apps/forth/dict.asm

@@ -1,6 +1,5 @@
 ; A dictionary entry has this structure:
-; - 7b name (zero-padded)
+; - 8b name (zero-padded)
-; - 1b flags (bit 0: IMMEDIATE)
 ; - 2b prev pointer
 ; - 2b code pointer
 ; - Parameter field (PF)
@@ -14,8 +13,11 @@
 nativeWord:
 	jp	(iy)
 
-; Execute a list of atoms, which usually ends with EXIT.
+; Execute a compiled word containing a list of references to other words,
-; IY points to that list.
+; usually ended by a reference to EXIT.
+; A reference to a word in a compiledWord section is *not* a direct reference,
+; but a word+CODELINK_OFFSET reference. Therefore, for a code link "link",
+; (link) is the routine to call.
 compiledWord:
 	push	iy \ pop hl
 	inc	hl
@@ -51,69 +53,6 @@ doesWord:
 	push	hl \ pop iy
 	jr	compiledWord
 
-; The IF word checks the stack for zero. If it's non-zero, it does nothing and
-; allow compiledWord to continue.
-; If it's zero, it tracksback RS, advance it until it finds a ELSE, a THEN, or
-; an EXIT (not supposed to happen unless the IF is misconstructed). Whether
-; it's a ELSE or THEN, the same thing happens: we resume execution after the
-; ELSE/THEN. If it's a EXIT, we simply execute it.
-ifWord:
-	pop	hl
-	ld	a, h
-	or	l
-	jp	nz, exit	; non-zero, continue
-	; Zero, seek ELSE, THEN or EXIT. Continue to elseWord
-
-; If a ELSE word is executed, it means that the preceding IF had a non-zero
-; condition and continued execution. This means that upon encountering an ELSE,
-; we must search for a THEN or an EXIT.
-; To simplify implementation and share code with ifWord, we also match ELSE,
-; which is only possible in malformed construct. Therefore "IF ELSE ELSE" is
-; valid and interpreted as "IF ELSE THEN".
-elseWord:
-	; to save processing, we test EXIT, ELSE and THEN in the order they
-	; appear, address-wise. This way, we don't need to push/pop HL: we can
-	; SUB the difference between the words and check for zeroes.
-	call	popRS
-	; We need to save that IP somewhere. Let it be BC
-	ld	b, h
-	ld	c, l
-.loop:
-	; Whether there's a match or not, we will resume the operation at IP+2,
-	; which means that we have to increase BC anyways. Let's do it now.
-	inc	bc \ inc bc
-	call	intoHL
-	or	a		; clear carry
-	ld	de, EXIT
-	sbc	hl, de
-	jp	z, exit
-	; Not EXIT, let's continue with ELSE. No carry possible because EXIT
-	; is first word. No need to clear.
-	ld	de, ELSE-EXIT
-	sbc	hl, de
-	jr	c, .nomatch	; A word between EXIT and ELSE. No match.
-	jr	z, .match	; We have a ELSE
-	; Let's try with THEN. Again, no carry possible, C cond was handled.
-	ld	de, THEN-ELSE
-	sbc	hl, de
-	jr	z, .match	; We have a THEN
-.nomatch:
-	; Nothing matched, which means that we need to continue looking.
-	; BC is already IP+2
-	ld	h, b
-	ld	l, c
-	jr	.loop
-.match:
-	; Matched a ELSE or a THEN, which means we need to continue executing
-	; word from IP+2, which is already in BC.
-	push	bc \ pop iy
-	jp	compiledWord
-
-; This word does nothing. It's never going to be executed unless the wordlist
-; is misconstructed.
-thenWord:
-	jp	exit
-
 ; This is not a word, but a number literal. This works a bit differently than
 ; others: PF means nothing and the actual number is placed next to the
 ; numberWord reference in the compiled word list. What we need to do to fetch
@@ -132,28 +71,11 @@ numberWord:
 NUMBER:
 	.dw	numberWord
 
