apps/forth/core.fs

@@ -47,51 +47,3 @@
 : = CMP NOT ;
 : < CMP 0 1 - = ;
 : > CMP 1 = ;
-: / /MOD SWAP DROP ;
-: MOD /MOD DROP ;
-
-( Format numbers )
-( TODO FORGET this word )
-: PUSHDGTS
-    999 SWAP        ( stop indicator )
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-    BEGIN
-    DUP 0 = IF DROP EXIT THEN
-    10 /MOD         ( r q )
-    SWAP '0' + SWAP ( d q )
-    AGAIN
-;
-
-: .               ( n -- )
-    ( handle negative )
-    ( that "0 1 -" thing is because we don't parse negative
-      number correctly yet. )
-    DUP 0 < IF '-' EMIT 0 1 - * THEN
-    PUSHDGTS
-    BEGIN
-    DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )
-    EMIT
-    AGAIN
-;
-
-: PUSHDGTS
-    999 SWAP        ( stop indicator )
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-    BEGIN
-    DUP 0 = IF DROP EXIT THEN
-    16 /MOD         ( r q )
-    SWAP            ( r q )
-    DUP 9 > IF 10 - 'a' +
-    ELSE '0' + THEN ( q d )
-    SWAP ( d q )
-    AGAIN
-;
-
-: .X              ( n -- )
-    ( For hex display, there are no negatives )
-    PUSHDGTS
-    BEGIN
-    DUP 'f' > IF DROP EXIT THEN ( stop indicator, we're done )
-    EMIT
-    AGAIN
-;

apps/forth/dict.asm

@@ -18,8 +18,7 @@
 ; IP, but we also take care of increasing it my 2 before jumping
 next:
 	; Before we continue: are stacks within bounds?
-	call	chkPS
+	call	chkPSRS
-	call	chkRS
 	ld	de, (IP)
 	ld	h, d
 	ld	l, e
@@ -159,34 +158,9 @@ abortUnknownWord:
 .msg:
 	.db	"unknown word", 0
 
-abortUnderflow:
-	ld	hl, .msg
-	jr	abortMsg
-.msg:
-	.db	"stack underflow", 0
-
-	.db	"ABORT", '"'
-	.fill	1
-	.dw	ABORT
-	.db	1		; IMMEDIATE
-ABORTI:
-	.dw	compiledWord
-	.dw	PRINTI
-	.dw	.private
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-.private:
-	.dw	nativeWord
-	ld	hl, (HERE)
-	ld	de, ABORT
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
 	.db "BYE"
 	.fill 4
-	.dw ABORTI
+	.dw ABORT
 	.db 0
 BYE:
 	.dw nativeWord
@@ -206,66 +180,19 @@ BYE:
 EMIT:
 	.dw nativeWord
 	pop	hl
-	call	chkPS
 	ld	a, l
 	call	stdioPutC
 	jp	next
 
-	.db	"(print)"
-	.dw	EMIT
-	.db	0
-PRINT:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	printstr
-	jp	next
-
-
-	.db	'.', '"'
-	.fill	5
-	.dw	PRINT
-	.db	1		; IMMEDIATE
-PRINTI:
-	.dw	nativeWord
-	ld	hl, (HERE)
-	ld	de, LIT
-	call	DEinHL
-	ex	de, hl		; (HERE) now in DE
-	ld	hl, (INPUTPOS)
-.loop:
-	ld	a, (hl)
-	or	a		; null? not cool
-	jp	z, abort
-	cp	'"'
-	jr	z, .loopend
-	ld	(de), a
-	inc	hl
-	inc	de
-	jr	.loop
-.loopend:
-	inc	hl		; inputpos to char afterwards
-	ld	(INPUTPOS), hl
-	; null-terminate LIT
-	inc	de
-	xor	a
-	ld	(de), a
-	ex	de, hl		; (HERE) in HL
-	ld	de, PRINT
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
 ; ( c port -- )
 	.db "PC!"
 	.fill 4
-	.dw PRINTI
+	.dw EMIT
 	.db 0
 PSTORE:
 	.dw nativeWord
 	pop	bc
 	pop	hl
-	call	chkPS
 	out	(c), l
 	jp	next
 
@@ -277,7 +204,6 @@ PSTORE:
 PFETCH:
 	.dw nativeWord
 	pop	bc
-	call	chkPS
 	ld	h, 0
 	in	l, (c)
 	push	hl
@@ -290,7 +216,6 @@ PFETCH:
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
-	call	chkPS
 	ld	l, (iy)
 	ld	h, (iy+1)
 	; HL points to code pointer
@@ -429,7 +354,6 @@ LITN:
 	ld	de, NUMBER
 	call	DEinHL
 	pop	de		; number from stack
-	call	chkPS
 	call	DEinHL
 	ld	(HERE), hl
 	jp	next
@@ -449,62 +373,52 @@ LITS:
 	ld	(HERE), de
 	jp	next
 
-	.db	"(find)"
+	.db	"'"
-	.fill	1
+	.fill	6
 	.dw	LITS
 	.db	0
-FIND_:
+APOS:
 	.dw	nativeWord
 	call	readword
 	call	find
-	jr	z, .found
+	jr	nz, .notfound
-	; not found
-	push	hl
-	ld	de, 0
 	push	de
 	jp	next
-.found:
+.notfound:
-	push	de
+	ld	hl, .msg
-	ld	de, 1
+	call	printstr
-	push	de
+	jp	abort
-	jp	next
+.msg:
-
+	.db	"word not found", 0
-	.db	"'"
-	.fill	6
-	.dw	FIND_
-	.db	0
-FIND:
-	.dw	compiledWord
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	FINDERR
-	.dw	EXIT
 
 	.db	"[']"
 	.fill	4
-	.dw	FIND
+	.dw	APOS
 	.db	0b01		; IMMEDIATE
-FINDI:
+APOSI:
-	.dw	compiledWord
+	.dw	nativeWord
-	.dw	FIND_
+	call	readword
-	.dw	CSKIP
+	call	find
-	.dw	FINDERR
+	jr	nz, .notfound
-	.dw	LITN
+	ld	hl, (HERE)
-	.dw	EXIT
+	push	de		; --> lvl 1
-
+	ld	de, NUMBER
-	.db	0b10		; UNWORD
+	call	DEinHL
-FINDERR:
+	pop	de		; <-- lvl 1
-	.dw	compiledWord
+	call	DEinHL
-	.dw	DROP		; Drop str addr, we don't use it
+	ld	(HERE), hl
-	.dw	LIT
+	jp	next
+.notfound:
+	ld	hl, .msg
+	call	printstr
+	jp	abort
+.msg:
 	.db	"word not found", 0
-	.dw	PRINT
-	.dw	ABORT
 
 ; ( -- c )
 	.db "KEY"
 	.fill 4
-	.dw FINDI
+	.dw APOSI
 	.db 0
 KEY:
 	.dw nativeWord
@@ -562,16 +476,31 @@ INP:
 	.dw	sysvarWord
 	.dw	INPUTPOS
 
+; ( n -- )
+	.db "."
+	.fill 6
+	.dw INP
+	.db 0
+DOT:
+	.dw nativeWord
+	pop	de
+	; We check PS explicitly because it doesn't look nice to spew gibberish
+	; before aborting the stack underflow.
+	call	chkPSRS
+	call	pad
+	call	fmtDecimalS
+	call	printstr
+	jp	next
+
 ; ( n a -- )
 	.db "!"
 	.fill 6
-	.dw INP
+	.dw DOT
 	.db 0
 STORE:
 	.dw nativeWord
 	pop	iy
 	pop	hl
-	call	chkPS
 	ld	(iy), l
 	ld	(iy+1), h
 	jp	next
@@ -585,7 +514,6 @@ CSTORE:
 	.dw nativeWord
 	pop	hl
 	pop	de
-	call	chkPS
 	ld	(hl), e
 	jp	next
 
@@ -597,7 +525,6 @@ CSTORE:
 FETCH:
 	.dw nativeWord
 	pop	hl
-	call	chkPS
 	call	intoHL
 	push	hl
 	jp	next
@@ -610,7 +537,6 @@ FETCH:
 CFETCH:
 	.dw nativeWord
 	pop	hl
-	call	chkPS
 	ld	l, (hl)
 	ld	h, 0
 	push	hl
@@ -634,7 +560,6 @@ DROP:
 SWAP:
 	.dw nativeWord
 	pop	hl
-	call	chkPS
 	ex	(sp), hl
 	push	hl
 	jp	next
@@ -649,7 +574,6 @@ SWAP2:
 	pop	de		; D
 	pop	hl		; C
 	pop	bc		; B
-	call	chkPS
 
 	ex	(sp), hl	; A in HL
 	push	de		; D
@@ -665,7 +589,6 @@ SWAP2:
 DUP:
 	.dw nativeWord
 	pop	hl
-	call	chkPS
 	push	hl
 	push	hl
 	jp	next
@@ -679,7 +602,6 @@ DUP2:
 	.dw nativeWord
 	pop	hl	; B
 	pop	de	; A
-	call	chkPS
 	push	de
 	push	hl
 	push	de
@@ -695,7 +617,6 @@ OVER:
 	.dw nativeWord
 	pop	hl	; B
 	pop	de	; A
-	call	chkPS
 	push	de
 	push	hl
 	push	de
@@ -712,7 +633,6 @@ OVER2:
 	pop	de	; C
 	pop	bc	; B
 	pop	iy	; A
-	call	chkPS
 	push	iy	; A
 	push	bc	; B
 	push	de	; C
@@ -728,7 +648,6 @@ OVER2:
 P2R:
 	.dw	nativeWord
 	pop	hl
-	call	chkPS
 	call	pushRS
 	jp	next
 
@@ -784,7 +703,6 @@ PLUS:
 	.dw nativeWord
 	pop	hl
 	pop	de
-	call	chkPS
 	add	hl, de
 	push	hl
 	jp	next
@@ -798,7 +716,6 @@ MINUS:
 	.dw nativeWord
 	pop	de		; B
 	pop	hl		; A
-	call	chkPS
 	or	a		; reset carry
 	sbc	hl, de
 	push	hl
@@ -813,36 +730,32 @@ MULT:
 	.dw nativeWord
 	pop	de
 	pop	bc
-	call	chkPS
 	call	multDEBC
 	push	hl
 	jp	next
 
-
+; ( a b -- c ) A / B
-	.db	"/MOD"
+	.db "/"
-	.fill	3
+	.fill 6
 	.dw MULT
 	.db 0
-DIVMOD:
+DIV:
 	.dw nativeWord
 	pop	de
 	pop	hl
-	call	chkPS
 	call	divide
-	push	hl
 	push	bc
 	jp	next
 
 ; ( a1 a2 -- b )
 	.db "SCMP"
 	.fill 3
-	.dw DIVMOD
+	.dw DIV
 	.db 0
 SCMP:
 	.dw nativeWord
 	pop	de
 	pop	hl
-	call	chkPS
 	call	strcmp
 	call	flagsToBC
 	push	bc
@@ -857,7 +770,6 @@ CMP:
 	.dw nativeWord
 	pop	hl
 	pop	de
-	call	chkPS
 	or	a	; clear carry
 	sbc	hl, de
 	call	flagsToBC
@@ -871,7 +783,6 @@ CMP:
 CSKIP:
 	.dw	nativeWord
 	pop	hl
-	call	chkPS
 	ld	a, h
 	or	l
 	jp	z, next		; False, do nothing.

apps/forth/dictionary.txt

@@ -32,14 +32,12 @@ directly, but as part of another word.
 "*I*" in description indicates an IMMEDIATE word.
 
 *** Defining words ***
-(find) x    -- a f          Read word x and find it in dict. If found, f=1 and
-                            a = wordref. If not found, f=0 and a = string addr.
 : x ...     --              Define a new word
 ;           R:I --          Exit a colon definition
 ,           n --            Write n in HERE and advance it.
-' x         -- a            Push addr of word x to a. If not found, aborts
+' x         -- a            Push addr of word x to a.
 ['] x       --              *I* Like "'", but spits the addr as a number
-                            literal. If not found, aborts.
+                            literal.
 (           --              *I* Comment. Ignore rest of line until ")" is read.
 ALLOT       n --            Move HERE by n bytes
 C,          b --            Write byte b in HERE and advance it.
@@ -75,8 +73,6 @@ input stream is executed immediately. In this context, branching doesn't work.
                             atom's cell.
 (bbr)       --              Branches backward by the number specified in its
                             atom's cell.
-ABORT       --              Resets PS and RS and returns to interpreter
-ABORT" x"   --              *I* Compiles a ." followed by a ABORT.
 AGAIN       I:a --          *I* Jump backwards to preceeding BEGIN.
 BEGIN       -- I:a          *I* Marker for backward branching with AGAIN.
 ELSE        I:a --          *I* Compiles a (fbr) and set branching cell at a.
@@ -125,8 +121,6 @@ H           -- a            HERE @
 -^          a b -- c        b - a -> c
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c
-MOD         a b -- c        a % b -> c
-/MOD        a b -- r q      r:remainder q:quotient
 
 *** Logic ***
 =           n1 n2 -- f      Push true if n1 == n2
@@ -150,12 +144,7 @@ wait until another line is entered.
 KEY input, however, is direct. Regardless of the input buffer's state, KEY will
 return the next typed key.
 
-(print)     a --            Print string at addr a.
 .           n --            Print n in its decimal form
-.X          n --            Print n in its hexadecimal form. In hex, numbers
-." xxx"     --              *I* Compiles string literal xxx followed by a call
-                            to (print)
-                            are never considered negative. "-1 .X -> ffff"
 EMIT        c --            Spit char c to output stream
 IN>         -- a            Address of variable containing current pos in input
                             buffer.

apps/forth/glue.asm

@@ -2,6 +2,10 @@
 jp	forthMain
 
 .inc "core.asm"
+.inc "lib/util.asm"
+.inc "lib/parse.asm"
+.inc "lib/ari.asm"
+.inc "lib/fmt.asm"
 .equ FORTH_RAMSTART RAMSTART
 .inc "forth/main.asm"
 .inc "forth/util.asm"

apps/forth/stack.asm

@@ -37,25 +37,25 @@ skipRS:
 	ret
 
 ; Verifies that SP and RS are within bounds. If it's not, call ABORT
-chkRS:
+chkPSRS:
 	push	ix \ pop hl
 	push	de		; --> lvl 1
 	ld	de, RS_ADDR
 	or	a		; clear carry
 	sbc	hl, de
 	pop	de		; <-- lvl 1
-	jp	c, abortUnderflow
+	jr	c, .underflow
-	ret
-
-chkPS:
-	push	hl
 	ld	hl, (INITIAL_SP)
-	; We have the return address for this very call on the stack and
+	; We have the return address for this very call on the stack. Let's
-	; protected registers. Let's compensate
+	; compensate
-	dec	hl \ dec hl
 	dec	hl \ dec hl
 	or	a		; clear carry
 	sbc	hl, sp
-	pop	hl
 	ret	nc		; (INITIAL_SP) >= SP? good
-	jp	abortUnderflow
+.underflow:
+	; underflow
+	ld	hl, .msg
+	call	printstr
+	jp	abort
+.msg:
+	.db "stack underflow", 0

apps/forth/util.asm

@@ -1,331 +1,3 @@
-; *** Collapse OS lib copy ***
-; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
-; Forth and the concept of ASM libs will become obsolete. To facilitate this
-; transition, I make, right now, a copy of the routines actually used by Forth's
-; native core. This also has the effect of reducing binary size right now and
-; give us an idea of Forth's compactness.
-; These routines below are copy/paste from apps/lib.
-
-; make Z the opposite of what it is now
-toggleZ:
-	jp	z, unsetZ
-	cp	a
-	ret
-
-; Copy string from (HL) in (DE), that is, copy bytes until a null char is
-; encountered. The null char is also copied.
-; HL and DE point to the char right after the null char.
-strcpyM:
-	ld	a, (hl)
-	ld	(de), a
-	inc	hl
-	inc	de
-	or	a
-	jr	nz, strcpyM
-	ret
-
-; Like strcpyM, but preserve HL and DE
-strcpy:
-	push	hl
-	push	de
-	call	strcpyM
-	pop	de
-	pop	hl
-	ret
-
-; Compares strings pointed to by HL and DE until one of them hits its null char.
-; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
-strcmp:
-	push	hl
-	push	de
-
-.loop:
-	ld	a, (de)
-	cp	(hl)
-	jr	nz, .end	; not equal? break early. NZ is carried out
-				; to the caller
-	or	a		; If our chars are null, stop the cmp
-	inc	hl
-	inc	de
-	jr	nz, .loop	; Z is carried through
-
-.end:
-	pop	de
-	pop	hl
-	; Because we don't call anything else than CP that modify the Z flag,
-	; our Z value will be that of the last cp (reset if we broke the loop
-	; early, set otherwise)
-	ret
-
-; Given a string at (HL), move HL until it points to the end of that string.
-strskip:
-	push	bc
-	ex	af, af'
-	xor	a	; look for null char
-	ld	b, a
-	ld	c, a
-	cpir	; advances HL regardless of comparison, so goes one too far
-	dec	hl
-	ex	af, af'
-	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
-
-; DE * BC -> DE (high) and HL (low)
-multDEBC:
-	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
-	ret
-
-; Parse the hex char at A and extract it's 0-15 numerical value. Put the result
-; in A.
-;
-; On success, the carry flag is reset. On error, it is set.
-parseHex:
-	; First, let's see if we have an easy 0-9 case
-
-	add 	a, 0xc6	; maps '0'-'9' onto 0xf6-0xff
-	sub 	0xf6	; maps to 0-9 and carries if not a digit
-	ret	nc
-
-	and 	0xdf		; converts lowercase to uppercase
-	add	a, 0xe9		; map 0x11-x017 onto 0xFA - 0xFF
-	sub 	0xfa		; map onto 0-6
-	ret 	c
-	; we have an A-F digit
-	add	a, 10		; C is clear, map back to 0xA-0xF
-	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
-; 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)
-	; 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.
-parseDecimalSkip:	; enter here to skip parsing the first digit
-	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
-
-; Parse string at (HL) as a hexadecimal value without the "0x" prefix and
-; return value in DE.
-; HL is advanced to the character following the last successfully read char.
-; Sets Z on success.
-parseHexadecimal:
-	ld	a, (hl)
-	call	parseHex	; before "ret c" is "sub 0xfa" in parseHex
-				; so carry implies not zero
-	ret 	c	; we need at least one char
-	push	bc
-	ld	de, 0
-	ld	b, d
-	ld	c, d
-
-; The idea here is that the 4 hex digits of the result can be represented "bdce",
-; where each register holds a single digit. Then the result is simply
-; e = (c << 4) | e,	 d = (b << 4) | d
-; However, the actual string may be of any length, so when loading in the most
-; significant digit, we don't know which digit of the result it actually represents
-; To solve this, after a digit is loaded into a (and is checked for validity),
-; all digits are moved along, with e taking the latest digit.
-.loop:
-	dec 	b
-	inc 	b	; b should be 0, else we've overflowed
-	jr	nz, .end	; Z already unset if overflow
-	ld 	b, d
-	ld 	d, c
-	ld 	c, e
-	ld 	e, a
-	inc 	hl
-	ld 	a, (hl)
-	call 	parseHex
-	jr 	nc, .loop
-	ld 	a, b
-	add	a, a  \ add a, a \ add a, a \ add a, a
-	or 	d
-	ld 	d, a
-
-	ld 	a, c
-	add	a, a  \ add a, a \ add a, a \ add a, a
-	or 	e
-	ld 	e, a
-	xor	a	; ensure z
-
-.end:
-	pop	bc
-	ret
-
-
-; Parse string at (HL) as a binary value (010101) without the "0b" prefix and
-; return value in E. D is always zero.
-; HL is advanced to the character following the last successfully read char.
-; Sets Z on success.
-parseBinaryLiteral:
-	ld	de, 0
-.loop:
-	ld	a, (hl)
-	add	a, 0xff-'1'
-	sub	0xff-1
-	jr	c, .end
-	rlc	e	; sets carry if overflow, and affects Z
-	ret	c	; Z unset if carry set, since bit 0 of e must be set
-	add	a, e
-	ld	e, a
-	inc	hl
-	jr	.loop
-.end:
-	; HL is properly set
-	xor	a		; ensure Z
-	ret
-
-; Parses the string at (HL) and returns the 16-bit value in DE. The string
-; can be a decimal literal (1234), a hexadecimal literal (0x1234) or a char
-; literal ('X').
-; HL is advanced to the character following the last successfully read char.
-;
-; As soon as the number doesn't fit 16-bit any more, parsing stops and the
-; number is invalid. If the number is valid, Z is set, otherwise, unset.
-parseLiteral:
-	ld	de, 0		; pre-fill
-	ld	a, (hl)
-	cp	0x27		; apostrophe
-	jr	z, .char
-
-	; inline parseDecimalDigit
-	add 	a, 0xc6	; maps '0'-'9' onto 0xf6-0xff
-	sub 	0xf6	; maps to 0-9 and carries if not a digit
-	ret	c
-	; a already parsed so skip first few instructions of parseDecimal
-	jp	nz, parseDecimalSkip
-	; maybe hex, maybe binary
-	inc	hl
-	ld	a, (hl)
-	inc	hl		; already place it for hex or bin
-	cp	'x'
-	jr	z, parseHexadecimal
-	cp	'b'
-	jr	z, parseBinaryLiteral
-	; nope, just a regular decimal
-	dec	hl \ dec hl
-	jp	parseDecimal
-
-; Parse string at (HL) and, if it is a char literal, sets Z and return
-; corresponding value in E. D is always zero.
-; HL is advanced to the character following the last successfully read char.
-;
-; A valid char literal starts with ', ends with ' and has one character in the
-; middle. No escape sequence are accepted, but ''' will return the apostrophe
-; character.
-.char:
-	inc	hl
-	ld	e, (hl)		; our result
-	inc	hl
-	cp	(hl)
-	; advance HL and return if good char
-	inc	hl
-	ret	z
-
-	; Z unset and there's an error
-	; In all error conditions, HL is advanced by 3. Rewind.
-	dec	hl \ dec hl \ dec hl
-	; NZ already set
-	ret
-
-; *** Forth-specific part ***
 ; Return address of scratchpad in HL
 pad:
 	ld	hl, (HERE)
@@ -543,12 +215,12 @@ HLPointsUNWORD:
 	pop	hl
 	ret
 
-; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
+; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise
 flagsToBC:
 	ld	bc, 0
 	ret	z	; equal
 	inc	bc
-	ret	m	; >
+	ret	c	; >
 	; <
 	dec	bc
 	dec	bc

emul/forth/glue0.asm

@@ -23,6 +23,10 @@
 .equ	STDIO_PUTC	emulPutC
 .inc "stdio.asm"
 
+.inc "lib/util.asm"
+.inc "lib/parse.asm"
+.inc "lib/ari.asm"
+.inc "lib/fmt.asm"
 .equ FORTH_RAMSTART STDIO_RAMEND
 .inc "forth/main.asm"
 .inc "forth/util.asm"

emul/forth/glue1.asm

@@ -14,6 +14,10 @@
 .equ	STDIO_PUTC	emulPutC
 .inc "stdio.asm"
 
+.inc "lib/util.asm"
+.inc "lib/parse.asm"
+.inc "lib/ari.asm"
+.inc "lib/fmt.asm"
 .equ FORTH_RAMSTART STDIO_RAMEND
 .inc "forth/main.asm"
 .inc "forth/util.asm"