forth/forth.asm

@@ -106,9 +106,8 @@
 ; *** 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 0x17-$
+.fill 0x1a-$
 JUMPTBL:
-	jp	nativeWord
 	jp	next
 	jp	chkPS
 
@@ -299,6 +298,35 @@ 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
@@ -754,10 +782,10 @@ ROUTINE:
 	ld	de, compiledWord
 	cp	'L'
 	jr	z, .end
-	ld	de, JUMPTBL
+	ld	de, nativeWord
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL+3
+	ld	de, JUMPTBL
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -772,7 +800,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+6
+	ld	de, JUMPTBL+3
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -1405,13 +1433,28 @@ 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	$-MULT
+	.dw	$-DIVMOD
 	.db	0
 ZERO:
 	.dw	nativeWord

forth/z80a.fs

@@ -29,13 +29,8 @@
 
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
-0x76 OP1 HALT,
 0xc9 OP1 RET,
-0x17 OP1 RLA,
+0x76 OP1 HALT,
-0x07 OP1 RLCA,
-0x1f OP1 RRA,
-0x0f OP1 RRCA,
-0x37 OP1 SCF,
 
 ( r -- )
 : OP1r
@@ -47,7 +42,6 @@
     OR A,
 ;
 0x04 OP1r INCr,
-0x05 OP1r DECr,
 0x46 OP1r LDr(HL),
 
 ( r -- )
@@ -74,7 +68,7 @@
 0xc5 OP1qq PUSHqq,
 0xc1 OP1qq POPqq,
 0x03 OP1qq INCss,
-0x09 OP1qq ADDHLss,
+0x09 OP1qq ADHLss,
 
 ( rd rr )
 : OP1rr
@@ -121,22 +115,6 @@
 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
@@ -150,18 +128,6 @@
 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,
@@ -172,7 +138,7 @@
     OR A,
     SPLITB A, A,
 ;
-0x01 OP3ddnn LDddnn,
+0x01 OP2ddnn LDddnn,
 
 ( nn -- )
 : OP3nn
@@ -184,19 +150,8 @@
 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 )
-    chkPS,
+    ROUTINE P CALLnn,
     DE PUSHqq,      ( B )
     HL PUSHqq,      ( C )
     BC PUSHqq,      ( A )
@@ -110,32 +110,6 @@ 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,