--- gforth/float.fs 1995/01/18 18:41:35 1.10 +++ gforth/float.fs 1995/02/06 18:14:33 1.13 @@ -26,20 +26,16 @@ : f, ( f -- ) here 1 floats allot f! ; -\ !! have create produce faligned pfas : fconstant ( r -- ) - falign here f, Create A, - DOES> @ f@ ; - -: fvariable - falign here 0. d>f f, AConstant ; + Create f, + DOES> f@ ; : fdepth ( -- n ) f0 @ fp@ - [ 1 floats ] Literal / ; : FLit ( -- r ) r> faligned dup f@ float+ >r ; : FLiteral ( r -- ) postpone FLit falign f, ; immediate -&16 Value precision +&15 Value precision : set-precision to precision ; : scratch ( r -- addr len ) @@ -83,10 +79,14 @@ ' sfnumber IS notfound +: fvariable ( -- ) + Create 0e0 f, ; + \ does> ( -- f-addr ) + 1e0 fasin 2e0 f* fconstant pi : f2* 2e0 f* ; -: f2/ 2e0 f/ ; +: f2/ .5e0 f* ; : 1/f 1e0 fswap f/ ; @@ -103,5 +103,10 @@ \ : facosh fdup fdup f* 1e0 f- fsqrt f+ fln ; \ : fasinh fdup fdup f* 1e0 f+ fsqrt f/ fatanh ; +: f~ ( f1 f2 f3 -- flag ) fdup f0= IF fdrop f= EXIT THEN + fdup f0> IF frot frot f- fabs fswap + ELSE fnegate frot frot fover fabs fover fabs f+ frot frot + f- fabs frot frot f* THEN f< ; + : f.s ." <" fdepth 0 .r ." > " fdepth 0 max maxdepth-.s @ min dup 0 ?DO dup i - 1- floats fp@ + f@ f. LOOP drop ;