Give CASE's default branch access to its input value

ref #97

blk/042

@@ -1,9 +1,9 @@
 Flow
 
-Note about flow words: flow words can only be used in
-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.
+Note that flow words can only be used in 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.
 
 f IF A ELSE B THEN: if f is true, execute A, if false, execute
 B. ELSE is optional.
@@ -11,6 +11,6 @@ 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.)
+A, if x == z, execute B. Otherwise, execute C. x is dropped
+in case of an OF match, *but it is kept if it reaches C*. You
+have to consume it to avoid PSP leak.                   (cont.)

blk/103

@@ -6,8 +6,8 @@ VARIABLE ACC
     ACC !
 ;
 : L BLK> @ _LIST ;
-: B BLK> @ 1- BLK> ! L ;
-: N BLK> @ 1+ BLK> ! L ;
+: B BLK> @ 1- BLK@ L ;
+: N BLK> @ 1+ BLK@ L ;
 
 
 

blk/201

@@ -3,13 +3,14 @@ Forth words, opcode assembly is a bit different than with a
 typical assembler. For example, what would traditionally be
 "ld a, b" would become "A B LDrr,".
 
-H@ offset at which we consider our PC 0. Used to compute PC. To
-have a proper PC, call  "H@ ORG !" at the beginning of your
-assembly process.
+BIN( is the addr at which the compiled binary will live. It is
+often 0.
 
-Labels are a convenient way of managing relative jump
-calculations. Backward labels are easy. It is only a matter or
-recording "HERE" and do subtractions. Forward labels record the
-place where we should write the offset, and then when we get to
-that point later on, the label records the offset there.
+ORG is H@ offset at which we begin spitting binary. Used to
+compute PC. To have a proper PC, call  "H@ ORG !" at the
+beginning of your assembly process. PC is H@ - ORG + BIN(.
 
+
+
+
+                                                        (cont.)

blk/202

@@ -1,13 +1,16 @@
+Labels are a convenient way of managing relative jump
+calculations. Backward labels are easy. It is only a matter or
+recording "HERE" and do subtractions. Forward labels record the
+place where we should write the offset, and then when we get to
+that point later on, the label records the offset there.
+
 To avoid using dict memory in compilation targets, we
 pre-declare label variables here, which means we have a limited
 number of it. For now, 4 ought to be enough.
 
-Flow
 
-There are 2 label types: backward and forward. For each type,
-there are two actions: set and write. Setting a label is
-declaring where it is. It has to be performed at the label's
-destination. Writing a label is writing its offset difference
-to the binary result. It has to be done right after a relative
-jump operation. Yes, labels are only for relative jumps.
 
+
+
+
+                                                        (cont.)

blk/203

@@ -1,14 +1,16 @@
+Flow
+
+There are 2 label types: backward and forward. For each type,
+there are two actions: set and write. Setting a label is
+declaring where it is. It has to be performed at the label's
+destination. Writing a label is writing its offset difference
+to the binary result. It has to be done right after a relative
+jump operation. Yes, labels are only for relative jumps.
+
 For backward labels, set happens before write. For forward
 labels, write happen before set. The write operation writes a
 dummy placeholder, and then the set operation writes the offset
 at that placeholder's address.
 
-Variable actions are expected to be called with labels in
-front of them. Example, "L2 FSET"
-
-About that "1 -": z80 relative jumps record "e-2", that is,
-the offset that *counts the 2 bytes of the jump itself*.
-Because we set the label *after* the jump OP1 itself, that's 1
-byte that is taken care of. We still need to adjust by another
-byte before writing the offset.
 
+                                                        (cont.)

blk/204

@@ -0,0 +1,10 @@
+Variable actions are expected to be called with labels in
+front of them. Example, "L2 FSET"
+
+About that "1 -": z80 relative jumps record "e-2", that is,
+the offset that *counts the 2 bytes of the jump itself*.
+Because we set the label *after* the jump OP1 itself, that's 1
+byte that is taken care of. We still need to adjust by another
+byte before writing the offset.
+
+

blk/212

@@ -1,8 +1,2 @@
-( 59 == z80a's memory )
-H@ 0x59 RAM+ !
-10 ALLOT
-
-213 LOAD 215 LOAD 216 LOAD 217 LOAD 218 LOAD 219 LOAD
-220 LOAD 222 LOAD 223 LOAD 224 LOAD 226 LOAD 228 LOAD
-230 LOAD 232 LOAD 234 LOAD 236 LOAD 238 LOAD 240 LOAD
-242 LOAD 243 LOAD 246 LOAD 247 LOAD 249 LOAD
+213 LOAD Z80A$
+215 249 LOADR

blk/213

@@ -1,7 +1,9 @@
 : Z80AMEM+ 0x59 RAM+ @ + ;
 : ORG 0 Z80AMEM+ ;
-: L1 2 Z80AMEM+ ; : L2 4 Z80AMEM+ ;
-: L3 6 Z80AMEM+ ; : L4 8 Z80AMEM+ ;
+: BIN( 2 Z80AMEM+ ;
+: L1 4 Z80AMEM+ ; : L2 6 Z80AMEM+ ;
+: L3 8 Z80AMEM+ ; : L4 10 Z80AMEM+ ;
+: Z80A$ H@ 0x59 RAM+ ! 12 ALLOT 0 BIN( ! ;
 : A 7 ; : B 0 ; : C 1 ; : D 2 ;
 : E 3 ; : H 4 ; : L 5 ; : (HL) 6 ;
 : BC 0 ; : DE 1 ; : HL 2 ; : AF 3 ; : SP AF ;

blk/215

@@ -2,7 +2,7 @@
 : SPLITB
     256 /MOD SWAP
 ;
-: PC H@ ORG @ - ;
+: PC H@ ORG @ - BIN( @ + ;
 ( A, spits an assembled byte, A,, spits an assembled word
   Both increase PC. To debug, change C, to .X )
 : A, C, ; : A,, SPLITB A, A, ;

blk/243

@@ -1,16 +1,15 @@
 : JPccnn, SWAP <<3 0xc2 OR A, A,, ;
+: BCALL, BIN( @ + CALLnn, ;
+: BJP, BIN( @ + JPnn, ;
+: BJPcc, BIN( @ + JPccnn, ;
 
-( 26 == next )
-: JPNEXT, 26 JPnn, ;
-( 29 == chkPS )
-: chkPS, 29 CALLnn, ;
+: JPNEXT, 26 BJP, ; ( 26 == next )
 
-: CODE
-    ( same as CREATE, but with native word )
+: chkPS, 29 BCALL, ; ( 29 == chkPS )
+
+: CODE ( same as CREATE, but with native word )
     (entry)
-    ( 23 == nativeWord )
-    23 C,
+    23 C, ( 23 == nativeWord )
 ;
-
 : ;CODE JPNEXT, ;
 

blk/249

@@ -4,3 +4,5 @@
 : PUSH0, BC 0 LDddnn, BC PUSHqq, ;
 : PUSH1, BC 1 LDddnn, BC PUSHqq, ;
 : PUSHZ, BC 0 LDddnn, IFZ, BC INCss, THEN, BC PUSHqq, ;
+: HLZ, A H LDrr, L ORr, ;
+: DEZ, A D LDrr, E ORr, ;

blk/284

@@ -6,7 +6,7 @@
 4 A,
 H@ XCURRENT !        ( set current tip of dict, 0x42 )
     0x17 A,          ( nativeWord )
-    0x14 CALLnn,     ( popRS )
+    0x14 BCALL,      ( popRS )
     HL PUSHqq, IY POPqq, ( --> IP )
     JPNEXT,
 

blk/286

@@ -1,8 +1,7 @@
 CODE (?br)           ( 0x67 )
     HL POPqq,
     chkPS,
-    A H LDrr,
-    L ORr,
+    HLZ,
     JRZ, L2 BWR ( BR + 2. False, branch )
     ( True, skip next 2 bytes and don't branch )
     IY INCss,

blk/289

@@ -12,5 +12,5 @@ PC ORG @ 1 + ! ( main )
 ( LATEST is a label to the latest entry of the dict. It is
   written at offset 0x08 by the process or person building
   Forth. )
-    0x08 LDHL(nn),
+    BIN( @ 0x08 + LDHL(nn),
     RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT       cont. )

blk/290

@@ -1,4 +1,4 @@
     EXDEHL,
     HL L1 @ LDddnn,
-    0x03 CALLnn,        ( 03 == find )
-    0x33 JPnn,          ( 33 == execute )
+    0x03 BCALL, ( 03 == find )
+    0x33 BJP,   ( 33 == execute )

blk/295

@@ -1,8 +1,7 @@
         ( DE contains prev offset )
         HL POPqq,           ( <-- lvl 2 )
         ( HL is prev field's addr. Is offset zero? )
-        A D LDrr,
-        E ORr,
+        DEZ,
         IFNZ,
             ( get absolute addr from offset )
             ( carry cleared from "or e" )
@@ -13,4 +12,5 @@
     JRNZ, AGAIN, ( inner-B292, try to match again )
     ( Z set? end of dict, unset Z )
 
+
                                                       ( cont. )

blk/298

@@ -2,6 +2,6 @@
 L2 BSET ( abortUnderflow )
     HL PC 7 - LDddnn,
     DE RAMSTART 0x02 + LDdd(nn),   ( RAM+02 == CURRENT )
-    0x03 CALLnn, ( find )
-    0x33 JPnn,          ( 33 == execute )
+    0x03 BCALL, ( find )
+    0x33 BJP,   ( 33 == execute )
 

blk/300

@@ -3,7 +3,7 @@ PC ORG @ 0x1b + ! ( next )
   we jump to current IP, but we also take care of increasing
   it by 2 before jumping. )
 	( Before we continue: are stacks within bounds? )
-    0x1d CALLnn, ( chkPS )
+    0x1d BCALL, ( chkPS )
     ( check RS )
     IX PUSHqq, HL POPqq,
     DE RS_ADDR LDddnn,

blk/301

@@ -3,7 +3,7 @@ PC ORG @ 0x34 + ! ( execute )
     ( DE points to wordref )
     EXDEHL,
     E (HL) LDrr,
-    D 0 LDrn,
+    D BIN( @ 256 / LDrn,
     EXDEHL,
     ( HL points to code pointer )
     DE INCss,

blk/302

@@ -4,7 +4,7 @@ PC ORG @ 0x0f + ! ( compiledWord )
   2. Set new IP to the second atom of the list
   3. Execute the first atom of the list. )
     IY PUSHqq, HL POPqq, ( <-- IP )
-    0x11 CALLnn,     ( 11 == pushRS )
+    0x11 BCALL,      ( 11 == pushRS )
     EXDEHL,          ( HL points to PFA )
     ( While we increase, dereference into DE for execute call
       later. )

blk/317

@@ -1,8 +1,7 @@
 CODE NOT
     HL POPqq,
     chkPS,
-    A L LDrr,
-    H ORr,
+    HLZ,
     PUSHZ,
 ;CODE
 

blk/326

@@ -2,12 +2,12 @@ CODE >R
     HL POPqq,
     chkPS,
     ( 17 == pushRS )
-    17 CALLnn,
+    17 BCALL,
 ;CODE
 
 CODE R>
     ( 20 == popRS )
-    20 CALLnn,
+    20 BCALL,
     HL PUSHqq,
 ;CODE
 

blk/330

@@ -3,7 +3,7 @@ CODE _find  ( cur w -- a f )
     DE POPqq,       ( cur )
     chkPS,
     ( 3 == find )
-    3 CALLnn,
+    3 BCALL,
     IFNZ,
         ( not found )
         HL PUSHqq,

blk/427

@@ -1,10 +1,10 @@
 ( 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 COMPILE >R ; IMMEDIATE
+: CASE 0 ; IMMEDIATE
 : OF
-    COMPILE I COMPILE =
-    [COMPILE] IF
+    COMPILE OVER COMPILE =
+    [COMPILE] IF COMPILE DROP
 ; IMMEDIATE
 : ENDOF [COMPILE] ELSE ; IMMEDIATE
 

blk/428

@@ -1,11 +1,9 @@
 ( 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
+  want to drop val, and then call THEN as long as we don't
   hit 0. )
 : ENDCASE
     BEGIN
-        DUP NOT IF
-            DROP COMPILE R> COMPILE DROP EXIT
-        THEN
+        DUP NOT IF DROP EXIT THEN
         [COMPILE] THEN
     AGAIN
 ; IMMEDIATE

tests/forth/test_flow.fs

@@ -3,11 +3,12 @@
         'X' OF 42 ENDOF
         0x12 OF 43 ENDOF
         255 OF 44 ENDOF
-        45
+        1+
     ENDCASE
 ;
 
 'X' foo 42 #eq
 0x12 foo 43 #eq
 255 foo 44 #eq
-254 foo 45 #eq
+254 foo 255 #eq
+'S S0 #eq