forth: Forth-ify parseDecimal

forth/core.fs

@@ -77,9 +77,6 @@
 
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE , DOES> @ ;
-: = CMP NOT ;
-: < CMP 0 1 - = ;
-: > CMP 1 = ;
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
 

forth/forth.asm

@@ -78,7 +78,7 @@
 	.dw	PARSEPTR
 	.dw	HERE
 	.dw	CURRENT
-	jp	parseDecimal
+	nop \ nop \ nop	; unused
 	jp	doesWord
 
 ; *** Boot dict ***
@@ -186,87 +186,6 @@ forthMain:
 .bootName:
 	.db	"BOOT", 0
 
-; 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
-; 2 - The number overflows from 16-bit
-; HL is advanced to the character following the last successfully read char.
-; Error conditions are:
-; 1 - There wasn't at least one character that could be read.
-; 2 - Overflow.
-; Sets Z on success, unset on error.
-
-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.
-	add	a, 0xff-'9'	; maps '0'-'9' onto 0xf6-0xff
-	sub	0xff-9		; maps to 0-9 and carries if not a digit
-	ret	c		; Error. If it's C, it's also going to be NZ
-	; During this routine, we switch between HL and its shadow. On one side,
-	; we have HL the string pointer, and on the other side, we have HL the
-	; numerical result. We also use EXX to preserve BC, saving us a push.
-	exx		; HL as a result
-	ld	h, 0
-	ld	l, a	; load first digit in without multiplying
-
-.loop:
-	exx		; HL as a string pointer
-	inc hl
-	ld a, (hl)
-	exx		; HL as a numerical result
-
-	; same as other above
-	add	a, 0xff-'9'
-	sub	0xff-9
-	jr	c, .end
-
-	ld	b, a	; we can now use a for overflow checking
-	add	hl, hl	; x2
-	sbc	a, a	; a=0 if no overflow, a=0xFF otherwise
-	ld	d, h
-	ld	e, l		; de is x2
-	add	hl, hl	; x4
-	rla
-	add	hl, hl	; x8
-	rla
-	add	hl, de	; x10
-	rla
-	ld	d, a	; a is zero unless there's an overflow
-	ld	e, b
-	add	hl, de
-	adc	a, a	; same as rla except affects Z
-	; Did we oveflow?
-	jr	z, .loop	; No? continue
-	; error, NZ already set
-	exx		; HL is now string pointer, restore BC
-	; HL points to the char following the last success.
-	ret
-
-.end:
-	push	hl	; --> lvl 1, result
-	exx		; HL as a string pointer, restore BC
-	pop	de	; <-- lvl 1, result
-	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
-
 ; Find the entry corresponding to word where (HL) points to and sets DE to
 ; point to that entry.
 ; Z if found, NZ if not.
@@ -503,7 +422,7 @@ litWord:
 	ld	(IP), hl
 	jp	next
 
-.fill 20
+.fill 84
 ; *** Dict hook ***
 ; This dummy dictionary entry serves two purposes:
 ; 1. Allow binary grafting. Because each binary dict always end with a dummy

forth/icore.fs

@@ -82,6 +82,43 @@
 
 : ABORT _c (resSP) _c QUIT ;
 
+: = _c CMP _c NOT ;
+: < _c CMP -1 _c = ;
+: > _c CMP 1 _c = ;
+
+: (parsed)      ( a -- n f )
+    ( read first char outside of the loop. it *has* to be
+      nonzero. )
+    _c DUP _c C@                    ( a c )
+    _c DUP _c NOT IF EXIT THEN      ( a 0 )
+    ( special case: do we have a negative? )
+    _c DUP '-' _c = IF
+        ( Oh, a negative, let's recurse and reverse )
+        _c DROP 1 _c +                  ( a+1 )
+        _c (parsed)                     ( n f )
+        _c SWAP 0 _c SWAP               ( f 0 n )
+        _c - _c SWAP EXIT               ( 0-n f )
+    THEN
+    ( running result, staring at zero )
+    0 _c SWAP                               ( a r c )
+    ( Loop over chars )
+    BEGIN
+    ( parse char )
+    '0' _c -
+    ( if bad, return "a 0" )
+    _c DUP 0 _c < IF _c 2DROP 0 EXIT THEN   ( bad )
+    _c DUP 9 _c > IF _c 2DROP 0 EXIT THEN   ( bad )
+    ( good, add to running result )
+    _c SWAP 10 _c * _c +                    ( a r*10+n )
+    _c SWAP 1 _c + _c SWAP                  ( a+1 r )
+    ( read next char )
+    _c OVER _c C@
+    _c DUP _c NOT UNTIL
+    ( we're done and it's a success. We have "a r c", we want
+      "r 1". )
+    _c DROP _c SWAP _c DROP 1
+;
+
 ( This is only the "early parser" in earlier stages. No need
   for an abort message )
 : (parse)

forth/z80a.fs

@@ -73,6 +73,16 @@
 3 CONSTANT AF
 3 CONSTANT SP
 
+( "cc" condition constants )
+0 CONSTANT CNZ
+1 CONSTANT CZ
+2 CONSTANT CNC
+3 CONSTANT CC
+4 CONSTANT CPO
+5 CONSTANT CPE
+6 CONSTANT CP
+7 CONSTANT CM
+
 ( As a general rule, IX and IY are equivalent to spitting an
   extra 0xdd / 0xfd and then spit the equivalent of HL )
 : IX 0xdd A, HL ;
@@ -126,6 +136,8 @@
 ;
 0x04 OP1r INCr,
 0x05 OP1r DECr,
+( also works for cc )
+0xc0 OP1r RETcc,
 
 ( r -- )
 : OP1r0
@@ -134,11 +146,14 @@
     C@              ( r op )
     OR A,
 ;
+0x80 OP1r0 ADDr,
+0x88 OP1r0 ADCr,
 0xa0 OP1r0 ANDr,
-0xb0 OP1r0 ORr,
-0xa8 OP1r0 XORr,
 0xb8 OP1r0 CPr,
-0x90 OP1r0 SUBr
+0xb0 OP1r0 ORr,
+0x90 OP1r0 SUBr,
+0x98 OP1r0 SBCr,
+0xa8 OP1r0 XORr,
 
 ( qq -- also works for ss )
 : OP1qq
@@ -192,6 +207,8 @@
 ;
 0xd3 OP2n OUTnA,
 0xdb OP2n INAn,
+0xc6 OP2n ADDn,
+0xd6 OP2n SUBn,
 
 ( r n -- )
 : OP2rn

forth/z80c.fs

@@ -368,23 +368,6 @@ CODE CMP
     BC PUSHqq,
 ;CODE
 
-CODE (parsed)
-    HL POPqq,
-    chkPS,
-    ( 60 == parseDecimal )
-    60 CALLnn,
-    JRZ, L1 FWR ( success )
-    ( error )
-    DE 0 LDddnn,
-    DE PUSHqq,  ( dummy )
-    DE PUSHqq,  ( flag )
-    JPNEXT,
-L1 FSET ( success )
-    DE PUSHqq,
-    DE 1 LDddnn,
-    DE PUSHqq,
-;CODE
-
 CODE (find)
     HL POPqq,
     chkPS,