forth: Word-ify "[']" and "'"

It turns out we have to...

apps/forth/core.fs

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

apps/forth/dictionary.txt

@@ -32,12 +32,14 @@ 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.
+' x         -- a            Push addr of word x to a. If not found, aborts
 ['] x       --              *I* Like "'", but spits the addr as a number
-                            literal.
+                            literal. If not found, aborts.
 (           --              *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.
@@ -73,6 +75,8 @@ 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.
@@ -121,6 +125,8 @@ 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
@@ -144,7 +150,12 @@ 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,10 +2,6 @@
 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
-chkPSRS:
+chkRS:
 	push	ix \ pop hl
 	push	de		; --> lvl 1
 	ld	de, RS_ADDR
 	or	a		; clear carry
 	sbc	hl, de
 	pop	de		; <-- lvl 1
-	jr	c, .underflow
+	jp	c, abortUnderflow
+	ret
+
+chkPS:
+	push	hl
 	ld	hl, (INITIAL_SP)
-	; We have the return address for this very call on the stack. Let's
+	; We have the return address for this very call on the stack and
-	; compensate
+	; protected registers. Let's compensate
+	dec	hl \ dec hl
 	dec	hl \ dec hl
 	or	a		; clear carry
 	sbc	hl, sp
+	pop	hl
 	ret	nc		; (INITIAL_SP) >= SP? good
-.underflow:
+	jp	abortUnderflow
-	; underflow
-	ld	hl, .msg
-	call	printstr
-	jp	abort
-.msg:
-	.db "stack underflow", 0

apps/forth/util.asm

@@ -1,3 +1,331 @@
+; *** 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)
@@ -215,12 +543,12 @@ HLPointsUNWORD:
 	pop	hl
 	ret
 
-; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise
+; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
 flagsToBC:
 	ld	bc, 0
 	ret	z	; equal
 	inc	bc
-	ret	c	; >
+	ret	m	; >
 	; <
 	dec	bc
 	dec	bc

emul/forth/glue0.asm

@@ -23,10 +23,6 @@
 .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,10 +14,6 @@
 .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"