forth: Forth-ify "/MOD"

The removal of the "divide" routine highlighted the fact that
nativeWord wasn't properly stabilized.

forth/forth.asm

@@ -106,8 +106,9 @@
 ; *** Stable ABI ***
 ; Those jumps below are supposed to stay at these offsets, always. If they
 ; change bootstrap binaries have to be adjusted because they rely on them.
-.fill 0x1a-$
+.fill 0x17-$
 JUMPTBL:
+	jp	nativeWord
 	jp	next
 	jp	chkPS
 
@@ -298,35 +299,6 @@ strskip:
 	pop	bc
 	ret
 
-; Borrowed from Tasty Basic by Dimitri Theulings (GPL).
-; Divide HL by DE, placing the result in BC and the remainder in HL.
-divide:
-	push hl		; --> lvl 1
-	ld l, h		; divide h by de
-	ld h, 0
-	call .dv1
-	ld b, c		; save result in b
-	ld a, l		; (remainder + l) / de
-	pop hl		; <-- lvl 1
-	ld h, a
-.dv1:
-	ld c, 0xff	; result in c
-.dv2:
-	inc c		; dumb routine
-	call .subde	; divide using subtract and count
-	jr nc, .dv2
-	add hl, de
-	ret
-.subde:
-	ld a, l
-	sub e		; subtract de from hl
-	ld l, a
-	ld a, h
-	sbc a, d
-	ld h, a
-	ret
-
-
 ; Parse string at (HL) as a decimal value and return value in DE.
 ; Reads as many digits as it can and stop when:
 ; 1 - A non-digit character is read
@@ -782,10 +754,10 @@ ROUTINE:
 	ld	de, compiledWord
 	cp	'L'
 	jr	z, .end
-	ld	de, nativeWord
+	ld	de, JUMPTBL
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL
+	ld	de, JUMPTBL+3
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -800,7 +772,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+3
+	ld	de, JUMPTBL+6
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -1433,28 +1405,13 @@ MULT:
 	jp	next
 
 
-	.db	"/MOD"
-	.fill	3
-	.dw $-MULT
-	.db 0
-DIVMOD:
-	.dw nativeWord
-	pop	de
-	pop	hl
-	call	chkPS
-	call	divide
-	push	hl
-	push	bc
-	jp	next
-
-
 ; It might look peculiar to have specific words for "0" and "1", but although
 ; it slightly beefs ups the ASM part of the binary, this one-byte-save-per-use
 ; really adds up when we compare total size.
 
 	.db	"0"
 	.fill	6
-	.dw	$-DIVMOD
+	.dw	$-MULT
 	.db	0
 ZERO:
 	.dw	nativeWord

forth/z80a.fs

@@ -29,8 +29,13 @@
 
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
-0xc9 OP1 RET,
 0x76 OP1 HALT,
+0xc9 OP1 RET,
+0x17 OP1 RLA,
+0x07 OP1 RLCA,
+0x1f OP1 RRA,
+0x0f OP1 RRCA,
+0x37 OP1 SCF,
 
 ( r -- )
 : OP1r
@@ -42,6 +47,7 @@
     OR A,
 ;
 0x04 OP1r INCr,
+0x05 OP1r DECr,
 0x46 OP1r LDr(HL),
 
 ( r -- )
@@ -68,7 +74,7 @@
 0xc5 OP1qq PUSHqq,
 0xc1 OP1qq POPqq,
 0x03 OP1qq INCss,
-0x09 OP1qq ADHLss,
+0x09 OP1qq ADDHLss,
 
 ( rd rr )
 : OP1rr
@@ -115,6 +121,22 @@
 0x80 OP2br RESbr,
 0x40 OP2br BITbr,
 
+( bitwise rotation ops have a similar sig )
+( r -- )
+: OProt
+    CREATE C,
+    DOES>
+    0xcb A,
+    C@              ( r op )
+    OR A,
+;
+0x10 OProt RLr,
+0x00 OProt RLCr,
+0x18 OProt RRr,
+0x08 OProt RRCr,
+0x20 OProt SLAr,
+0x38 OProt SRLr,
+
 ( cell contains both bytes. MSB is spit as-is, LSB is ORed with r )
 ( r -- )
 : OP2r
@@ -128,6 +150,18 @@
 0xed41 OP2r OUT(C)r,
 0xed40 OP2r INr(C),
 
+( ss -- )
+: OP2ss
+    CREATE C,
+    DOES>
+    0xed A,
+    C@ SWAP         ( op ss )
+    16 *            ( op ss<< 4 )
+    OR A,
+;
+0x4a OP2ss ADCHLss,
+0x42 OP2ss SBCHLss,
+
 ( dd nn -- )
 : OP3ddnn
     CREATE C,
@@ -138,7 +172,7 @@
     OR A,
     SPLITB A, A,
 ;
-0x01 OP2ddnn LDddnn,
+0x01 OP3ddnn LDddnn,
 
 ( nn -- )
 : OP3nn
@@ -150,8 +184,19 @@
 0xcd OP3nn CALLnn,
 0xc3 OP3nn JPnn,
 
+: 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 )
-: JRe, 0x18 A, 2 - A, ;
 : JPNEXT, ROUTINE N [LITN] JPnn, ;
 
 : CODE

forth/z80c.fs

@@ -24,7 +24,7 @@ CODE ROT
     HL POPqq,       ( C )
     DE POPqq,       ( B )
     BC POPqq,       ( A )
-    ROUTINE P CALLnn,
+    chkPS,
     DE PUSHqq,      ( B )
     HL PUSHqq,      ( C )
     BC PUSHqq,      ( A )
@@ -110,6 +110,32 @@ CODE XOR
     HL PUSHqq,
 ;CODE
 
+( Borrowed from http://wikiti.brandonw.net/ )
+( Divides AC by DE and places the quotient in AC and the
+  remainder in HL )
+CODE /MOD
+    DE POPqq,
+    BC POPqq,
+    chkPS,
+    A B LDrr,
+    B 16 LDrn,
+    HL 0 LDddnn,
+( loop )
+    SCF,
+    C RLr,
+    RLA,
+    HL ADCHLss,
+    DE SBCHLss,
+    4 JRNCe,  ( skip )
+    DE ADDHLss,
+    C DECr,
+( skip )
+    0 12 - DJNZe, ( loop )
+    B A LDrr,
+    HL PUSHqq,
+    BC PUSHqq,
+;CODE
+
 CODE C!
     HL POPqq,
     DE POPqq,