| \ High level floating point 14jan94py |
\ 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. |
\ This file is part of Gforth. |
| |
|
| scratch over c@ emit '. emit 1 /string type |
scratch over c@ emit '. emit 1 /string type |
| 'E emit . ; |
'E emit . ; |
| |
|
| |
[IFDEF] fp-char |
| : sfnumber ( c-addr u -- r true | false ) |
: sfnumber ( c-addr u -- r true | false ) |
| 2dup [CHAR] e scan ( c-addr u c-addr2 u2 ) |
fp-char @ >float1 ; |
| dup 0= |
[ELSE] |
| IF |
: sfnumber ( c-addr u -- r true | false ) |
| 2drop 2dup [CHAR] E scan ( c-addr u c-addr3 u3 ) |
>float ; |
| THEN |
[THEN] |
| nip |
|
| IF |
|
| >float |
|
| ELSE |
|
| 2drop false |
|
| THEN ; |
|
| |
|
| [ifdef] recognizer: |
[ifdef] recognizer: |
| |
[IFDEF] 2lit, |
| |
: flit, postpone Fliteral ; |
| |
:noname ['] noop ; |
| |
:noname ['] flit, ; |
| |
[ELSE] |
| ' noop |
' noop |
| :noname postpone Fliteral ; |
:noname postpone Fliteral ; |
| |
[THEN] |
| dup |
dup |
| recognizer: r:fnumber |
recognizer: r:fnumber |
| |
|