Diff for /gforth/float.fs between versions 1.25 and 1.27

version 1.25, 1999/03/23 20:24:18 version 1.27, 1999/05/15 20:00:20
Line 43 Line 43
 \ [THEN]  \ [THEN]
   
 : sfalign ( -- ) \ float-ext s-f-align  : sfalign ( -- ) \ float-ext s-f-align
       \G If the data-space pointer is not single-float-aligned, reserve
       \G enough space to align it.
     here dup sfaligned swap ?DO  bl c,  LOOP ;      here dup sfaligned swap ?DO  bl c,  LOOP ;
 : dfalign ( -- ) \ float-ext d-f-align  : dfalign ( -- ) \ float-ext d-f-align
       \G If the data-space pointer is not double-float-aligned, reserve
       \G enough space to align it.
     here dup dfaligned swap ?DO  bl c,  LOOP ;      here dup dfaligned swap ?DO  bl c,  LOOP ;
   
 1 sfloats constant sfloat+ ( sf-addr1 -- sf-addr2 ) \ float-ext s-float-plus  1 sfloats constant sfloat+ ( sf-addr1 -- sf-addr2 ) \ float-ext s-float-plus
   \G Increment @i{sf-addr1} by the number of address units corresponding to the size of
   \G a single-precision IEEE floating-point number, to give @i{sf-addr2}.""
 dofield: lastxt code-address! \ change the constant into a field  dofield: lastxt code-address! \ change the constant into a field
   
 1 dfloats constant dfloat+ ( df-addr1 -- df-addr2 ) \ float-ext d-float-plus  1 dfloats constant dfloat+ ( df-addr1 -- df-addr2 ) \ float-ext d-float-plus
   \G Increment @i{df-addr1} by the number of address units corresponding to the size of
   \G a double-precision IEEE floating-point number, to give @i{df-addr2}.""
 dofield: lastxt code-address! \ change the constant into a field  dofield: lastxt code-address! \ change the constant into a field
   
 : f, ( f -- )  here 1 floats allot f! ;  : f, ( f -- ) \ gforth
       \G Reserve data space for one floating-point number and store
       \G @i{f} in the space.
       here 1 floats allot f! ;
   
 : fconstant  ( r "name" -- ) \ float  : fconstant  ( r "name" -- ) \ float
     Create f,      Create f,
Line 182  IS interpreter-notfound Line 193  IS interpreter-notfound
 \ : facosh   fdup fdup f* 1.0e0 f- fsqrt f+ fln ;  \ : facosh   fdup fdup f* 1.0e0 f- fsqrt f+ fln ;
 \ : fasinh   fdup fdup f* 1.0e0 f+ fsqrt f/ fatanh ;  \ : fasinh   fdup fdup f* 1.0e0 f+ fsqrt f/ fatanh ;
   
 \ !! factor out parts  : f~abs ( r1 r2 r3 -- flag ) \ gforth
 : f~ ( f1 f2 f3 -- flag ) \ float-ext      \G Approximate equality with absolute error: |r1-r2|<r3.
       frot frot f- fabs fswap f< ;
   
   : f~rel ( r1 r2 r3 -- flag ) \ gforth
       \G Approximate equality with relative error: |r1-r2|<r3*|r1+r2|.
           frot frot fover fabs fover fabs f+ frot frot
           f- fabs frot frot f* f< ;
   
   : f~ ( r1 r2 r3 -- flag ) \ float-ext
       \G ANS Forth medley: r3>0: @code{f~abs}; r3=0: r1=r2; r3<0: @code{fnegate f~abs}.
     fdup f0=      fdup f0=
     IF      IF
         fdrop f= EXIT          fdrop f=  \ !! this does not work, because 0=-0 with f= on Linux-Intel
                     \ the standard says they should compare unequal
                     \ the comparison should be done with COMPARE
           EXIT
     THEN      THEN
     fdup f0>      fdup f0>
     IF      IF
         frot frot f- fabs fswap          f~abs
     ELSE      ELSE
         fnegate frot frot fover fabs fover fabs f+ frot frot          fnegate f~rel
         f- fabs frot frot f*      THEN ;
     THEN  
     f< ;  
   
 : f.s ( -- ) \ gforth f-dot-s  : f.s ( -- ) \ gforth f-dot-s
     \G Display the number of items on the floating-point stack,      \G Display the number of items on the floating-point stack,

Removed from v.1.25  
changed lines
  Added in v.1.27


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>