diff --git a/blk/042 b/blk/042 index 36dd48e..eb03a5a 100644 --- a/blk/042 +++ b/blk/042 @@ -5,12 +5,12 @@ definitions. In the INTERPRET loop, they don't have the desired effect because each word from the input stream is executed immediately. In this context, branching doesn't work. -(br) -- Branches by the number specified in the 2 following - bytes. Can be negative. -(?br) f -- Branch if f is false. -( -- *I* Comment. Ignore rest of line until ")" is read. -[ -- Begin interpretative mode. In a definition, words - between here and "]" will be executed instead of - compiled. -] -- End interpretative mode. -ABORT -- Resets PS and RS and returns to interpreter. (cont.) +f IF A ELSE B THEN: if f is true, execute A, if false, execute +B. ELSE is optional. +BEGIN .. f UNTIL: if f is false, branch to BEGIN. +BEGIN .. AGAIN: Always branch to BEGIN. +x y DO .. LOOP: LOOP increments y. if y != x, branch to DO. +x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute +A, if x == z, execute B. Otherwise, execute C. + + (cont.) diff --git a/blk/043 b/blk/043 index b9ef2bc..00c1c7c 100644 --- a/blk/043 +++ b/blk/043 @@ -1,16 +1,15 @@ (cont.) -ABORT" x" -- *I* Compiles a ." followed by a ABORT. -AGAIN I:a -- *I* Jump backwards to preceeding BEGIN. -BEGIN -- I:a *I* Marker for backward branching with - AGAIN. -ELSE I:a -- *I* Compiles a (fbr) and set branching - cell at a. -EXECUTE a -- Execute wordref at addr a -IF -- I:a *I* Compiles a (fbr?) and pushes its - cell's addr -INTERPRET -- Get a line from stdin, compile it in tmp - memory, then execute the compiled - contents. -QUIT R:drop -- Return to interpreter prompt immediately -RECURSE R:I -- R:I-2 Run the current word again. -THEN I:a -- *I* Set branching cell at a. (cont.) +(br) -- Branches by the number specified in the 2 + following bytes. Can be negative. +(?br) f -- Branch if f is false. +( -- *I* Comment. Ignore input until ")" is read. +[ -- Begin interpretative mode. In a definition, + execute words instead of compiling them. +] -- End interpretative mode. +ABORT -- Resets PS and RS and returns to interpreter. +ABORT" x" -- *I* Compiles a ." followed by a ABORT. +EXECUTE a -- Execute wordref at addr a +INTERPRET -- Get a line from stdin, compile it in tmp memory, + then execute the compiled contents. +QUIT -- Return to interpreter prompt immediately +EXIT! -- Exit current INTERPRET loop. diff --git a/blk/044 b/blk/044 index 3b70fae..e69de29 100644 --- a/blk/044 +++ b/blk/044 @@ -1,4 +0,0 @@ -(cont.) -UNTIL f -- *I* Jump backwards to BEGIN if f is - false. -EXIT! -- Exit current INTERPRET loop. diff --git a/forth/core.fs b/forth/core.fs index 9feab9c..6c308af 100644 --- a/forth/core.fs +++ b/forth/core.fs @@ -55,6 +55,27 @@ H@ 2- ( push a. -2 for allot offset ) ; IMMEDIATE +( During a CASE, the stack grows by 1 at each ENDOF so that + we can fill all those ENDOF branching addrs. So that we + know when to stop, we put a 0 on PSP. That's our stopgap. ) +: CASE 0 ; IMMEDIATE +: OF + COMPILE OVER COMPILE = + [COMPILE] IF +; IMMEDIATE +: ENDOF [COMPILE] ELSE ; IMMEDIATE + +( At this point, we have something like "0 e1 e2 e3 val". We + want top drop val, and then call THEN as long as we don't + hit 0. ) +: ENDCASE + BEGIN + DUP NOT IF DROP EXIT THEN + [COMPILE] THEN + AGAIN + COMPILE DROP +; IMMEDIATE + : CREATE (entry) ( empty header with name ) 11 ( 11 == cellWord ) diff --git a/tests/forth/test_flow.fs b/tests/forth/test_flow.fs new file mode 100644 index 0000000..b67a9de --- /dev/null +++ b/tests/forth/test_flow.fs @@ -0,0 +1,13 @@ +: foo + CASE + 'X' OF 42 ENDOF + 0x12 OF 43 ENDOF + 255 OF 44 ENDOF + 45 + ENDCASE +; + +'X' foo 42 #eq +0x12 foo 43 #eq +255 foo 44 #eq +254 foo 45 #eq