forth: Forth-ify IF and ELSE

Now, I really need comments...

apps/forth/core.fth

@@ -1,8 +1,15 @@
+: H HERE @ ;
+: -^ SWAP - ;
 : ? @ . ;
 : +! SWAP OVER @ + SWAP ! ;
 : ALLOT HERE +! ;
 : VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE HERE @ ! DOES> @ ;
+: CONSTANT CREATE H ! DOES> @ ;
+: , H ! 2 ALLOT ;
+: C, H C! 1 ALLOT ;
+: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
+: THEN DUP H -^ SWAP C! ; IMMEDIATE
+: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
 : NOT IF 0 ELSE 1 THEN ;
 : = CMP NOT ;
 : < CMP 0 1 - = ;

apps/forth/dict.asm

@@ -1,7 +1,7 @@
 ; A dictionary entry has this structure:
 ; - 7b name (zero-padded)
-; - 1b flags (bit 0: IMMEDIATE)
 ; - 2b prev pointer
+; - 1b flags (bit 0: IMMEDIATE. bit 1: UNWORD)
 ; - 2b code pointer
 ; - Parameter field (PF)
 ;
@@ -9,6 +9,11 @@
 ; with IY pointing to the PF. They themselves are expected to end by jumping
 ; to the address at the top of the Return Stack. They will usually do so with
 ; "jp exit".
+;
+; That's for "regular" words (words that are part of the dict chain). There are
+; also "special words", for example NUMBER, LIT, FBR, that have a slightly
+; different structure. They're also a pointer to an executable, but as for the
+; other fields, the only one they have is the "flags" field.
 
 ; Execute a word containing native code at its PF address (PFA)
 nativeWord:
@@ -51,40 +56,6 @@ doesWord:
 	push	hl \ pop iy
 	jr	compiledWord
 
