Add CASE..OF words

They changed in my earlier commit.

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
+f IF A ELSE B THEN: if f is true, execute A, if false, execute
-           bytes. Can be negative.
+B. ELSE is optional.
-(?br) f -- Branch if f is false.
+BEGIN .. f UNTIL: if f is false, branch to BEGIN.
-(     --   *I* Comment. Ignore rest of line until ")" is read.
+BEGIN .. AGAIN: Always branch to BEGIN.
-[     --   Begin interpretative mode. In a definition, words
+x y DO .. LOOP: LOOP increments y. if y != x, branch to DO.
-           between here and "]" will be executed instead of
+x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute
-           compiled.
+A, if x == z, execute B. Otherwise, execute C.
-]     --   End interpretative mode.
+
-ABORT --   Resets PS and RS and returns to interpreter. (cont.)
+                                                        (cont.)

blk/043

@@ -1,16 +1,15 @@
 (cont.)
-ABORT" x" --           *I* Compiles a ." followed by a ABORT.
+(br)      --   Branches by the number specified in the 2
-AGAIN     I:a --       *I* Jump backwards to preceeding BEGIN.
+               following bytes. Can be negative.
-BEGIN     -- I:a       *I* Marker for backward branching with
+(?br)     f -- Branch if f is false.
-                       AGAIN.
+(         --   *I* Comment. Ignore input until ")" is read.
-ELSE      I:a --       *I* Compiles a (fbr) and set branching
+[         --   Begin interpretative mode. In a definition,
-                       cell at a.
+               execute words instead of compiling them.
-EXECUTE   a --         Execute wordref at addr a
+]         --   End interpretative mode.
-IF        -- I:a       *I* Compiles a (fbr?) and pushes its
+ABORT     --   Resets PS and RS and returns to interpreter.
-                       cell's addr
+ABORT" x" --   *I* Compiles a ." followed by a ABORT.
-INTERPRET --           Get a line from stdin, compile it in tmp
+EXECUTE   a -- Execute wordref at addr a
-                       memory, then execute the compiled
+INTERPRET --   Get a line from stdin, compile it in tmp memory,
-                       contents.
+               then execute the compiled contents.
-QUIT      R:drop --    Return to interpreter prompt immediately
+QUIT      --   Return to interpreter prompt immediately
-RECURSE   R:I -- R:I-2 Run the current word again.
+EXIT!     --   Exit current INTERPRET loop.
-THEN      I:a --       *I* Set branching cell at a.     (cont.)

blk/044

@@ -1,4 +0,0 @@
-(cont.)
-UNTIL     f --         *I* Jump backwards to BEGIN if f is
-                       false.
-EXIT!     --           Exit current INTERPRET loop.

drv/acia.fs

@@ -29,7 +29,7 @@ ACIA_MEM: Address in memory that can be used variables shared
 
 : ACIA$
     H@ DUP DUP ACIA( ! ACIAR> !
-    1 + ACIAW> ! ( write index starts one position later )
+    1+ ACIAW> ! ( write index starts one position later )
     ACIABUFSZ ALLOT
     H@ ACIA) !
 ( setup ACIA
@@ -49,7 +49,7 @@ ACIA_MEM: Address in memory that can be used variables shared
 
 : KEY
     ( inc then fetch )
-    ACIAR> @ 1 + DUP ACIA) @ = IF
+    ACIAR> @ 1+ DUP ACIA) @ = IF
         DROP ACIA( @
     THEN
 

drv/acia.z80

@@ -20,37 +20,38 @@ ACIA_MEM
 	( Read our character from ACIA into our BUFIDX )
     ACIA_CTL INAn,
     0x01 ANDn,   ( is ACIA rcv buf full? )
-    JRZ, L2 FWR ( end, no, wrong interrupt cause. )
+    IFNZ,
+        ( correct interrupt cause )
+        ( +2 == ACIAW> )
+        ACIA_MEM 2+ LDHL(nn),
+        ( is it == to ACIAR>? )
+        ( +0 == ACIAR> )
+        DE ACIA_MEM LDdd(nn),
+        ( carry cleared from ANDn above )
+        DE SBCHLss,
+        IFNZ, ( buffer full? )
+            ( no, continue )
+            DE ADDHLss, ( restore ACIAW> )
+            ( buffer not full, let's write )
+            ACIA_IO INAn,
+            (HL) A LDrr,
 
-    ( +2 == ACIAW> )
+            ( advance W> )
-    ACIA_MEM 2 + LDHL(nn),
+            HL INCss,
-    ( is it == to ACIAR>? )
+            ( +2 == ACIAW> )
-    ( +0 == ACIAR> )
+            ACIA_MEM 2+ LD(nn)HL,
-    DE ACIA_MEM LDdd(nn),
+            ( +6 == ACIA) )
-    ( carry cleared from ANDn above )
+            DE ACIA_MEM 6 + LDdd(nn),
-    DE SBCHLss,
+            DE SUBHLss,
-    JRZ, L3 FWR ( end, buffer full )
+            IFZ, ( end of buffer reached? )
-
+                ( yes )
-    DE ADDHLss, ( restore ACIAW> )
+                ( +4 == ACIA( )
-    ( buffer not full, let's write )
+                ACIA_MEM 4 + LDHL(nn),
-    ACIA_IO INAn,
+                ( +2 == ACIAW> )
-    (HL) A LDrr,
+                ACIA_MEM 2+ LD(nn)HL,
-
+            THEN,
-    ( advance W> )
+        THEN,
-    HL INCss,
+    THEN,
-    ( +2 == ACIAW> )
-    ACIA_MEM 2 + LD(nn)HL,
-    ( +6 == ACIA) )
-    DE ACIA_MEM 6 + LDdd(nn),
-    DE SUBHLss,
-    JRNZ, L4 FWR ( skip )
-    ( end of buffer reached )
-    ( +4 == ACIA( )
-    ACIA_MEM 4 + LDHL(nn),
-    ( +2 == ACIAW> )
-    ACIA_MEM 2 + LD(nn)HL,
-L4 FSET ( skip )
-L3 FSET L2 FSET ( end )
 
     DE POPqq,
     HL POPqq,

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 )

forth/link.fs

@@ -27,7 +27,7 @@
 : ASKIP
     DUP @       ( a n )
     ( ?br or br or NUMBER )
-    DUP <>{ 0x70 &= 0x58 |= 0x20 |= 0x24 |= <>}
+    DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
     IF DROP 4 + EXIT THEN
     ( regular word )
     0x22 = NOT IF 2+ EXIT THEN
@@ -155,9 +155,9 @@
       as variable space. )
     4 +                         ( u+4 )
     DUP H@ +                    ( u we )
-    DUP .X LF
+    DUP .X CRLF
     SWAP CURRENT @ +            ( we wr )
-    DUP .X LF
+    DUP .X CRLF
     BEGIN                       ( we wr )
         DUP ROT                 ( wr wr we )
         ( call RLWORD. we need a sig: ol o wr we )
@@ -174,7 +174,7 @@
         ( Are we finished? We're finished if wr-4 <= H@ )
         DUP 4 - H@ <=
     UNTIL
-    H@ 4 + .X LF
+    H@ 4 + .X CRLF
 ;
 
 ( Relink a regular Forth full interpreter. )

recipes/rc2014/README.md

@@ -169,7 +169,7 @@ same (`8d60`), the end offset depends on the situation.
 
 If you look at data between `99f6` and `9a3c`, you'll see that this data is not
 100% dictionary entry material. Some of it is buffer data allocated at
-initialization. To locate the end of a word, look for `0043`, the address for
+initialization. To locate the end of a word, look for `0042`, the address for
 `EXIT`. In my case, it's at `9a1a` and it's the end of the `INIT` word.
 
 Moreover, the `INIT` routine that is in there is not quite what we want,

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