-; Similarly to numberWord, this is not a real word, but a string literal.
-; Instead of being followed by a 2 bytes number, it's followed by a
-; null-terminated string. This is not expected to be called in a regular
-; context. Only words expecting those literals will look for them. This is why
-; the litWord triggers abort.
-litWord:
-	call	popRS
-	call	intoHL
-	call	printstr	; let's print the word before abort.
-	ld	hl, .msg
-	call	printstr
-	jp	abort
-.msg:
-	.db "undefined word", 0
-LIT:
-	.dw	litWord
 
 ; ( R:I -- )
-	.db ";"
-	.fill 7
-	.dw 0
 EXIT:
+	.db "EXIT", 0, 0, 0, 0
+	.dw 0
 	.dw nativeWord
 ; When we call the EXIT word, we have to do a "double exit" because our current
 ; Interpreter pointer is pointing to the word *next* to our EXIT reference when,
@@ -166,45 +88,44 @@ exit:
 	call	popRS
 	; We have a pointer to a word
 	push	hl \ pop iy
-	jp	compiledWord
+	jr	compiledWord
 
 ; ( R:I -- )
-	.db "QUIT"
-	.fill 4
-	.dw EXIT
 QUIT:
+	.db "QUIT", 0, 0, 0, 0
+	.dw EXIT
 	.dw nativeWord
 quit:
-	jp	forthRdLine
+	ld	hl, FLAGS
+	set	FLAG_QUITTING, (hl)
+	jr	exit
 
-	.db "ABORT"
-	.fill 3
-	.dw QUIT
 ABORT:
+	.db "ABORT", 0, 0, 0
+	.dw QUIT
 	.dw nativeWord
 abort:
