diff --git a/src/waforth.wat b/src/waforth.wat index 8adb885..e4757b7 100644 --- a/src/waforth.wat +++ b/src/waforth.wat @@ -1395,33 +1395,7 @@ ;; [6.2.1725](https://forth-standard.org/standard/core/IS) (func $IS (param $tos i32) (result i32) - (local $xtp i32) - (local $btos i32) - (local.set $xtp - (i32.add - (call $body (drop (call $find! (call $parseName)))) - (i32.const 4))) - (if (result i32) (i32.eqz (i32.load (i32.const 0x2092c (; = body(STATE) ;)))) - (then - (i32.store (local.get $xtp) - (i32.load (local.tee $btos (i32.sub (local.get $tos) (i32.const 4))))) - (local.get $btos)) - (else - (call $emitSetLocal (i32.const 0)) ;; Save tos currently on operand stack - - ;; Push parameter pointer on operand stack - (call $emitConst (local.get $xtp)) - - ;; Pop value from stack & push on operand stack - (call $emitGetLocal (i32.const 0)) - (call $emitConst (i32.const 4)) - (call $emitSub) - (call $emitTeeLocal (i32.const 0)) - (call $emitLoad) - - (call $emitStore) - (call $emitGetLocal (i32.const 0)) ;; Put tos on operand stack again - (local.get $tos)))) + (call $to (local.get $tos))) (data (i32.const 0x20690) "\80\06\02\00" "\82" (; F_IMMEDIATE ;) "IS " "\79\00\00\00") (elem (i32.const 0x79) $IS) @@ -1916,14 +1890,8 @@ ;; [6.2.2295](https://forth-standard.org/standard/core/TO) (func $TO (param $tos i32) (result i32) - (local $v i32) - (local $xt i32) - (local $btos i32) - (local.set $xt (drop (call $find! (call $parseName)))) - (i32.store (i32.add (call $body (local.get $xt)) (i32.const 4)) - (i32.load (local.tee $btos (i32.sub (local.get $tos) (i32.const 4))))) - (local.get $btos)) - (data (i32.const 0x20950) "\40\09\02\00" "\02" "TO " "\a6\00\00\00") + (call $to (local.get $tos))) + (data (i32.const 0x20950) "\40\09\02\00" "\82" (; F_IMMEDIATE ;) "TO " "\a6\00\00\00") (elem (i32.const 0xa6) $TO) ;; [6.2.2298](https://forth-standard.org/standard/core/TRUE) @@ -2877,6 +2845,35 @@ (local.set $p (i32.add (local.get $p) (i32.const 1))) (br $loop)))) + (func $to (param $tos i32) (result i32) + (local $dp i32) + (local $btos i32) + (local.set $dp + (i32.add + (call $body (drop (call $find! (call $parseName)))) + (i32.const 4))) + (if (result i32) (i32.eqz (i32.load (i32.const 0x2092c (; = body(STATE) ;)))) + (then + (i32.store (local.get $dp) + (i32.load (local.tee $btos (i32.sub (local.get $tos) (i32.const 4))))) + (local.get $btos)) + (else + (call $emitSetLocal (i32.const 0)) ;; Save tos currently on operand stack + + ;; Push parameter pointer on operand stack + (call $emitConst (local.get $dp)) + + ;; Pop value from stack & push on operand stack + (call $emitGetLocal (i32.const 0)) + (call $emitConst (i32.const 4)) + (call $emitSub) + (call $emitTeeLocal (i32.const 0)) + (call $emitLoad) + + (call $emitStore) + (call $emitGetLocal (i32.const 0)) ;; Put tos on operand stack again + (local.get $tos)))) + (func $ensureCompiling (param $tos i32) (result i32) (local.get $tos) (if (param i32) (result i32) (i32.eqz (i32.load (i32.const 0x2092c (; = body(STATE) ;)))) diff --git a/src/web/tests/forth2012-test-suite/coreexttest.fth b/src/web/tests/forth2012-test-suite/coreexttest.fth index 7a8a8b1..0208159 100644 --- a/src/web/tests/forth2012-test-suite/coreexttest.fth +++ b/src/web/tests/forth2012-test-suite/coreexttest.fth @@ -414,8 +414,8 @@ T{ : VD1 VAL1 ; -> }T T{ VD1 -> 222 }T T{ : VD2 TO VAL2 ; -> }T T{ VAL2 -> -999 }T -\ T{ -333 VD2 -> }T -\ T{ VAL2 -> -333 }T +T{ -333 VD2 -> }T +T{ VAL2 -> -333 }T T{ VAL1 -> 222 }T T{ 123 VALUE VAL3 IMMEDIATE VAL3 -> 123 }T T{ : VD3 VAL3 LITERAL ; VD3 -> 123 }T