mirror of
https://github.com/remko/waforth
synced 2025-01-17 18:11:39 +01:00
compiler: Fix compilation of BEGIN+WHILE+WHILE+ELSE combinations
This commit is contained in:
Remko Tronçon
parent
860618af3e
commit
945cc3bede
4 changed files with 44 additions and 39 deletions
|
|
@ -20,10 +20,10 @@ and the I/O primitives to read and write a character to a screen.
|
|||
The WebAssembly module containing the interpreter, dynamic compiler, and
|
||||
all built-in words comes down to 13k (6k gzipped), with an extra 7k (3k gzipped) for the JavaScript wrapper and web UI.
|
||||
|
||||
WAForth is still in an experimental stage. It implements most of the [ANS Core
|
||||
Words](http://lars.nocrew.org/dpans/dpans6.htm#6.1), and passes most of the
|
||||
WAForth implements all of the [ANS Core
|
||||
Words](http://lars.nocrew.org/dpans/dpans6.htm#6.1) (and passes
|
||||
[Forth 200x Test Suite](https://forth-standard.org/standard/testsuite)
|
||||
core word tests.
|
||||
core word tests), and several [ANS Core Extension Words](http://lars.nocrew.org/dpans/dpans6.htm#6.2)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -670,13 +670,13 @@ T{ 3 GI4 -> 3 4 5 6 }T
|
|||
T{ 5 GI4 -> 5 6 }T
|
||||
T{ 6 GI4 -> 6 7 }T
|
||||
|
||||
\ TODO T{ : GI5 BEGIN DUP 2 >
|
||||
\ TODO WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T
|
||||
\ TODO T{ 1 GI5 -> 1 345 }T
|
||||
\ TODO T{ 2 GI5 -> 2 345 }T
|
||||
\ TODO T{ 3 GI5 -> 3 4 5 123 }T
|
||||
\ TODO T{ 4 GI5 -> 4 5 123 }T
|
||||
\ TODO T{ 5 GI5 -> 5 123 }T
|
||||
T{ : GI5 BEGIN DUP 2 >
|
||||
WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T
|
||||
T{ 1 GI5 -> 1 345 }T
|
||||
T{ 2 GI5 -> 2 345 }T
|
||||
T{ 3 GI5 -> 3 4 5 123 }T
|
||||
T{ 4 GI5 -> 4 5 123 }T
|
||||
T{ 5 GI5 -> 5 123 }T
|
||||
|
||||
T{ : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> }T
|
||||
T{ 0 GI6 -> 0 }T
|
||||
|
|
|
|||
|
|
@ -2132,7 +2132,7 @@
|
|||
;; 1 temporary local for computations
|
||||
(global.set $currentLocal (global.get $firstTemporaryLocal))
|
||||
(global.set $lastLocal (global.get $currentLocal))
|
||||
(global.set $branchNesting (i32.const -1))
|
||||
(global.set $branchNesting (i32.const 0))
|
||||
(global.set $lastEmitWasGetTOS (i32.const 0)))
|
||||
|
||||
(func $endColon
|
||||
|
|
@ -2245,9 +2245,10 @@
|
|||
(call $emitIf)
|
||||
(global.set $branchNesting (i32.add (global.get $branchNesting) (i32.const 1))))
|
||||
|
||||
(func $compileThen
|
||||
(func $compileThen (param $tos i32) (result i32)
|
||||
(global.set $branchNesting (i32.sub (global.get $branchNesting) (i32.const 1)))
|
||||
(call $emitEnd))
|
||||
(call $emitEnd)
|
||||
(call $compileEndDests (local.get $tos)))
|
||||
|
||||
(func $compileDo (param $tos i32) (result i32)
|
||||
;; 1: $diff_i = end index - current index
|
||||
|
|
@ -2345,25 +2346,46 @@
|
|||
(call $emitICall (i32.const 0) (i32.const 9 (; = END_DO_INDEX ;)))
|
||||
(call $emitBr (i32.add (global.get $branchNesting) (i32.const 1))))
|
||||
|
||||
(func $compileBegin
|
||||
(func $compileBegin (param $tos i32) (result i32)
|
||||
(call $emitLoop)
|
||||
(global.set $branchNesting (i32.add (global.get $branchNesting) (i32.const 1))))
|
||||
(global.set $branchNesting (i32.add (global.get $branchNesting) (i32.const 1)))
|
||||
(i32.store (local.get $tos) (i32.or (global.get $branchNesting) (i32.const 0x80000000 (; dest bit ;))))
|
||||
(i32.add (local.get $tos) (i32.const 4)))
|
||||
|
||||
(func $compileWhile
|
||||
(call $compileIf))
|
||||
|
||||
(func $compileRepeat
|
||||
(call $emitBr (i32.const 1)) ;; Jump across while to repeat
|
||||
(func $compileRepeat (param $tos i32) (result i32)
|
||||
(call $emitBr
|
||||
(i32.sub
|
||||
(global.get $branchNesting)
|
||||
(i32.and
|
||||
(i32.load (i32.sub (local.get $tos) (i32.const 4)))
|
||||
(i32.const 0x7FFFFFFF))))
|
||||
(call $emitEnd)
|
||||
(call $emitEnd)
|
||||
(global.set $branchNesting (i32.sub (global.get $branchNesting) (i32.const 1))))
|
||||
(global.set $branchNesting (i32.sub (global.get $branchNesting) (i32.const 1)))
|
||||
(call $compileEndDests (local.get $tos)))
|
||||
|
||||
(func $compileUntil
|
||||
(func $compileUntil (param $tos i32) (result i32)
|
||||
(call $compilePop)
|
||||
(call $emitEqualsZero)
|
||||
(call $emitBrIf (i32.const 0))
|
||||
(call $emitEnd)
|
||||
(global.set $branchNesting (i32.sub (global.get $branchNesting) (i32.const 1))))
|
||||
(call $compileEndDests (local.get $tos)))
|
||||
|
||||
(func $compileEndDests (param $tos i32) (result i32)
|
||||
(local $btos i32)
|
||||
(block $endLoop
|
||||
(loop $loop
|
||||
(br_if $endLoop
|
||||
(i32.or
|
||||
(i32.le_u (local.get $tos) (i32.const 0x10000 (; = STACK_BASE ;)))
|
||||
(i32.ne
|
||||
(i32.load (local.tee $btos (i32.sub (local.get $tos) (i32.const 4))))
|
||||
(i32.or (global.get $branchNesting) (i32.const 0x80000000 (; dest bit ;))))))
|
||||
(call $emitEnd)
|
||||
(global.set $branchNesting (i32.sub (global.get $branchNesting) (i32.const 1)))
|
||||
(local.set $tos (local.get $btos))))
|
||||
(local.get $tos))
|
||||
|
||||
(func $compileRecurse
|
||||
;; call 0
|
||||
|
|
|
|||
|
|
@ -826,23 +826,6 @@ function loadTests() {
|
|||
expect(stackValues()[8]).to.eql(7);
|
||||
expect(stackValues()[9]).to.eql(5);
|
||||
});
|
||||
|
||||
it.skip("should work with multiple whiles + else", () => {
|
||||
run(
|
||||
`: FOO BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN 7 ;`
|
||||
);
|
||||
run("1 FOO 5");
|
||||
expect(stackValues()[0]).to.eql(1);
|
||||
expect(stackValues()[1]).to.eql(2);
|
||||
expect(stackValues()[2]).to.eql(2);
|
||||
expect(stackValues()[3]).to.eql(4);
|
||||
expect(stackValues()[4]).to.eql(4);
|
||||
expect(stackValues()[5]).to.eql(8);
|
||||
expect(stackValues()[6]).to.eql(8);
|
||||
expect(stackValues()[7]).to.eql(16);
|
||||
expect(stackValues()[8]).to.eql(7);
|
||||
expect(stackValues()[9]).to.eql(5);
|
||||
});
|
||||
});
|
||||
|
||||
describe("BEGIN / UNTIL", () => {
|
||||
|
|
|
|||
Loading…
Reference in a new issue