--- gforth/float.fs 2011/10/06 21:08:45 1.60 +++ gforth/float.fs 2012/05/26 10:20:01 1.65 @@ -1,6 +1,6 @@ \ High level floating point 14jan94py -\ Copyright (C) 1995,1997,2003,2004,2005,2006,2007,2009,2010 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 ; @@ -128,30 +128,32 @@ DOES> ( -- r ) scratch over c@ emit '. emit 1 /string type 'E emit . ; +[IFDEF] fp-char : sfnumber ( c-addr u -- r true | false ) - 2dup [CHAR] e scan ( c-addr u c-addr2 u2 ) - dup 0= - IF - 2drop 2dup [CHAR] E scan ( c-addr u c-addr3 u3 ) - THEN - nip - IF - >float - ELSE - 2drop false - THEN ; + fp-char @ >float1 ; +[ELSE] +: sfnumber ( c-addr u -- r true | false ) + >float ; +[THEN] [ifdef] recognizer: - ' noop - :noname postpone Fliteral ; + [IFDEF] 2lit, + : flit, postpone Fliteral ; + :noname ['] noop ; + :noname ['] flit, ; + [ELSE] + ' noop + :noname postpone Fliteral ; + [THEN] dup recognizer: r:fnumber - : fnum-recognizer ( addr u -- nt int-table true | addr u false ) - 2dup sfnumber dup - IF - drop 2drop r:fnumber true - THEN ; + : 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