Bugfixes, add first version of float number library.

double.fth

@@ -4,6 +4,7 @@
 : DNEGATE OVER NEGATE ROT IF SWAP INVERT ELSE SWAP NEGATE THEN ;
 : D- DNEGATE D+ ;
 : D. DUP >R DABS <# BL HOLD #S R> SIGN #> TYPE ;
+: UD. <# BL HOLD #S #> TYPE ;
 : D.R >R DUP >R DABS <# BL HOLD #S R> SIGN #> R> OVER - SPACES TYPE ;
 : D0< 0< NIP ;
 : D2* 2* OVER 0< 1 AND OR SWAP 2* SWAP ;
@@ -15,7 +16,7 @@
 : M+ S>D D+ ;
 : DMIN 2OVER 2OVER D> IF 2SWAP THEN 2DROP ;
 : DMAX 2OVER 2OVER D< IF 2SWAP THEN 2DROP ;
-: UDM* TUCK UM* >R >R UM* R> M+ R> + ;
+: UDM* TUCK UM* >R >R UM* R> O+ R> + ;
 : UD* 2DUP 2>R 2SWAP >R UDM* R> 2R> ROT UDM* DROP D+ ;
 : D* UD* ;
 : DM* TUCK M* 2>R 2DUP 0< UM* 2>R UM* 2R@ ROT M+ 2R> DROP + 2R> D+ ;

double_compressed.fth

@@ -20,4 +20,4 @@ R> ; : M*/ >R DM* R> DM/MOD ROT DROP ; BASE @ HEX
 :CODE MLSHIFT 32 C, 30 C, 3E C, 20 C, 22 C, CODE; BASE !
 : MRSHIFT DUP 16 < IF 16 SWAP - MLSHIFT ELSE 16 - RSHIFT 0
 THEN ; : DLSHIFT TUCK LSHIFT >R MLSHIFT R> OR ; : DRSHIFT TUCK
-MRSHIFT >R >R RSHIFT R> OR R> ;
+MRSHIFT >R >R RSHIFT R> OR R> ; : UD. <# BL HOLD #S #> TYPE ;

float.fth

@@ -0,0 +1,53 @@
+: 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- ;
+: FROUND 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> FROUND 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.

forth.fth

@@ -1,6 +1,7 @@
 ASSEMBLER
 : EXIT 0x28 0x29 ;
 : (lit) 0x2b 0x21 0x29 ;
+: (dodoes) 0x2b 0x21 0x2b 0x1b 0x29 ;
 : DUP 0x30 0x21 0x29 ;
 : SWAP 0x31 0x32 0x21 0x22 0x29 ;
 : ROT 0x31 0x32 0x33 0x22 0x21 0x23 0x29 ;
@@ -176,8 +177,7 @@ FORTH
 : POSTPONE ' DUP 1- C@ 128 AND IF , ELSE ['] (lit) , , ['] , , THEN ; IMMEDIATE
 : LITERAL ['] (lit) , , ; IMMEDIATE
 : NLITERAL DUP >R 0 DO ['] (lit) , 0 , LOOP R> 0 DO HERE 2 - I 4 * - ! LOOP ; IMMEDIATE
-: (dodoes) ['] (branch) LATEST @ 1+ ! LATEST @ 7 + R@ CELL+ ! R> LATEST @ 3 + ! ;
-: DOES> ['] (dodoes) , ['] (lit) , 0 , ; IMMEDIATE
+: DOES> ['] (dodoes) LATEST @ 1+ ! R> LATEST @ 5 + ! ;
 : ['] ' POSTPONE LITERAL ; IMMEDIATE
 : [COMPILE] ' , ; IMMEDIATE
 : ; ['] EXIT , LATEST ! POSTPONE [ ; IMMEDIATE

init.lua

@@ -599,7 +599,8 @@ end
 
 local progs = {["Empty"] = string.rep(string.char(0), 16536),
 		["Forth Boot Disk"] = create_forth_floppy(),
-		["Double number library"] = create_from_file(modpath.."/double_compressed.fth")}
+		["Double number library"] = create_from_file(modpath.."/double_compressed.fth"),
+		["Floating point number library"] = create_from_file(modpath.."/float.fth")}
 minetest.register_node("forth_computer:floppy_programmator",{
 	description = "Floppy disk programmator",
 	tiles = {"floppy_programmator_top.png", "floppy_programmator_bottom.png", "floppy_programmator_right.png", "floppy_programmator_left.png", "floppy_programmator_back.png", "floppy_programmator_front.png"},