2009-05-07
Background
>FLOAT is the Forth-94 string-to-float conversion primitive. While most implementations seek to follow the specification given by the Standard, few are strictly compliant. A common deficit is the failure to detect certain illegal input.
The implementation presented here seeks to avoid the defects observed elsewhere while keeping code size to a minimum. A test is included to check against common implementation errors.
Should a defect be discovered in this implementation, or it is found to accept input not specified by Forth-94, the author would be pleased to hear of it.
Implementation
\ FINPUT.F version 0.1 2009-05-07
\
\ A minimum yet compliant Forth-94 implementation of
\ >FLOAT. Works with separate or common stack float
\ models.
\
\ F# demonstrates the conditioning required to be
\ applied to >FLOAT to achieve compliance for forth
\ text input.
\
\ The code is intended as a model only. No particular
\ effort has been made to optimize for speed or
\ accuracy.
\
\ Assumptions:
\ 2's complement arithmetic
\ 1 char = 1 addr unit
\ -ROT ( : -ROT ROT ROT ; )
\ <> ( : <> - 0<> ; )
\
\ This code is PUBLIC DOMAIN. Use at your own risk.
\
\ History:
\
\ 0.1 Replaced .1E F* with 10E F/ for better accuracy.
\ Added conditional to allow leading decimal point
\ on forth text input.
\
( EMPTY ) FORTH DEFINITIONS DECIMAL
CR .( Loading FINPUT v0.1 2009-05-07 ... )
1 CONSTANT STRICT \ 0 = compiles shorter but less
\ strict code
\ ***** MODIFY THESE AS REQUIRED *****
HEX
: UPCHAR ( c -- C ) \ make char uppercase
DUP [CHAR] a [CHAR] z 1+ WITHIN IF 20 XOR THEN ;
DECIMAL
\ Implement this to allow 'E' or 'e' on forth input
: CAPS-SEARCH SEARCH ; \ case-insensitive SEARCH
\ ***** END *****
STRICT [IF] .( strict ) [ELSE] .( short ) [THEN]
.( version ) CR
HERE
VARIABLE exp \ exponent
VARIABLE dpf \ decimal point
FVARIABLE tmp
10 0 D>F FCONSTANT F10.0 \ 10.E0
: getc ( a u -- a' u' c )
1 /STRING OVER 1- C@ ;
\ get sign
: gets ( a u -- a' u' n|0 )
DUP IF
getc DUP [CHAR] - = IF EXIT THEN
[CHAR] + <> /STRING
THEN 0 ;
: getdigs ( a u -- a' u' )
BEGIN DUP WHILE
getc [CHAR] 0 - DUP 9 U> IF
DROP -1 /STRING EXIT
THEN
0 D>F tmp F@ F10.0 F* F+ tmp F!
dpf @ exp +!
REPEAT ;
: getmant ( a u -- a' u' flag )
[ STRICT ] [IF] TUCK [THEN]
getdigs DUP IF
OVER C@ [CHAR] . = IF
-1 dpf ! 1 /STRING getdigs
THEN
THEN
[ STRICT ] [IF] ROT OVER - dpf @ + [THEN] ;
: getexp ( a u -- a' u' )
DUP IF
OVER C@ UPCHAR DUP [CHAR] E =
SWAP [CHAR] D = OR 1 AND /STRING
THEN
gets >R 0 0 2SWAP >NUMBER 2SWAP D>S
R> IF NEGATE THEN exp @ +
BEGIN ?DUP WHILE DUP 0<
IF 1+ tmp F@ F10.0 F/
ELSE 1- tmp F@ F10.0 F* THEN tmp F!
REPEAT ;
STRICT [IF]
\ Forth-94 function (strict)
: >FLOAT ( c-addr u -- r true | false )
[ 0 0 D>F ] FLITERAL tmp F! 0 exp ! 0 dpf !
2DUP -TRAILING NIP 0<> AND DUP IF
gets >R getmant IF
getexp DUP WHILE
THEN
2DROP R> DROP 0 EXIT THEN
ELSE 0 >R
THEN 2DROP tmp F@ R> IF FNEGATE THEN TRUE ;
[ELSE]
\ Forth-94 function (non-strict)
: >FLOAT ( a u -- r true | false )
[ 0 0 D>F ] FLITERAL tmp F! 0 exp ! 0 dpf !
-TRAILING
gets >R getmant
getexp IF R> 2DROP 0 EXIT THEN
DROP tmp F@ R> IF FNEGATE THEN TRUE ;
[THEN]
HERE SWAP - CR . .( bytes )
\ Forth float input. Floating-point numbers can be
\ entered via F# .
1 [IF] ( standard behaviour )
: fnumber ( c-addr u -- [r] flag )
DUP 1 > IF ( at least 2 chars )
OVER DUP C@ [CHAR] . < - ( skip sign)
C@ [CHAR] . > >R ( 1st char can't be .)
2DUP S" E" CAPS-SEARCH >R 2DROP
2R> AND BASE @ 10 = AND 0= WHILE
THEN 2DROP 0 ELSE >FLOAT THEN
DUP >R STATE @ AND IF POSTPONE FLITERAL THEN R> ;
[ELSE] ( allow leading decimal point )
: fnumber ( c-addr u -- [r] flag )
2DUP S" E" CAPS-SEARCH -ROT 2DROP
BASE @ 10 = AND IF >FLOAT ELSE 2DROP 0 THEN
DUP >R STATE @ AND IF POSTPONE FLITERAL THEN R> ;
[THEN]
: F# ( <number> )
BL WORD COUNT fnumber 0= ABORT" bad float" ; IMMEDIATE
1 [IF]
\ Test Forth-94 compliance for >FLOAT
: CHK ( addr len flag )
>R CR [CHAR] " EMIT 2DUP TYPE [CHAR] " EMIT
8 OVER - SPACES >FLOAT DUP >R IF FDROP THEN R>
." --> " DUP IF ." TRUE " ELSE ." FALSE" THEN
R> - IF ." *fail* " ELSE ." pass " THEN ;
: TEST ( -- )
CR ." Checking >FLOAT Forth-94 compliance ..." CR
S" ." FALSE CHK
S" E" FALSE CHK
S" .E" FALSE CHK
S" .E-" FALSE CHK
S" +" FALSE CHK
S" -" FALSE CHK
S" 9" FALSE CHK
S" 9 " FALSE CHK
S" " TRUE CHK
S" " TRUE CHK
S" 1+1" TRUE CHK
S" 1-1" TRUE CHK
S" 9" TRUE CHK
S" 9." TRUE CHK
S" .9" TRUE CHK
S" 9E" TRUE CHK
S" 9e+" TRUE CHK
S" 9d-" TRUE CHK
;
TEST
[THEN]
\ end
Top Home Forth
Page updated: 07 May 2009