--- gforth/float.fs 2009/09/25 18:52:29 1.55 +++ gforth/float.fs 2011/12/31 15:29:25 1.64 @@ -1,6 +1,6 @@ \ 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. @@ -88,7 +88,7 @@ DOES> ( -- r ) \G @code{F.} @code{FE.} and @code{FS.} to @i{u}. to precision ; -: scratch ( r -- addr len ) +: scratch ( -- addr len ) pad precision - precision ; : zeros ( n -- ) 0 max 0 ?DO '0 emit LOOP ; @@ -141,6 +141,29 @@ DOES> ( -- r ) 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 defer compiler-notfound1 ' no.extensions IS compiler-notfound1 @@ -170,6 +193,7 @@ IS compiler-notfound1 defers interpreter-notfound1 ENDIF ; IS interpreter-notfound1 +[then] : fvariable ( "name" -- ) \ float f-variable Create 0.0E0 f, ; @@ -233,7 +257,7 @@ set-current fnegate f~rel 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 \G r3 takes its absolute value from r1 and its sign from r2