-	; Reinitialize PS (RS is reinitialized in forthInterpret
 	ld	sp, (INITIAL_SP)
-	jp	forthRdLine
+	ld	hl, .msg
+	call	printstr
+	call	printcrlf
+	jr	quit
+.msg:
+	.db " err", 0
 
+BYE:
 	.db "BYE"
 	.fill 5
 	.dw ABORT
-BYE:
 	.dw nativeWord
-	; Goodbye Forth! Before we go, let's restore the stack
+	ld	hl, FLAGS
-	ld	sp, (INITIAL_SP)
+	set	FLAG_ENDPGM, (hl)
-	; unwind stack underflow buffer
+	jp	exit
-	pop	af \ pop af \ pop af
-	; success
-	xor	a
-	ret
 
 ; ( c -- )
-	.db "EMIT"
-	.fill 4
-	.dw BYE
 EMIT:
+	.db "EMIT", 0, 0, 0, 0
+	.dw BYE
 	.dw nativeWord
 	pop	hl
 	ld	a, l
@@ -212,12 +133,13 @@ EMIT:
 	jp	exit
 
 ; ( addr -- )
-	.db "EXECUTE"
-	.db 0
-	.dw EMIT
 EXECUTE:
+	.db "EXECUTE", 0
+	.dw EMIT
 	.dw nativeWord
-	pop	iy	; is a wordref
+	pop	iy	; Points to word_offset
+	ld	de, CODELINK_OFFSET
+	add	iy, de
 executeCodeLink:
 	ld	l, (iy)
 	ld	h, (iy+1)
@@ -227,54 +149,46 @@ executeCodeLink:
 	; IY points to PFA
 	jp	(hl)	; go!
 
+DEFINE:
 	.db ":"
 	.fill 7
 	.dw EXECUTE
-DEFINE:
 	.dw nativeWord
 	call	entryhead
+	jp	nz, quit
 	ld	de, compiledWord
 	ld	(hl), e
 	inc	hl
 	ld	(hl), d
 	inc	hl
-	; At this point, we've processed the name literal following the ':'.
+	push	hl \ pop iy
-	; What's next? We have, in IP, a pointer to words that *have already
-	; been compiled by INTERPRET*. All those bytes will be copied as-is.
-	; All we need to do is to know how many bytes to copy. To do so, we
-	; skip compwords until EXIT is reached.
-	ld	(HERE), hl	; where we write compwords.
-	ld	l, (ix)
-	ld	h, (ix+1)
 .loop:
-	call	HLPointsEXIT
+	call	readword
-	jr	z, .loopend
+	jr	nz, .end
-	call	compSkip
+	call	.issemicol
+	jr	z, .end
+	call	compile
+	jp	nz, quit
 	jr	.loop
-.loopend:
+.end:
-	; At this point, HL points to EXIT compword. We'll copy it too.
+	; end chain with EXIT
-	; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
+	ld	hl, EXIT+CODELINK_OFFSET
-	ld	e, (ix)
+	call	wrCompHL
-	ld	d, (ix+1)
+	ld	(HERE), iy
-	inc	hl \ inc hl	; our +2
-	or	a		; clear carry
-	sbc	hl, de
-	ld	b, h
-	ld	c, l
-	; BC has proper count
-	ex	de, hl		; HL is our source (old RS' TOS)
-	ld	de, (HERE)	; and DE is our dest
-	ldir			; go!
-	; HL has our new RS' TOS
-	ld	(ix), l
-	ld	(ix+1), h
-	ld	(HERE), de	; update HERE
 	jp	exit
+.issemicol:
+	ld	a, (hl)
+	cp	';'
+	ret	nz
+	inc	hl
+	ld	a, (hl)
+	dec	hl
+	or	a
+	ret
 
-	.db "DOES>"
-	.fill 3
-	.dw DEFINE
 DOES:
+	.db "DOES>", 0, 0, 0
+	.dw DEFINE
 	.dw nativeWord
 	; We run this when we're in an entry creation context. Many things we
 	; need to do.
@@ -285,6 +199,8 @@ DOES:
 	; 3. exit. Because we've already popped RS, a regular exit will abort
 	;    colon definition, so we're good.
 	ld	iy, (CURRENT)
+	ld	de, CODELINK_OFFSET
+	add	iy, de
 	ld	hl, doesWord
 	call	wrCompHL
 	inc	iy \ inc iy		; cell variable space
@@ -294,10 +210,10 @@ DOES:
 	jp	exit
 
 ; ( -- c )
+KEY:
 	.db "KEY"
 	.fill 5
 	.dw DOES
-KEY:
 	.dw nativeWord
 	call	stdioGetC
 	ld	h, 0
@@ -305,28 +221,31 @@ KEY:
 	push	hl
 	jp	exit
 
-	.db "INTERPR"
-	.db 0
-	.dw KEY
 INTERPRET:
+	.db "INTERPRE"
+	.dw KEY
 	.dw nativeWord
 interpret:
-	ld	iy, COMPBUF
-.loop:
 	call	readword
-	jr	nz, .end
+	jp	nz, quit
+	ld	iy, COMPBUF
 	call	compile
-	jr	.loop
+	jp	nz, .notfound
-.end:
+	ld	hl, EXIT+CODELINK_OFFSET
-	ld	hl, QUIT
+	ld	(iy), l
-	call	wrCompHL
+	ld	(iy+1), h
 	ld	iy, COMPBUF
 	jp	compiledWord
+.notfound:
+	ld	hl, .msg
+	call	printstr
+	jp	quit
+.msg:
+	.db	"not found", 0
 
-	.db "CREATE"
-	.fill 2
-	.dw INTERPRET
 CREATE:
+	.db "CREATE", 0, 0
+	.dw INTERPRET
 	.dw nativeWord
 	call	entryhead
 	jp	nz, quit
@@ -338,25 +257,24 @@ CREATE:
 	ld	(HERE), hl
 	jp	exit
 
+HERE_:	; Caution: conflicts with actual variable name
 	.db "HERE"
 	.fill 4
 	.dw CREATE
-HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord
 	.dw HERE
 
-	.db "CURRENT"
-	.db 0
-	.dw HERE_
 CURRENT_:
+	.db "CURRENT", 0
+	.dw HERE_
 	.dw sysvarWord
 	.dw CURRENT
 
 ; ( n -- )
+DOT:
 	.db "."
 	.fill 7
 	.dw CURRENT_
-DOT:
 	.dw nativeWord
 	pop	de
 	; We check PS explicitly because it doesn't look nice to spew gibberish
@@ -368,10 +286,10 @@ DOT:
 	jp	exit
 
 ; ( n a -- )
+STORE:
 	.db "!"
 	.fill 7
 	.dw DOT
-STORE:
 	.dw nativeWord
 	pop	iy
 	pop	hl
@@ -380,10 +298,10 @@ STORE:
 	jp	exit
 
 ; ( a -- n )
+FETCH:
 	.db "@"
 	.fill 7
 	.dw STORE
-FETCH:
 	.dw nativeWord
 	pop	hl
 	call	intoHL
@@ -391,10 +309,10 @@ FETCH:
 	jp	exit
 
 ; ( a b -- b a )
+SWAP:
 	.db "SWAP"
 	.fill 4
 	.dw FETCH
-SWAP:
 	.dw nativeWord
 	pop	hl
 	ex	(sp), hl
@@ -402,10 +320,10 @@ SWAP:
 	jp	exit
 
 ; ( a -- a a )
+DUP:
 	.db "DUP"
 	.fill 5
 	.dw SWAP
-DUP:
 	.dw nativeWord
 	pop	hl
 	push	hl
@@ -413,10 +331,10 @@ DUP:
 	jp	exit
 
 ; ( a b -- a b a )
+OVER:
 	.db "OVER"
 	.fill 4
 	.dw DUP
-OVER:
 	.dw nativeWord
 	pop	hl	; B
 	pop	de	; A
@@ -426,10 +344,10 @@ OVER:
 	jp	exit
 
 ; ( a b -- c ) A + B
+PLUS:
 	.db "+"
 	.fill 7
 	.dw OVER
-PLUS:
 	.dw nativeWord
 	pop	hl
 	pop	de
@@ -438,10 +356,10 @@ PLUS:
 	jp	exit
 
 ; ( a b -- c ) A - B
+MINUS:
 	.db "-"
 	.fill 7
 	.dw PLUS
-MINUS:
 	.dw nativeWord
 	pop	de		; B
 	pop	hl		; A
@@ -451,10 +369,10 @@ MINUS:
 	jp	exit
 
 ; ( a b -- c ) A * B
+MULT:
 	.db "*"
 	.fill 7
 	.dw MINUS
-MULT:
 	.dw nativeWord
 	pop	de
 	pop	bc
@@ -463,10 +381,10 @@ MULT:
 	jp	exit
 
 ; ( a b -- c ) A / B
+DIV:
 	.db "/"
 	.fill 7
 	.dw MULT
-DIV:
 	.dw nativeWord
 	pop	de
 	pop	hl
@@ -474,86 +392,66 @@ DIV:
 	push	bc
 	jp	exit
 
-	.db "IF"
-	.fill 6
-	.dw DIV
-IF:
-	.dw ifWord
-
-	.db "ELSE"
-	.fill 4
-	.dw IF
-ELSE:
-	.dw elseWord
-
-	.db "THEN"
-	.fill 4
-	.dw ELSE
-THEN:
-	.dw thenWord
-
 ; End of native words
 
 ; ( a -- )
 ; @ .
+FETCHDOT:
 	.db "?"
 	.fill 7
-	.dw THEN
+	.dw DIV
-FETCHDOT:
 	.dw compiledWord
-	.dw FETCH
+	.dw FETCH+CODELINK_OFFSET
-	.dw DOT
+	.dw DOT+CODELINK_OFFSET
-	.dw EXIT
+	.dw EXIT+CODELINK_OFFSET
 
 ; ( n a -- )
 ; SWAP OVER @ + SWAP !
+STOREINC:
 	.db "+!"
 	.fill 6
 	.dw FETCHDOT
-STOREINC:
 	.dw compiledWord
-	.dw SWAP
+	.dw SWAP+CODELINK_OFFSET
-	.dw OVER
+	.dw OVER+CODELINK_OFFSET
-	.dw FETCH
+	.dw FETCH+CODELINK_OFFSET
-	.dw PLUS
+	.dw PLUS+CODELINK_OFFSET
-	.dw SWAP
+	.dw SWAP+CODELINK_OFFSET
-	.dw STORE
+	.dw STORE+CODELINK_OFFSET
-	.dw EXIT
+	.dw EXIT+CODELINK_OFFSET
 
 ; ( n -- )
 ; HERE +!
-	.db "ALLOT"
-	.fill 3
-	.dw STOREINC
 ALLOT:
-	.dw compiledWord
+	.db "ALLOT", 0, 0, 0
-	.dw HERE_
 	.dw STOREINC
-	.dw EXIT
+	.dw compiledWord
+	.dw HERE_+CODELINK_OFFSET
+	.dw STOREINC+CODELINK_OFFSET
+	.dw EXIT+CODELINK_OFFSET
 
 ; CREATE 2 ALLOT
-	.db "VARIABL"
-	.db 0
-	.dw ALLOT
 VARIABLE:
+	.db "VARIABLE"
+	.dw ALLOT
 	.dw compiledWord
-	.dw CREATE
+	.dw CREATE+CODELINK_OFFSET
 	.dw NUMBER
 	.dw 2
-	.dw ALLOT
+	.dw ALLOT+CODELINK_OFFSET
-	.dw EXIT
+	.dw EXIT+CODELINK_OFFSET
 
 ; ( n -- )
 ; CREATE HERE @ ! DOES> @
-	.db "CONSTAN"
-	.db 0
-	.dw VARIABLE
 CONSTANT:
+	.db "CONSTANT"
+	.dw VARIABLE
 	.dw compiledWord
-	.dw CREATE
+	.dw CREATE+CODELINK_OFFSET
-	.dw HERE_
+	.dw HERE_+CODELINK_OFFSET
-	.dw FETCH
+	.dw FETCH+CODELINK_OFFSET
-	.dw STORE
+	.dw STORE+CODELINK_OFFSET
-	.dw DOES
+	.dw DOES+CODELINK_OFFSET
-	.dw FETCH
+	.dw FETCH+CODELINK_OFFSET
-	.dw EXIT
+	.dw EXIT+CODELINK_OFFSET
+

apps/forth/dictionary.txt

@@ -1,34 +1,23 @@
 Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
-(TOS). For example, in "a b -- c d", b is TOS before, d is TOS after. "R:" means
+                (TOS). For example, in "a b -- c d", b is TOS before, d is TOS
-that the Return Stack is modified.
+                after. "R:" means that the Return Stack is modified.
 
 DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms
-that newly created word into a "does cell", that is, a regular cell ( when
+       that newly created word into a "does cell", that is, a regular cell (
-called, puts the cell's addr on PS), but right after that, it executes words
+       when called, puts the cell's addr on PS), but right after that, it
-that appear after the DOES>.
+       executes words that appear after the DOES>.
 
-"does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES> link) and
+       "does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES>
-there is no need for ALLOT in colon definition.
+       link) and there is no need for ALLOT in colon definition.
 
-At compile time, colon definition stops processing words when reaching the
+       At compile time, colon definition stops processing words when reaching
-DOES>.
+       the DOES>.
 
-Example: ": CONSTANT CREATE HERE @ ! DOES> @ ;"
+       Example: ": CONSTANT CREATE HERE @ ! DOES> @ ;"
-
-Word references (wordref): When we say we have a "word reference", it's a
-pointer to a words *code link*. For example, the label "PLUS:" in this unit is a
-word reference. Why not refer to the beginning of the word struct? Because we
-actually seldom refer to the name and prev link, except during compilation, so
-defining "word reference" this way makes the code easier to understand.
-
-Atom: A word of the type compiledWord contains, in its PF, a list of what we
-call "atoms". Those atoms are most of the time word references, but they can
-also be references to NUMBER and LIT.
 
 *** Native Words ***
 
-: x ...     --              Define a new word
+: x ... ;   --              Define a new word
-;           R:I --          Exit a colon definition
 .           n --            Print n in its decimal form
 @           a -- n          Set n to value at address a
 !           n a --          Store n in address a
@@ -37,22 +26,18 @@ also be references to NUMBER and LIT.
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
-CURRENT     -- n            Set n to wordref of last added entry.
 DOES>       --              See description at top of file
 DUP         a -- a a
-ELSE        --              Branch to THEN
 EMIT        c --            Spit char c to stdout
-EXECUTE     a --            Execute wordref at addr a
+EXECUTE     a --            Execute word at addr a
+EXIT        R:I --          Exit a colon definition
 HERE        -- a            Push HERE's address
-IF          n --            Branch to ELSE or THEN if n is zero
 QUIT        R:drop --       Return to interpreter promp immediately
 KEY         -- c            Get char c from stdin
 INTERPRET   --              Get a line from stdin, compile it in tmp memory,
                             then execute the compiled contents.
 OVER        a b -- a b a
 SWAP        a b -- b a
-THEN        --              Does nothing. Serves as a branching merker for IF
-                            and ELSE.
 
 *** Core-but-Forth Words ***
 

apps/forth/main.asm

@@ -4,20 +4,50 @@
 ; Number of bytes we keep as a padding between HERE and the scratchpad
 .equ	PADDING		0x20
 ; Max length of dict entry names
-.equ	NAMELEN		7
+.equ	NAMELEN		8
 ; Offset of the code link relative to the beginning of the word
-.equ	CODELINK_OFFSET	NAMELEN+3
+.equ	CODELINK_OFFSET	10
+; When set, the interpreter should abort parsing of current line and return to
+; prompt.
+.equ	FLAG_QUITTING	0
+; When set, the interpreter should quit
+.equ	FLAG_ENDPGM	1
 
 ; *** Variables ***
 .equ	INITIAL_SP	FORTH_RAMSTART
 .equ	CURRENT		@+2
 .equ	HERE		@+2
 .equ	INPUTPOS	@+2
+.equ	FLAGS		@+2
 ; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
-.equ	COMPBUF		@+2
+.equ	COMPBUF		@+1
 .equ	FORTH_RAMEND	@+0x40
 
 ; *** Code ***
+MAIN:
+	.dw compiledWord
+	.dw INTERPRET+CODELINK_OFFSET
+	.dw CHKEND
+
+; If FLAG_ENDPGM is set, stop the program, else, tweak the RS so that we loop.
+CHKEND:
+	.dw nativeWord
+	ld	hl, FLAGS
+	bit	FLAG_ENDPGM, (hl)
+	jr	nz, .endpgm
+	; not quitting program, are we supposed to continue parsing line?
+	ld	hl, FLAGS
+	bit	FLAG_QUITTING, (hl)
+	jr	nz, forthRdLine
+	; Not quitting line either.
+	jr	forthInterpret
+.endpgm:
+	ld	sp, (INITIAL_SP)
+	; restore stack
+	pop	af \ pop af \ pop af
+	xor	a
+	ret
+
 forthMain:
 	; STACK OVERFLOW PROTECTION:
 	; To avoid having to check for stack underflow after each pop operation
@@ -32,14 +62,16 @@ forthMain:
 	ld	hl, FORTH_RAMEND
 	ld	(HERE), hl
 forthRdLine:
+	xor	a
+	ld	(FLAGS), a
 	ld	hl, msgOk
 	call	printstr
 	call	printcrlf
 	call	stdioReadLine
 	ld	(INPUTPOS), hl
 forthInterpret:
-	ld	ix, RS_ADDR-2		; -2 because we inc-before-push
+	ld	ix, RS_ADDR
-	ld	iy, INTERPRET
+	ld	iy, MAIN
 	jp	executeCodeLink
 msgOk:
 	.db	" ok", 0

apps/forth/stack.asm

@@ -3,26 +3,25 @@
 ; PS is the most frequently used. However, this causes a problem with routine
 ; calls: because in Forth, the stack isn't balanced within each call, our return
 ; offset, when placed by a CALL, messes everything up. This is one of the
-; reasons why we need stack management routines below. IX always points to RS'
+; reasons why we need stack management routines below.
-; Top Of Stack (TOS)
 ;
 ; This return stack contain "Interpreter pointers", that is a pointer to the
 ; address of a word, as seen in a compiled list of words.
 
 ; Push value HL to RS
 pushRS:
-	inc	ix
-	inc	ix
 	ld	(ix), l
-	ld	(ix+1), h
+	inc	ix
+	ld	(ix), h
+	inc	ix
 	ret
 
 ; Pop RS' TOS to HL
 popRS:
+	dec ix
+	ld	h, (ix)
+	dec ix
 	ld	l, (ix)
-	ld	h, (ix+1)
-	dec ix
-	dec ix
 	ret
 
 ; Verifies that SP is within bounds. If it's not, call ABORT

apps/forth/util.asm

@@ -43,136 +43,14 @@ readword:
 	inc	a	; unset Z
 	ret
 
-; Sets Z if (HL) == E and (HL+1) == D
+; For DE pointing to a dict entry, set DE to point to the previous entry.
-HLPointsDE:
-	ld	a, (hl)
-	cp	e
-	ret	nz		; no
-	inc	hl
-	ld	a, (hl)
-	dec	hl
-	cp	d		; Z has our answer
-	ret
-
-
-HLPointsNUMBER:
-	push	de
-	ld	de, NUMBER
-	call	HLPointsDE
-	pop	de
-	ret
-
-HLPointsLIT:
-	push	de
-	ld	de, LIT
-	call	HLPointsDE
-	pop	de
-	ret
-
-HLPointsEXIT:
-	push	de
-	ld	de, EXIT
-	call	HLPointsDE
-	pop	de
-	ret
-
-; Skip the compword where HL is currently pointing. If it's a regular word,
-; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
-; to after null-termination.
-compSkip:
-	call	HLPointsNUMBER
-	jr	z, .isNum
-	call	HLPointsLIT
-	jr	nz, .isWord
-	; We have a literal
-	inc	hl \ inc hl
-	call	strskip
-	inc	hl		; byte after word termination
-	ret
-.isNum:
-	; skip by 4
-	inc	hl \ inc hl
-	; continue to isWord
-.isWord:
-	; skip by 2
-	inc	hl \ inc hl
-	ret
-
-; The goal of this routine is to read a string literal following the currently
-; executed words. For example, CREATE and DEFINE need this. Things are a little
-; twisted, so bear with me while I explain how it works.
-;
-; When we call this routine, everything has been compiled. We're on an atom and
-; we're executing it. Now, we're looking for a string literal or a word-with-a
-; name that follows our readCompWord caller. We could think that this word is
-; right there on RS' TOS, but no! You have to account for words wrapping the
-; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
-; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
-; "CREATE 2 ALLOT".
-;
-; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
-; If that atom is a LIT, we're good. We make HL point to it and advance IP to
-; byte following null-termination.
-;
-; If it isn't, things get interesting: If it's a word reference, then it's
-; not an invalid literal. For example, one could want to redefine an existing
-; word. So in that case, we'll copy the word's name on the pad (it might not be
-; null-terminated) and set HL to point to it.
-; How do we know that our reference is a word reference (it could be, for
-; example, a NUMBER reference)? We check that its address is more than QUIT, the
-; second word in our dict. We don't accept EXIT because it's the termination
-; word. Yeah, it means that ";" can't be overridden...
-; If name can't be read, we abort
-readCompWord:
-	; In all cases, we want RS' BOS in HL. Let's get it now.
-	ld	hl, (RS_ADDR)
-	call	HLPointsLIT
-	jr	nz, .notLIT
-	; RS BOS is a LIT, make HL point to string, then skip this RS compword.
-	inc	hl \ inc hl	; HL now points to string itself
-	push	hl		; --> lvl 1, our result
-	call	strskip
-	inc	hl		; byte after word termination
-	ld	(RS_ADDR), hl
-	pop	hl		; <-- lvl 1, our result
-	ret
-.notLIT:
-	; Alright, not a literal, but is it a word? If it's not a number, then
-	; it's a word.
-	call	HLPointsNUMBER
-	jr	z, .notWord
-	; Not a number, then it's a word. Copy word to pad and point to it.
-	call	intoHL
-	or	a		; clear carry
-	ld	de, CODELINK_OFFSET
-	sbc	hl, de
-	; That's our return value
-	push	hl		; --> lvl 1
-	; HL now points to word offset, let'd copy it to pad
-	ex	de, hl
-	call	pad
-	ex	de, hl
-	ld	bc, NAMELEN
-	ldir
-	; null-terminate
-	xor	a
-	ld	(de), a
-	; Advance RS' BOS by 2
-	ld	hl, RS_ADDR
-	inc	(hl) \ inc (hl)
-	pop	hl		; <-- lvl 1
-	ret
-.notWord:
-	ld	hl, .msg
-	call	printstr
-	jp	abort
-.msg:
-	.db "word expected", 0
-
-; For DE being a wordref, move DE to the previous wordref.
 ; Z is set if DE point to 0 (no entry). NZ if not.
 prev:
-	dec	de \ dec de	; prev field
+	push	hl		; --> lvl 1
+	ld	hl, NAMELEN	; prev field offset
+	add	hl, de
+	ex	de, hl
+	pop	hl		; <-- lvl 1
 	call	intoDE
 	; DE points to prev. Is it zero?
 	xor	a
@@ -185,28 +63,15 @@ prev:
 ; point to that entry.
 ; Z if found, NZ if not.
 find:
-	push	hl
-	push	bc
 	ld	de, (CURRENT)
-	ld	bc, CODELINK_OFFSET
 .inner:
-	; DE is a wordref, let's go to beginning of struct
-	push	de		; --> lvl 1
-	or	a		; clear carry
-	ex	de, hl
-	sbc	hl, bc
-	ex	de, hl		; We're good, DE points to word name
 	ld	a, NAMELEN
 	call	strncmp
-	pop	de		; <-- lvl 1, return to wordref
+	ret	z		; found
-	jr	z, .end		; found
 	call	prev
 	jr	nz, .inner
 	; Z set? end of dict unset Z
 	inc	a
-.end:
-	pop	bc
-	pop	hl
 	ret
 
 ; Write compiled data from HL into IY, advancing IY at the same time.
@@ -219,58 +84,49 @@ wrCompHL:
 
 ; Compile word string at (HL) and write down its compiled version in IY,
 ; advancing IY to the byte next to the last written byte.
+; Set Z on success, unset on failure.
 compile:
 	call	find
 	jr	nz, .maybeNum
-	ex	de, hl
+	ret	nz
+	; DE is a word offset, we need a code link
+	ld	hl, CODELINK_OFFSET
+	add	hl, de
+	xor	a	; set Z
 	jr	wrCompHL
 .maybeNum:
-	push	hl		; --> lvl 1. save string addr
 	call	parseLiteral
-	jr	nz, .undef
+	ret	nz
-	pop	hl		; <-- lvl 1
 	; a valid number!
 	ld	hl, NUMBER
 	call	wrCompHL
 	ex	de, hl		; number in HL
 	jr	wrCompHL
-.undef:
+	ret	z
-	; When encountering an undefined word during compilation, we spit a
+	; unknown name
-	; reference to litWord, followed by the null-terminated word.
+	ld	hl, .msg
-	; This way, if a preceding word expect a string literal, it will read it
+	call	printstr
-	; by calling readCompWord, and if it doesn't, the routine will be
+	jp	abort
-	; called, triggering an abort.
+.msg:
-	ld	hl, LIT
+	.db "unknown name", 0
-	call	wrCompHL
-	pop	hl		; <-- lvl 1. recall string addr
-.writeLit:
-	ld	a, (hl)
-	ld	(iy), a
-	inc	hl
-	inc	iy
-	or	a
-	jr	nz, .writeLit
-	ret
-
 
 ; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
+; Set Z if name could be read, NZ if not
 entryhead:
-	call	readCompWord
+	call	readword
+	ret	nz
 	ld	de, (HERE)
 	call	strcpy
 	ex	de, hl		; (HERE) now in HL
 	ld	de, (CURRENT)
+	ld	(CURRENT), hl
 	ld	a, NAMELEN
 	call	addHL
-	xor	a		; IMMED
-	ld	(hl), a
-	inc	hl
 	ld	(hl), e
 	inc	hl
 	ld	(hl), d
 	inc	hl
-	ld	(CURRENT), hl
 	ld	(HERE), hl
 	xor	a		; set Z
 	ret