[BACK]Return to float.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/float.fs between versions 1.50 and 1.55

version 1.50, 2006/12/31 13:39:13 version 1.55, 2009/09/25 18:52:29
Line 1 Line 1
 \ High level floating point                            14jan94py  \ High level floating point                            14jan94py
   
 \ Copyright (C) 1995,1997,2003,2004,2005,2006 Free Software Foundation, Inc.  \ Copyright (C) 1995,1997,2003,2004,2005,2006,2007 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 Line 15
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
   
 \ 1 cells 4 = [IF]  \ 1 cells 4 = [IF]
 \ ' cells   Alias sfloats  \ ' cells   Alias sfloats
Line 51 Line 50
     \G enough space to align it.      \G enough space to align it.
     here dup dfaligned swap ?DO  bl c,  LOOP ;      here dup dfaligned swap ?DO  bl c,  LOOP ;
   
 1 sfloats (Field) sfloat+ , ( sf-addr1 -- sf-addr2 ) \ float-ext s-float-plus  (Field) sfloat+ ( sf-addr1 -- sf-addr2 ) \ float-ext s-float-plus
 \G @code{1 sfloats +}.  \G @code{1 sfloats +}.
       1 sfloats ,
   
 1 dfloats (Field) dfloat+ , ( df-addr1 -- df-addr2 ) \ float-ext d-float-plus  (Field) dfloat+ ( df-addr1 -- df-addr2 ) \ float-ext d-float-plus
 \G @code{1 dfloats +}.  \G @code{1 dfloats +}.
       1 dfloats ,
       
 : f, ( f -- ) \ gforth  : f, ( f -- ) \ gforth
     \G Reserve data space for one floating-point number and store      \G Reserve data space for one floating-point number and store
     \G @i{f} in the space.      \G @i{f} in the space.
Line 232  set-current Line 233  set-current
         fnegate f~rel          fnegate f~rel
     THEN ;      THEN ;
   
   -0e fp@ c@ $80 = [if] 0 [else] 7 [endif] constant fsign-offset
   
   : fcopysign ( r1 r2 -- r3 ) \ gforth
   \G r3 takes its absolute value from r1 and its sign from r2
       \ !! implementation relies on IEEE DP format
       fp@ fsign-offset + dup c@ $80 and >r ( r1 r2 addr-r1sign )
       float+ dup c@ $7f and r> or swap c!
       fdrop ;
   
 \ proposals from Krishna Myeni in <cjsp2d$47l$1@ngspool-d02.news.aol.com>  \ proposals from Krishna Myeni in <cjsp2d$47l$1@ngspool-d02.news.aol.com>
 \ not sure if they are a good idea  \ not sure if they are a good idea
   
 : FTRUNC ( r1 -- r2 )  : ftrunc ( r1 -- r2 ) \ X:ftrunc
     \ round towards 0      \ round towards 0
     \ !! should be implemented properly      fdup fabs floor fswap fcopysign ;
     F>D D>F ;  
   
 : FMOD ( r1 r2 -- r )  : FMOD ( r1 r2 -- r )
     \ remainder of r1/r2      \ remainder of r1/r2
     FOVER FOVER F/ ftrunc F* F- ;      FOVER FOVER F/ ftrunc F* F- ;
   
Removed from v.1.50  
changed lines
  Added in v.1.55

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