forth/forth.asm

@@ -296,8 +296,6 @@ strskip:
 parseDecimal:
 	; First char is special: it has to succeed.
 	ld	a, (hl)
-	cp	'-'
-	jr	z, .negative
 	; Parse the decimal char at A and extract it's 0-9 numerical value. Put the
 	; result in A.
 	; On success, the carry flag is reset. On error, it is set.
@@ -351,19 +349,6 @@ parseDecimal:
 	cp	a	; ensure Z
 	ret
 
-.negative:
-	inc	hl
-	call	parseDecimal
-	ret	nz
-	push	hl	; --> lvl 1
-	or	a	; clear carry
-	ld	hl, 0
-	sbc	hl, de
-	ex	de, hl
-	pop	hl	; <-- lvl 1
-	xor	a	; set Z
-	ret
-
 ; *** Support routines ***
 ; Find the entry corresponding to word where (HL) points to and sets DE to
 ; point to that entry.
@@ -1328,9 +1313,39 @@ R2P:
 	push	hl
 	jp	next
 
+	.db	"I"
+	.dw	$-R2P
+	.db	1
+I:
+	.dw	nativeWord
+	ld	l, (ix)
+	ld	h, (ix+1)
+	push	hl
+	jp	next
+
+	.db	"I'"
+	.dw	$-I
+	.db	2
+IPRIME:
+	.dw	nativeWord
+	ld	l, (ix-2)
+	ld	h, (ix-1)
+	push	hl
+	jp	next
+
+	.db	"J"
+	.dw	$-IPRIME
+	.db	1
+J:
+	.dw	nativeWord
+	ld	l, (ix-4)
+	ld	h, (ix-3)
+	push	hl
+	jp	next
+
 ; ( a b -- c ) A + B
 	.db "+"
-	.dw $-R2P
+	.dw $-J
 	.db 1
 PLUS:
 	.dw nativeWord
@@ -1355,9 +1370,35 @@ MINUS:
 	push	hl
 	jp	next
 
+; ( a b -- c ) A * B
+	.db "*"
+	.dw $-MINUS
+	.db 1
+MULT:
+	.dw nativeWord
+	pop	de
+	pop	bc
+	call	chkPS
+	; DE * BC -> DE (high) and HL (low)
+	ld	hl, 0
+	ld	a, 0x10
+.loop:
+	add	hl, hl
+	rl	e
+	rl	d
+	jr	nc, .noinc
+	add	hl, bc
+	jr	nc, .noinc
+	inc	de
+.noinc:
+	dec a
+	jr	nz, .loop
+	push	hl
+	jp	next
+
 ; ( a1 a2 -- b )
 	.db "SCMP"
-	.dw $-MINUS
+	.dw $-MULT
 	.db 4
 SCMP:
 	.dw nativeWord

forth/z80a.fs

@@ -26,12 +26,6 @@
   extra 0xdd / 0xfd and then spit the equivalent of HL )
 : IX 0xdd A, HL ;
 : IY 0xfd A, HL ;
-: _ix+- 0xff AND 0xdd A, (HL) ;
-: _iy+- 0xff AND 0xfd A, (HL) ;
-: IX+ _ix+- ;
-: IX- 0 -^ _ix+- ;
-: IY+ _iy+- ;
-: IY- 0 -^ _iy+- ;
 
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
@@ -83,35 +77,17 @@
 0x03 OP1qq INCss,
 0x09 OP1qq ADDHLss,
 
-: _1rr
+( rd rr )
+: OP1rr
+    CREATE C,
+    DOES>
     C@              ( rd rr op )
     ROT             ( rr op rd )
     8 *             ( rr op rd<<3 )
     OR OR A,
 ;
-
-( rd rr )
-: OP1rr
-    CREATE C,
-    DOES>
-    _1rr
-;
 0x40 OP1rr LDrr,
 
-( ixy+- HL rd )
-: LDIXYr,
-    ( dd/fd has already been spit )
-    LDrr,           ( ixy+- )
-    A,
-;
-
-( rd ixy+- HL )
-: LDrIXY,
-    ROT             ( ixy+- HL rd )
-    SWAP            ( ixy+- rd HL )
-    LDIXYr,
-;
-
 ( n -- )
 : OP2n
     CREATE C,

forth/z80c.fs

@@ -113,27 +113,6 @@ CODE XOR
     HL PUSHqq,
 ;CODE
 
-CODE *
-    DE POPqq,
-    BC POPqq,
-    chkPS,
-	( DE * BC -> DE (high) and HL (low) )
-    HL 0 LDddnn,
-    A 0x10 LDrn,
-( loop )
-    HL ADDHLss,
-    E RLr,
-    D RLr,
-    6 JRNCe, ( noinc )
-    BC ADDHLss,
-    3 JRNCe, ( noinc )
-    DE INCss,
-( noinc )
-    A DECr,
-    -12 JRNZe, ( loop )
-    HL PUSHqq,
-;CODE
-
 ( Borrowed from http://wikiti.brandonw.net/ )
 ( Divides AC by DE and places the quotient in AC and the
   remainder in HL )
@@ -154,7 +133,7 @@ CODE /MOD
     DE ADDHLss,
     C DECr,
 ( skip )
-    -12 DJNZe, ( loop )
+    0 12 - DJNZe, ( loop )
     B A LDrr,
     HL PUSHqq,
     BC PUSHqq,
@@ -189,21 +168,3 @@ CODE PC@
     L INr(C),
     HL PUSHqq,
 ;CODE
-
-CODE I
-    L 0 IX+ LDrIXY,
-    H 1 IX+ LDrIXY,
-    HL PUSHqq,
-;CODE
-
-CODE I'
-    L 2 IX- LDrIXY,
-    H 1 IX- LDrIXY,
-    HL PUSHqq,
-;CODE
-
-CODE J
-    L 4 IX- LDrIXY,
-    H 3 IX- LDrIXY,
-    HL PUSHqq,
-;CODE