forth: add label system to z80 assembler

forth/z80a.fs

@@ -5,8 +5,58 @@
     256 /MOD SWAP
 ;
 
+( A, spits an assembled byte, A,, spits an assembled word )
 ( To debug, change C, to .X )
 : A, C, ;
+: A,, SPLITB A, A, ;
+
+( 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. )
+
+(sysv) L1
+(sysv) L2
+(sysv) L3
+(sysv) L4
+
+( 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.
+)
+
+: BSET H@ SWAP ! ;
+: BWR @ H@ - 1 - A, ;
+( same as BSET, but we need to write a placeholder )
+: FWR BSET 0 A, ;
+: FSET @ DUP H@ -^ 1 - SWAP C! ;
+
+
+( "r" register constants )
 7 CONSTANT A
 0 CONSTANT B
 1 CONSTANT C
@@ -15,6 +65,8 @@
 4 CONSTANT H
 5 CONSTANT L
 6 CONSTANT (HL)
+
+( "ss" register constants )
 0 CONSTANT BC
 1 CONSTANT DE
 2 CONSTANT HL
@@ -38,6 +90,7 @@
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
 0xeb OP1 EXDEHL,
+0xd9 OP1 EXX,
 0x76 OP1 HALT,
 0xe9 OP1 JP(HL),
 0x12 OP1 LD(DE)A,
@@ -49,6 +102,19 @@
 0x0f OP1 RRCA,
 0x37 OP1 SCF,
 
+( Relative jumps are a bit special. They're supposed to take
+  an argument, but they don't take it so they can work with
+  the label system. Therefore, relative jumps are an OP1 but
+  when you use them, you're expected to write the offset
+  afterwards yourself. )
+
+0x18 OP1 JR,
+0x38 OP1 JRC,
+0x30 OP1 JRNC,
+0x28 OP1 JRZ,
+0x20 OP1 JRNZ,
+0x10 OP1 DJNZ,
+
 ( r -- )
 : OP1r
     CREATE C,
@@ -72,6 +138,7 @@
 0xb0 OP1r0 ORr,
 0xa8 OP1r0 XORr,
 0xb8 OP1r0 CPr,
+0x90 OP1r0 SUBr
 
 ( qq -- also works for ss )
 : OP1qq
@@ -200,7 +267,7 @@
     ROT             ( nn op dd )
     <<4             ( nn op dd<<4 )
     OR A,
-    SPLITB A, A,
+    A,,
 ;
 0x01 OP3ddnn LDddnn,
 
@@ -209,39 +276,27 @@
     CREATE C,
     DOES>
     C@ A,
-    SPLITB A, A,
+    A,,
 ;
 0xcd OP3nn CALLnn,
 0xc3 OP3nn JPnn,
 0x22 OP3nn LD(nn)HL,
 0x2a OP3nn LDHL(nn),
 
-: OPJR
-    CREATE C,
-    DOES>
-    C@ A, 2 - A,
-;
-0x18 OPJR JRe,
-0x38 OPJR JRCe,
-0x30 OPJR JRNCe,
-0x28 OPJR JRZe,
-0x20 OPJR JRNZe,
-0x10 OPJR DJNZe,
-
 ( Specials )
 
 ( dd nn -- )
 : LDdd(nn),
     0xed A,
     SWAP <<4 0x4b OR A,
-    SPLITB A, A,
+    A,,
 ;
 
 ( nn dd -- )
 : LD(nn)dd,
     0xed A,
     <<4 0x43 OR A,
-    SPLITB A, A,
+    A,,
 ;
 
 ( 26 == next )

forth/z80c.fs

@@ -155,10 +155,10 @@ CODE NOT
     A L LDrr,
     H ORr,
     HL 0 LDddnn,
-    3 JRNZe, ( skip)
+    JRNZ, L1 FWR ( skip )
     ( false, make 1 )
     HL INCss,
-( skip )
+L1 FSET ( skip )
     HL PUSHqq,
 ;CODE
 
@@ -190,13 +190,13 @@ CODE *
     HL ADDHLss,
     E RLr,
     D RLr,
-    6 JRNCe, ( noinc )
+    JRNC, 4 A, ( noinc )
     BC ADDHLss,
-    3 JRNCe, ( noinc )
+    JRNC, 1 A, ( noinc )
     DE INCss,
 ( noinc )
     A DECr,
-    -12 JRNZe, ( loop )
+    JRNZ, -14 A, ( loop )
     HL PUSHqq,
 ;CODE
 
@@ -210,17 +210,17 @@ CODE /MOD
     A B LDrr,
     B 16 LDrn,
     HL 0 LDddnn,
-( loop )
+L1 BSET ( loop )
     SCF,
     C RLr,
     RLA,
     HL ADCHLss,
     DE SBCHLss,
-    4 JRNCe,  ( skip )
+    JRNC, L2 FWR ( skip )
     DE ADDHLss,
     C DECr,
-( skip )
+L2 FSET ( skip )
-    -12 DJNZe, ( loop )
+    DJNZ, L1 BWR ( loop )
     B A LDrr,
     HL PUSHqq,
     BC PUSHqq,
@@ -318,9 +318,9 @@ CODE IMMED?
     HL DECss,
     DE 0 LDddnn,
     7 (HL) BITbr,
-    3 JRZe, ( notset )
+    JRZ, L1 FWR ( notset )
     DE INCss,
-( notset )
+L1 FSET ( notset )
     DE PUSHqq,
 ;CODE
 
@@ -342,15 +342,16 @@ CODE SCMP
     DE  POPqq,
     HL  POPqq,
     chkPS,
-( loop )
+L1 BSET ( loop )
     LDA(DE),
     (HL) CPr,
-    7 JRNZe, ( not equal? break early to "end". NZ is set. )
+    JRNZ, L2 FWR ( not equal? break early to "end".
+                   NZ is set. )
     A ORr,   ( if our char is null, stop )
     HL INCss,
     DE INCss,
-    -7 JRNZe, ( loop )
+    JRNZ, L1 BWR ( loop )
-( end )
+L2 FSET ( end )
     ( 40 == flagsToBC )
     40 CALLnn,
     BC PUSHqq,
@@ -372,13 +373,13 @@ CODE (parsed)
     chkPS,
     ( 60 == parseDecimal )
     60 CALLnn,
-    10 JRZe, ( success )
+    JRZ, L1 FWR ( success )
     ( error )
     DE 0 LDddnn,
     DE PUSHqq,  ( dummy )
     DE PUSHqq,  ( flag )
     JPNEXT,
-( success )
+L1 FSET ( success )
     DE PUSHqq,
     DE 1 LDddnn,
     DE PUSHqq,
@@ -389,13 +390,13 @@ CODE (find)
     chkPS,
     ( 3 == find )
     3 CALLnn,
-    10 JRZe, ( found )
+    JRZ, L1 FWR ( found )
     ( not found )
     HL PUSHqq,
     DE 0 LDddnn,
     DE PUSHqq,
     JPNEXT,
-( found )
+L1 FSET ( found )
     DE PUSHqq,
     DE 1 LDddnn,
     DE PUSHqq,
@@ -406,14 +407,14 @@ CODE SCPY
     chkPS,
     DE HERE LDdd(nn),
     B 0 LDrn,
-( loop )
+L1 BSET ( loop )
     A (HL) LDrr,
     LD(DE)A,
     HL INCss,
     DE INCss,
     B INCr,
     A ORr,
-    -6 JRNZe, ( loop )
+    JRNZ, L1 BWR ( loop )
     DE A LD(dd)r
     HERE DE LD(nn)dd,
 ;CODE