54 lines
2.0 KiB
Forth
54 lines
2.0 KiB
Forth
: 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.
|