-; This word is followed by 1b *relative* offset (to the cell's addr) to where to
-; branch to. For example, The branching cell of "IF THEN" would contain 3. Add
-; this value to RS.
-branchWord:
-	push	de
-	ld	l, (ix)
-	ld	h, (ix+1)
-	ld	a, (hl)
-	call	addHL
-	ld	(ix), l
-	ld	(ix+1), h
-	pop	de
-	jp	exit
-
-BRANCH:
-	.dw	branchWord
-
-; Conditional branch, only branch if TOS is zero
-cbranchWord:
-	pop	hl
-	ld	a, h
-	or	l
-	jr	z, branchWord
-	; skip next byte in RS
-	ld	l, (ix)
-	ld	h, (ix+1)
-	inc	hl
-	ld	(ix), l
-	ld	(ix+1), h
-	jp	exit
-
-CBRANCH:
-	.dw	cbranchWord
-
 ; 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
@@ -102,6 +73,8 @@ numberWord:
 	ld	(ix+1), h
 	push	de
 	jp	exit
+
+	.db	0b10		; Flags
 NUMBER:
 	.dw	numberWord
 
@@ -119,6 +92,8 @@ litWord:
 	jp	abort
 .msg:
 	.db "undefined word", 0
+
+	.db	0b10		; Flags
 LIT:
 	.dw	litWord
 
@@ -143,16 +118,18 @@ exit:
 
 ; ( R:I -- )
 	.db "QUIT"
-	.fill 4
+	.fill 3
 	.dw EXIT
+	.db 0
 QUIT:
 	.dw nativeWord
 quit:
 	jp	forthRdLine
 
 	.db "ABORT"
-	.fill 3
+	.fill 2
 	.dw QUIT
+	.db 0
 ABORT:
 	.dw nativeWord
 abort:
@@ -163,8 +140,9 @@ ABORTREF:
 	.dw ABORT
 
 	.db "BYE"
-	.fill 5
+	.fill 4
 	.dw ABORT
+	.db 0
 BYE:
 	.dw nativeWord
 	; Goodbye Forth! Before we go, let's restore the stack
@@ -177,8 +155,9 @@ BYE:
 
 ; ( c -- )
 	.db "EMIT"
-	.fill 4
+	.fill 3
 	.dw BYE
+	.db 0
 EMIT:
 	.dw nativeWord
 	pop	hl
@@ -188,8 +167,9 @@ EMIT:
 
 ; ( c port -- )
 	.db "PC!"
-	.fill 5
+	.fill 4
 	.dw EMIT
+	.db 0
 PSTORE:
 	.dw nativeWord
 	pop	bc
@@ -199,8 +179,9 @@ PSTORE:
 
 ; ( port -- c )
 	.db "PC@"
-	.fill 5
+	.fill 4
 	.dw PSTORE
+	.db 0
 PFETCH:
 	.dw nativeWord
 	pop	bc
@@ -211,8 +192,8 @@ PFETCH:
 
 ; ( addr -- )
 	.db "EXECUTE"
-	.db 0
 	.dw PFETCH
+	.db 0
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -226,8 +207,9 @@ executeCodeLink:
 	jp	(hl)	; go!
 
 	.db ":"
-	.fill 7
+	.fill 6
 	.dw EXECUTE
+	.db 0
 DEFINE:
 	.dw nativeWord
 	call	entryhead
@@ -273,8 +255,9 @@ DEFINE:
 
 
 	.db "DOES>"
-	.fill 3
+	.fill 2
 	.dw DEFINE
+	.db 0
 DOES:
 	.dw nativeWord
 	; We run this when we're in an entry creation context. Many things we
@@ -296,35 +279,77 @@ DOES:
 
 
 	.db "IMMEDIA"
-	.db 0
 	.dw DOES
+	.db 0
 IMMEDIATE:
 	.dw nativeWord
 	ld	hl, (CURRENT)
 	dec	hl
-	dec	hl
-	dec	hl
-	inc	(hl)
+	set	FLAG_IMMED, (hl)
 	jp	exit
 
 ; ( n -- )
 	.db "LITERAL"
-	.db 1		; IMMEDIATE
 	.dw IMMEDIATE
+	.db 1		; IMMEDIATE
 LITERAL:
 	.dw nativeWord
-	ld	hl, (CMPDST)
+	ld	hl, (HERE)
 	ld	de, NUMBER
 	call	DEinHL
 	pop	de		; number from stack
 	call	DEinHL
-	ld	(CMPDST), hl
+	ld	(HERE), hl
 	jp	exit
 
+
+	.db	"'"
+	.fill	6
+	.dw	LITERAL
+	.db	0
+APOS:
+	.dw	nativeWord
+	call	readLITBOS
+	call	find
+	jr	nz, .notfound
+	push	de
+	jp	exit
+.notfound:
+	ld	hl, .msg
+	call	printstr
+	jp	abort
+.msg:
+	.db	"word not found", 0
+
+	.db	"[']"
+	.fill	4
+	.dw	APOS
+	.db	0b01		; IMMEDIATE
+APOSI:
+	.dw	nativeWord
+	call	readword
+	call	find
+	jr	nz, .notfound
+	ld	hl, (HERE)
+	push	de		; --> lvl 1
+	ld	de, NUMBER
+	call	DEinHL
+	pop	de		; <-- lvl 1
+	call	DEinHL
+	ld	(HERE), hl
+	jp	exit
+.notfound:
+	ld	hl, .msg
+	call	printstr
+	jp	abort
+.msg:
+	.db	"word not found", 0
+
 ; ( -- c )
 	.db "KEY"
-	.fill 5
-	.dw LITERAL
+	.fill 4
+	.dw APOSI
+	.db 0
 KEY:
 	.dw nativeWord
 	call	stdioGetC
@@ -334,8 +359,9 @@ KEY:
 	jp	exit
 
 	.db "CREATE"
-	.fill 2
+	.fill 1
 	.dw KEY
+	.db 0
 CREATE:
 	.dw nativeWord
 	call	entryhead
@@ -349,23 +375,25 @@ CREATE:
 	jp	exit
 
 	.db "HERE"
-	.fill 4
+	.fill 3
 	.dw CREATE
+	.db 0
 HERE_:	; Caution: conflicts with actual variable name
 	.dw sysvarWord
 	.dw HERE
 
 	.db "CURRENT"
-	.db 0
 	.dw HERE_
+	.db 0
 CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT
 
 ; ( n -- )
 	.db "."
-	.fill 7
+	.fill 6
 	.dw CURRENT_
+	.db 0
 DOT:
 	.dw nativeWord
 	pop	de
@@ -379,8 +407,9 @@ DOT:
 
 ; ( n a -- )
 	.db "!"
-	.fill 7
+	.fill 6
 	.dw DOT
+	.db 0
 STORE:
 	.dw nativeWord
 	pop	iy
@@ -391,8 +420,9 @@ STORE:
 
 ; ( n a -- )
 	.db "C!"
-	.fill 6
+	.fill 5
 	.dw STORE
+	.db 0
 CSTORE:
 	.dw nativeWord
 	pop	hl
@@ -402,8 +432,9 @@ CSTORE:
 
 ; ( a -- n )
 	.db "@"
-	.fill 7
+	.fill 6
 	.dw CSTORE
+	.db 0
 FETCH:
 	.dw nativeWord
 	pop	hl
@@ -413,8 +444,9 @@ FETCH:
 
 ; ( a -- c )
 	.db "C@"
-	.fill 6
+	.fill 5
 	.dw FETCH
+	.db 0
 CFETCH:
 	.dw nativeWord
 	pop	hl
@@ -425,8 +457,9 @@ CFETCH:
 
 ; ( -- a )
 	.db "LIT@"
-	.fill 4
+	.fill 3
 	.dw CFETCH
+	.db 0
 LITFETCH:
 	.dw nativeWord
 	call	readLITTOS
@@ -435,8 +468,9 @@ LITFETCH:
 
 ; ( a b -- b a )
 	.db "SWAP"
-	.fill 4
+	.fill 3
 	.dw LITFETCH
+	.db 0
 SWAP:
 	.dw nativeWord
 	pop	hl
@@ -446,8 +480,9 @@ SWAP:
 
 ; ( a b c d -- c d a b )
 	.db "2SWAP"
-	.fill 3
+	.fill 2
 	.dw SWAP
+	.db 0
 SWAP2:
 	.dw nativeWord
 	pop	de		; D
@@ -462,8 +497,9 @@ SWAP2:
 
 ; ( a -- a a )
 	.db "DUP"
-	.fill 5
+	.fill 4
 	.dw SWAP2
+	.db 0
 DUP:
 	.dw nativeWord
 	pop	hl
@@ -473,8 +509,9 @@ DUP:
 
 ; ( a b -- a b a b )
 	.db "2DUP"
-	.fill 4
+	.fill 3
 	.dw DUP
+	.db 0
 DUP2:
 	.dw nativeWord
 	pop	hl	; B
@@ -487,8 +524,9 @@ DUP2:
 
 ; ( a b -- a b a )
 	.db "OVER"
-	.fill 4
+	.fill 3
 	.dw DUP2
+	.db 0
 OVER:
 	.dw nativeWord
 	pop	hl	; B
@@ -500,8 +538,9 @@ OVER:
 
 ; ( a b c d -- a b c d a b )
 	.db "2OVER"
-	.fill 3
+	.fill 2
 	.dw OVER
+	.db 0
 OVER2:
 	.dw nativeWord
 	pop	hl	; D
@@ -518,8 +557,9 @@ OVER2:
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.fill 7
+	.fill 6
 	.dw OVER2
+	.db 0
 PLUS:
 	.dw nativeWord
 	pop	hl
@@ -530,8 +570,9 @@ PLUS:
 
 ; ( a b -- c ) A - B
 	.db "-"
-	.fill 7
+	.fill 6
 	.dw PLUS
+	.db 0
 MINUS:
 	.dw nativeWord
 	pop	de		; B
@@ -543,8 +584,9 @@ MINUS:
 
 ; ( a b -- c ) A * B
 	.db "*"
-	.fill 7
+	.fill 6
 	.dw MINUS
+	.db 0
 MULT:
 	.dw nativeWord
 	pop	de
@@ -555,8 +597,9 @@ MULT:
 
 ; ( a b -- c ) A / B
 	.db "/"
-	.fill 7
+	.fill 6
 	.dw MULT
+	.db 0
 DIV:
 	.dw nativeWord
 	pop	de
@@ -567,8 +610,9 @@ DIV:
 
 ; ( a1 a2 -- b )
 	.db "SCMP"
-	.fill 4
+	.fill 3
 	.dw DIV
+	.db 0
 SCMP:
 	.dw nativeWord
 	pop	de
@@ -580,8 +624,9 @@ SCMP:
 
 ; ( n1 n2 -- f )
 	.db "CMP"
-	.fill 5
+	.fill 4
 	.dw SCMP
+	.db 0
 CMP:
 	.dw nativeWord
 	pop	hl
@@ -592,68 +637,48 @@ CMP:
 	push	bc
 	jp	exit
 
-	.db "IF"
-	.fill 5
-	.db 1		; IMMEDIATE
-	.dw CMP
-IF:
-	.dw nativeWord
-	; Spit a conditional branching atom, followed by an empty 1b cell. Then,
-	; push the address of that cell on the PS. ELSE or THEN will pick
-	; them up and set the offset.
-	ld	hl, (CMPDST)
-	ld	de, CBRANCH
-	call	DEinHL
-	push	hl		; address of cell to fill
-	inc	hl		; empty 1b cell
-	ld	(CMPDST), hl
+; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
+; where to branch to. For example, The branching cell of "IF THEN" would
+; contain 3. Add this value to RS.
+	.db	"(fbr)"
+	.fill	2
+	.dw	CMP
+	.db	0
+FBR:
+	.dw	nativeWord
+	push	de
+	ld	l, (ix)
+	ld	h, (ix+1)
+	ld	a, (hl)
+	call	addHL
+	ld	(ix), l
+	ld	(ix+1), h
+	pop	de
 	jp	exit
 
-	.db "ELSE"
-	.fill 3
-	.db 1		; IMMEDIATE
-	.dw IF
-ELSE:
-	.dw nativeWord
-	; First, let's set IF's branching cell.
-	pop	de		; cell's address
-	ld	hl, (CMPDST)
-	; also skip ELSE word.
-	inc	hl \ inc hl \ inc hl
-	or	a		; clear carry
-	sbc	hl, de		; HL now has relative offset
-	ld	a, l
-	ld	(de), a
-	; Set IF's branching cell to current atom address and spit our own
-	; uncondition branching cell, which will then be picked up by THEN.
-	; First, let's spit our 4 bytes
-	ld	hl, (CMPDST)
-	ld	de, BRANCH
-	call	DEinHL
-	push	hl		; address of cell to fill
-	inc	hl		; empty 1b cell
-	ld	(CMPDST), hl
+; Conditional branch, only branch if TOS is zero
+	.db	"(fbr?)"
+	.fill	1
+	.dw	FBR
+	.db	0
+FBRC:
+	.dw	nativeWord
+	pop	hl
+	ld	a, h
+	or	l
+	jr	z, FBR+2
+	; skip next byte in RS
+	ld	l, (ix)
+	ld	h, (ix+1)
+	inc	hl
+	ld	(ix), l
+	ld	(ix+1), h
 	jp	exit
 
-	.db "THEN"
-	.fill 3
-	.db 1		; IMMEDIATE
-	.dw ELSE
-THEN:
-	.dw nativeWord
-	; See comments in IF and ELSE
-	pop	de		; cell's address
-	ld	hl, (CMPDST)
-	; There is nothing to skip because THEN leaves nothing.
-	or	a		; clear carry
-	sbc	hl, de		; HL now has relative offset
-	ld	a, l
-	ld	(de), a
-	jp	exit
 
 	.db "RECURSE"
+	.dw FBRC
 	.db 0
-	.dw THEN
 RECURSE:
 	.dw nativeWord
 	call	popRS

apps/forth/dictionary.txt

@@ -1,6 +1,7 @@
 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
-that the Return Stack is modified.
+that the Return Stack is modified. "I:" prefix means "IMMEDIATE", that is, that
+this stack transformation is made at compile time.
 
 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
@@ -25,27 +26,39 @@ 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.
 
+Words between "()" are "support words" that aren't really meant to be used
+directly, but as part of another word.
+
+"*I*" in description indicates an IMMEDIATE word.
+
 *** Defining words ***
 : 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       --              *I* Like "'", but spits the addr as a number literal.
 ALLOT       n --            Move HERE by n bytes
+C,          b --            Write byte b in HERE and advance it.
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
 CONSTANT x  n --            Creates cell x that when called pushes its value
 DOES>       --              See description at top of file
 IMMEDIATE   --              Flag the latest defined word as immediate.
-LITERAL     n --            Inserts number from TOS as a literal
+LITERAL     n --            *I* Inserts number from TOS as a literal
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 
 *** Flow ***
-ELSE        --              Branch to THEN
+(fbr?)      f --            Conditionally branches forward by the number
+                            specified in its atom's cell.
+(fbr)       --              Branches forward by the number specified in its
+                            atom's cell.
+ELSE        I:a --          *I* Compiles a (fbr) and set branching cell at a.
 EXECUTE     a --            Execute wordref at addr a
-IF          n --            Branch to ELSE or THEN if n is zero
+IF          -- I:a          *I* Compiles a (fbr?) and pushes its cell's addr
 INTERPRET   --              Get a line from stdin, compile it in tmp memory,
                             then execute the compiled contents.
 QUIT        R:drop --       Return to interpreter promp immediately
 RECURSE     R:I -- R:I-2    Run the current word again.
-THEN        --              Does nothing. Serves as a branching merker for IF
-                            and ELSE.
+THEN        I:a --          *I* Set branching cell at a.
 
 *** Stack ***
 DUP         a -- a a
@@ -64,11 +77,13 @@ C@          a -- c          Set c to byte at address a
 C!          c a --          Store byte c in address a
 CURRENT     -- n            Set n to wordref of last added entry.
 HERE        -- a            Push HERE's address
+H           -- a            HERE @
 
 *** Arithmetic ***
 
 +           a b -- c        a + b -> c
 -           a b -- c        a - b -> c
+-^          a b -- c        b - a -> c
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c
 

apps/forth/main.asm

@@ -8,15 +8,20 @@
 ; Offset of the code link relative to the beginning of the word
 .equ	CODELINK_OFFSET	NAMELEN+3
 
+; Flags for the "flag field" of the word structure
+; IMMEDIATE word
+.equ	FLAG_IMMED	0
+; This wordref is not a regular word (it's not preceeded by a name). It's one
+; of the NUMBER, LIT, BRANCH etc. entities.
+.equ	FLAG_UNWORD	1
+
 ; *** Variables ***
 .equ	INITIAL_SP	FORTH_RAMSTART
 .equ	CURRENT		@+2
 .equ	HERE		@+2
+.equ	OLDHERE		@+2
 ; Pointer to where we currently are in the interpretation of the current line.
 .equ	INPUTPOS	@+2
-; Pointer to where compiling words should output. During interpret, it's a
-; moving target in (COMPBUF). During DEFINE, it's (HERE).
-.equ	CMPDST		@+2
 ; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
 .equ	COMPBUF		@+2
 .equ	FORTH_RAMEND	@+0x40
@@ -31,19 +36,29 @@
 ;
 ; 1. read single word from line
 ; 2. compile word to atom
-; 3. execute atom
-; 4. goto 1
+; 3. if immediate, execute atom
+; 4. goto 1 until we exhaust words
+; 5. Execute compiled atom list as if it was a regular compiledWord.
 ;
-; During step 3, it's possible that atom read from input, so INPUTPOS might
-; have moved between 3 and 4.
-;
-; Because the Parameter Stack uses PS, we can't just go around calling routines:
+; Because the Parameter Stack uses SP, we can't just go around calling routines:
 ; This messes with the PS. This is why we almost always jump (unless our call
 ; doesn't involve Forth words in any way).
 ;
 ; This presents a challenge for our interpret loop because step 4, "goto 1"
 ; isn't obvious. To be able to do that, we must push a "return routine" to the
 ; Return Stack before step 3.
+;
+; HERE and IMMEDIATE: When compiling in step 2, we spit compiled atoms in
+; (HERE) to simplify "," semantic in Forth (spitting, in all cases, is done in
+; (HERE)). However, suring input line compilation, it isn't like during ":", we
+; aren't creating a new entry.
+;
+; Compiling and executing from (HERE) would be dangerous because an
+; entry-creation word, during runtime, could end up overwriting the atom list
+; we're executing. This is why we have this list in COMPBUF.
+;
+; During IMMEDIATE mode, (HERE) is temporarily set to COMPBUF, and when we're
+; done, we restore (HERE) for runtime. This way, everyone is happy.
 
 ; *** Code ***
 forthMain:
@@ -71,8 +86,12 @@ forthRdLine:
 	call	stdioReadLine
 	ld	ix, RS_ADDR-2		; -2 because we inc-before-push
 	ld	(INPUTPOS), hl
+	; We're about to compile the line and possibly execute IMMEDIATE words.
+	; Let's save current (HERE) and temporarily set it to COMPBUF.
+	ld	hl, (HERE)
+	ld	(OLDHERE), hl
 	ld	hl, COMPBUF
-	ld	(CMPDST), hl
+	ld	(HERE), hl
 forthInterpret:
 	call	readword
 	jr	nz, .execute
@@ -104,9 +123,9 @@ forthInterpret:
 	; called, triggering an abort.
 	ld	de, LIT
 	call	.writeDE
-	ld	de, (CMPDST)
+	ld	de, (HERE)
 	call	strcpyM
-	ld	(CMPDST), de
+	ld	(HERE), de
 	jr	forthInterpret
 .immed:
 	push	hl		; --> lvl 1
@@ -117,16 +136,19 @@ forthInterpret:
 .execute:
 	ld	de, QUIT
 	call	.writeDE
+	; Compilation done, let's restore (HERE) and execute!
+	ld	hl, (OLDHERE)
+	ld	(HERE), hl
 	ld	iy, COMPBUF
 	jp	compiledWord
 .writeDE:
 	push	hl
-	ld	hl, (CMPDST)
+	ld	hl, (HERE)
 	ld	(hl), e
 	inc	hl
 	ld	(hl), d
 	inc	hl
-	ld	(CMPDST), hl
+	ld	(HERE), hl
 	pop	hl
 	ret
 

apps/forth/util.asm

@@ -69,12 +69,12 @@ HLPointsLIT:
 	pop	de
 	ret
 
-HLPointsBRANCH:
+HLPointsBR:
 	push	de
-	ld	de, BRANCH
+	ld	de, FBR
 	call	HLPointsDE
 	jr	z, .end
-	ld	de, CBRANCH
+	ld	de, FBRC
 	call	HLPointsDE
 .end:
 	pop	de
@@ -87,20 +87,13 @@ HLPointsEXIT:
 	pop	de
 	ret
 
-HLPointsQUIT:
-	push	de
-	ld	de, QUIT
-	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	HLPointsBRANCH
+	call	HLPointsBR
 	jr	z, .isBranch
 	call	HLPointsLIT
 	jr	nz, .isWord
@@ -176,15 +169,8 @@ readLIT:
 	ex	de, hl
 	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
-	call	HLPointsBRANCH
-	jr	z, .notWord
-	call	HLPointsEXIT
-	jr	z, .notWord
-	call	HLPointsQUIT
+	; Alright, not a literal, but is it a word?
+	call	HLPointsUNWORD
 	jr	z, .notWord
 	; Not a number, then it's a word. Copy word to pad and point to it.
 	push	hl		; --> lvl 1. we need it to set DE later
@@ -233,18 +219,6 @@ readLITTOS:
 	pop	de
 	ret
 
-; 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
-	call	intoDE
-	; DE points to prev. Is it zero?
-	xor	a
-	or	d
-	or	e
-	; Z will be set if DE is zero
-	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.
@@ -264,7 +238,7 @@ find:
 	call	strncmp
 	pop	de		; <-- lvl 1, return to wordref
 	jr	z, .end		; found
-	call	prev
+	call	.prev
 	jr	nz, .inner
 	; Z set? end of dict unset Z
 	inc	a
@@ -273,6 +247,18 @@ find:
 	pop	hl
 	ret
 
+; 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 \ dec de	; prev field
+	call	intoDE
+	; DE points to prev. Is it zero?
+	xor	a
+	or	d
+	or	e
+	; Z will be set if DE is zero
+	ret
+
 ; Write compiled data from HL into IY, advancing IY at the same time.
 wrCompHL:
 	ld	(iy), l
@@ -291,13 +277,11 @@ entryhead:
 	ld	de, (CURRENT)
 	ld	a, NAMELEN
 	call	addHL
-	xor	a		; IMMED
+	call	DEinHL
+	; Set word flags: not IMMED, not UNWORD, so it's 0
+	xor	a
 	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
@@ -306,16 +290,10 @@ entryhead:
 ; Sets Z if wordref at HL is of the IMMEDIATE type
 HLisIMMED:
 	dec	hl
-	dec	hl
-	dec	hl
+	bit	FLAG_IMMED, (hl)
+	inc	hl
 	; We need an invert flag. We want to Z to be set when flag is non-zero.
-	ld	a, 1
-	and	(hl)
-	dec	a	; if A was 1, Z is set. Otherwise, Z is unset
-	inc	hl
-	inc	hl
-	inc	hl
-	ret
+	jp	toggleZ
 
 ; Sets Z if wordref at (HL) is of the IMMEDIATE type
 HLPointsIMMED:
@@ -325,6 +303,22 @@ HLPointsIMMED:
 	pop	hl
 	ret
 
+; Sets Z if wordref at HL is of the UNWORD type
+HLisUNWORD:
+	dec	hl
+	bit	FLAG_UNWORD, (hl)
+	inc	hl
+	; We need an invert flag. We want to Z to be set when flag is non-zero.
+	jp	toggleZ
+
+; Sets Z if wordref at (HL) is of the IMMEDIATE type
+HLPointsUNWORD:
+	push	hl
+	call	intoHL
+	call	HLisUNWORD
+	pop	hl
+	ret
+
 ; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise
 flagsToBC:
 	ld	bc, 0

apps/lib/util.asm

@@ -105,3 +105,10 @@ strlen:
 	dec	a
 	pop	bc
 	ret
+
+; make Z the opposite of what it is now
+toggleZ:
+	jp	z, unsetZ
+	cp	a
+	ret
+

apps/zasm/util.asm

@@ -24,12 +24,6 @@ subDEFromHL:
 	pop	af
 	ret
 
-; make Z the opposite of what it is now
-toggleZ:
-	jp	z, unsetZ
-	cp	a
-	ret
-
 ; Compares strings pointed to by HL and DE up to A count of characters in a
 ; case-insensitive manner.
 ; If equal, Z is set. If not equal, Z is reset.