--- gforth/float.fs	2009/09/25 18:52:29	1.55
+++ 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 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,19 +128,50 @@ 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,
+	: 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 prefix-number
+	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 +201,7 @@ IS compiler-notfound1
 	defers interpreter-notfound1
     ENDIF ;
 IS interpreter-notfound1
+[then]
 
 : fvariable ( "name" -- ) \ float f-variable
     Create 0.0E0 f, ;
@@ -233,7 +265,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