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

version 1.55, 2009/09/25 18:52:29 version 1.65, 2012/05/26 10:20:01
Line 1 Line 1
 \ High level floating point                            14jan94py  \ High level floating point                            14jan94py
   
 \ Copyright (C) 1995,1997,2003,2004,2005,2006,2007 Free Software Foundation, Inc.  \ Copyright (C) 1995,1997,2003,2004,2005,2006,2007,2009,2010,2011 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 88  DOES> ( -- r ) Line 88  DOES> ( -- r )
     \G @code{F.} @code{FE.} and @code{FS.} to @i{u}.      \G @code{F.} @code{FE.} and @code{FS.} to @i{u}.
     to precision ;      to precision ;
   
 : scratch ( r -- addr len )  : scratch ( -- addr len )
   pad precision - precision ;    pad precision - precision ;
   
 : zeros ( n -- )   0 max 0 ?DO  '0 emit  LOOP ;  : zeros ( n -- )   0 max 0 ?DO  '0 emit  LOOP ;
Line 128  DOES> ( -- r ) Line 128  DOES> ( -- r )
   scratch over c@ emit '. emit 1 /string type    scratch over c@ emit '. emit 1 /string type
   'E emit . ;    'E emit . ;
   
   [IFDEF] fp-char
 : sfnumber ( c-addr u -- r true | false )  : sfnumber ( c-addr u -- r true | false )
     2dup [CHAR] e scan ( c-addr u c-addr2 u2 )      fp-char @ >float1 ;
     dup 0=  [ELSE]
     IF  : sfnumber ( c-addr u -- r true | false )
         2drop 2dup [CHAR] E scan ( c-addr u c-addr3 u3 )      >float ;
     THEN  [THEN]
     nip  
     IF  
         >float  
     ELSE  
         2drop false  
     THEN ;  
   
   [ifdef] recognizer:
       [IFDEF] 2lit,
           : flit, postpone Fliteral ;
           :noname ['] noop ;
           :noname ['] flit, ;
       [ELSE]
           ' noop
           :noname postpone Fliteral ;
       [THEN]
       dup
       recognizer: r:fnumber
   
       : fnum-recognizer ( addr u -- float int-table | addr u r:fail )
           2dup sfnumber
           IF
               2drop r:fnumber  EXIT
           THEN
           r:fail ;
   
   ' fnum-recognizer
   forth-recognizer get-recognizers
   1+ forth-recognizer set-recognizers
   [else]
 [ifundef] compiler-notfound1  [ifundef] compiler-notfound1
 defer compiler-notfound1  defer compiler-notfound1
 ' no.extensions IS compiler-notfound1  ' no.extensions IS compiler-notfound1
Line 170  IS compiler-notfound1 Line 188  IS compiler-notfound1
         defers interpreter-notfound1          defers interpreter-notfound1
     ENDIF ;      ENDIF ;
 IS interpreter-notfound1  IS interpreter-notfound1
   [then]
   
 : fvariable ( "name" -- ) \ float f-variable  : fvariable ( "name" -- ) \ float f-variable
     Create 0.0E0 f, ;      Create 0.0E0 f, ;
Line 233  set-current Line 252  set-current
         fnegate f~rel          fnegate f~rel
     THEN ;      THEN ;
   
 -0e fp@ c@ $80 = [if] 0 [else] 7 [endif] constant fsign-offset  -0e 8 0 [do] fp@ [i] + c@ $80 = [if] [i] constant fsign-offset [then] [loop]
   
 : fcopysign ( r1 r2 -- r3 ) \ gforth  : fcopysign ( r1 r2 -- r3 ) \ gforth
 \G r3 takes its absolute value from r1 and its sign from r2  \G r3 takes its absolute value from r1 and its sign from r2

Removed from v.1.55  
changed lines
  Added in v.1.65


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