: FLOAT-EXP 1+ C@ ;
: FLOAT-SIGN @ 128 AND ;
: FLOAT-DIGITS 2@ DUP 65280 AND IF 127 AND 128 OR ELSE 127 AND
THEN ;
: FLOAT-SIGNED FLOAT-SIGN IF DNEGATE THEN ;
: LEADING-0s 32768 16 0 DO 2DUP AND IF DROP I UNLOOP EXIT THEN
1 RSHIFT LOOP DROP 16 ;
: DLEADING-0s LEADING-0s DUP 16 = IF DROP >R LEADING-0s 16 +
R> SWAP THEN ;
: TLEADING-0s LEADING-0s DUP 16 = IF DROP >R DLEADING-0s 16 +
R> SWAP THEN ;
: FLOATS 4 * ;
: FLOAT+ 4 + ;
: FLOAT- 4 - ;
: RFLOAT ;
:NONAME 2>R 2R@ [ 'NUMBER @ COMPILE, ] DUP 0= IF 2R> 2DROP
EXIT THEN 2DROP 0 ?DO DROP LOOP 0 2R> RFLOAT ; 'NUMBER !
VARIABLE FSTACK
8 FLOATS ALLOT
FSTACK 2 + FSTACK !
: FFIRST FSTACK @ ;
: FSECOND FSTACK @ FLOAT- ;
: FR IF DUP 128 AND >R 128 OR 1 M+ 65407 AND R> OR THEN ;
: F+ FSECOND FLOAT-EXP FFIRST FLOAT-EXP - DUP 0< IF NEGATE
FSECOND FLOAT-DIGITS ROT DRSHIFT FSECOND FLOAT-SIGNED FFIRST
FLOAT-DIGITS FFIRST FLOAT-SIGNED D+ 2DUP D0= IF ELSE
2DUP D0< IF 128 >R DNEGATE
ELSE 0 >R THEN DLEADING-0s 8 - DUP >R 0< IF R@ NEGATE DRSHIFT
ELSE R@ DLSHIFT THEN FFIRST FLOAT-EXP R> - 256 * OR 65407 AND
R> OR THEN
ELSE FFIRST FLOAT-DIGITS ROT DRSHIFT FFIRST FLOAT-SIGNED
FSECOND FLOAT-DIGITS FSECOND FLOAT-SIGNED D+ 2DUP D0= IF ELSE
2DUP D0< IF 128 >R
DNEGATE ELSE 0 >R THEN DLEADING-0s 8 - DUP >R 0< IF R@ NEGATE
DRSHIFT ELSE R@ DLSHIFT THEN FSECOND FLOAT-EXP R> - 256 * OR
65407 AND R> OR THEN THEN FSECOND DUP FSTACK ! 2! ;
: F- FFIRST @ 128 XOR FFIRST ! F+ ;
: F* FFIRST FLOAT-DIGITS FSECOND FLOAT-DIGITS UD* DUP 0< IF 1
DRSHIFT 1 ELSE 0 THEN >R 6 DRSHIFT OVER 1 AND R> 2>R 1 DRSHIFT
ROT DROP DUP 128 AND IF 65407 AND FFIRST
FLOAT-SIGN FSECOND FLOAT-SIGN XOR OR FFIRST FLOAT-EXP FSECOND
FLOAT-EXP + 128 - R> + 8 LSHIFT OR R> FR ELSE 
2R> 2DROP THEN FSECOND DUP
FSTACK ! 2! ;
: F. FFIRST FLOAT-SIGN IF 45 EMIT THEN FFIRST FLOAT-EXP 128 -
. FFIRST FLOAT-DIGITS D. FSTACK @ FLOAT- FSTACK ! ;
: FPOP FSTACK @ 2@ FSTACK @ FLOAT- FSTACK ! ;
: FPUSH FSTACK @ FLOAT+ DUP FSTACK ! 2! ;
: FCONSTANT CREATE FPOP , , DOES> 2@ FPUSH ;
0 33568 FPUSH FCONSTANT TEN
52429 31820 FPUSH FCONSTANT 1/10
TEN TEN F* F.
1/10 1/10 F+ F.