--- gforth/float.fs 2011/10/07 17:10:15 1.61 +++ gforth/float.fs 2012/05/28 14:20:04 1.67 @@ -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,27 +128,42 @@ 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 ; + +Create si-prefixes ," PTGMk munpf" +si-prefixes count bl scan drop Constant zero-exp + +: prefix-number ( c-addr u -- r true | false ) + si-prefixes count bounds DO + 2dup I c@ scan nip dup 0<> IF + 1 = IF 1- fp-char @ ELSE I c@ THEN + >float1 + dup IF 1000 s>f zero-exp I - s>f f** f* THEN + UNLOOP EXIT THEN drop + LOOP + sfnumber ; +[ELSE] +: sfnumber ( c-addr u -- r true | false ) + >float ; +: prefix-number sfnumber ; +[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 -- float int-table | addr u r:fail ) - 2dup sfnumber + 2dup prefix-number IF 2drop r:fnumber EXIT THEN