--- gforth/float.fs 2011/12/28 13:39:49 1.63 +++ gforth/float.fs 2012/05/26 10:35:35 1.66 @@ -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. @@ -128,18 +128,26 @@ 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 '.' scan drop Constant zero-exp + +: prefix-number ( c-addr u -- r true | false ) + si-prefixes count bounds DO + 2dup I c@ scan nip 0<> IF + I c@ >float1 + dup IF 1000 s>f zero-exp I - s>f f** f* THEN + UNLOOP EXIT THEN + LOOP + sfnumber ; +[ELSE] +: sfnumber ( c-addr u -- r true | false ) + >float ; +: prefix-number sfnumber ; +[THEN] [ifdef] recognizer: [IFDEF] 2lit, @@ -154,7 +162,7 @@ DOES> ( -- r ) 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