Diff for /gforth/float.fs between versions 1.51 and 1.54

version 1.51, 2007/07/06 12:54:56 version 1.54, 2009/05/24 17:36:36
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 234  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@ dup 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.51  
changed lines
  Added in v.1.54


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