\ dfout 05.3.2 NAB

needs NewFloatMgr
needs fpout

module dfrepresent

: darray ( n "name" -- )
  create dfloats allot
  does> ( n -- &df )  swap dfloats + ;

9 darray pow1
9 darray pow2

(dfloat) 1e64 dfdup dfdup df* df*
8 pow1 df!df
(dfloat) 1e64 dfdup df*
7 pow1 df!df
(dfloat) 1e64  6 pow1 df!df
(dfloat) 1e32  5 pow1 df!df
(dfloat) 1e16  4 pow1 df!df
(dfloat) 1e8  3 pow1 df!df
(dfloat) 1e4  2 pow1 df!df
(dfloat) 1e2  1 pow1 df!df
(dfloat) 1e1  0 pow1 df!df

(dfloat) 1e-64 dfdup dfdup df* df*
8 pow2 df!df
(dfloat) 1e-64 dfdup df*
7 pow2 df!df
(dfloat) 1e-64  6 pow2 df!df
(dfloat) 1e-32  5 pow2 df!df
(dfloat) 1e-16  4 pow2 df!df
(dfloat) 1e-8  3 pow2 df!df
(dfloat) 1e-4  2 pow2 df!df
(dfloat) 1e-2  1 pow2 df!df
(dfloat) 1e-1  0 pow2 df!df

0 value maxdf

0 value e
0 value dfbuf

: dfout ( char -- )
  dfbuf c!  dfbuf 1+ to dfbuf ;

: build-exp ( df1 -- df2 )
  0 to e
  0 8 do
    dfdup i pow1 df@df df> if
      1 i lshift e + to e
      i pow2 df@df df*
    then
  -1 +loop ;

: extract-digits ( df -- )
  maxdf 0 do
    dfdup df>d  over
    10 /mod
    ?dup if [char] 0 +  dfout then
    [char] 0 +  dfout 
    d>df df- (dfloat) 10 df*
  loop ;

0 value last

: roundup
  df>d drop 4 > if
  0 to last
  maxdf 1+ 1 do  dfbuf i - c@
  dup [char] 9 = if drop [char] 0
  dfbuf i - c!
  else  1+ dfbuf i - c!  leave then
  i to last
  loop
  last maxdf = if
    [char] 1 dfbuf maxdf - c!
    e 1+ to e
  then
  then ;

public:

: dfrepresent
  ?dup 0= if  drop  0 0 0  exit  then
  2dup [char] 0 fill
  to maxdf  to dfbuf
  dfdup (dfloat) 0 df< if
    dfnegate  true  else  false  then
  >r
  build-exp extract-digits  roundup
  e 1+ r> true ;

16 set-precision

expose-module fpout

public:

: output-is-df
  ['] dfdup is fpout-fdup
  ['] dfrepresent is fpout-represent ;

\ Wrap the output words:
: DFS. output-is-df fs. output-is-f ;
: (dfe.) output-is-df (fe.) output-is-f ;
: dfe.r output-is-df fe.r output-is-f ;
: dfe. output-is-df fe. output-is-f ;
: (df.) output-is-df (f.) output-is-f ;
: df.r output-is-df f.r output-is-f ;
: df. output-is-df f. output-is-f ;
: (dg.) output-is-df (g.) output-is-f ;
: dg.r output-is-df g.r output-is-f ;
: dg. output-is-df g. output-is-f ;

previous
end-module
