From ff281f69a877ce47492e07afe368782d92f174f1 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 12 Mar 2020 11:39:27 -0400
Subject: [PATCH] forth: add "UNWORD" flag

Also, reorder word fields so that the flag field is more easily accessible.
---
 apps/forth/dict.asm | 118 +++++++++++++++++++++++++++++---------------
 apps/forth/main.asm |   7 +++
 apps/forth/util.asm |  82 ++++++++++++++----------------
 apps/lib/util.asm   |   7 +++
 apps/zasm/util.asm  |   6 ---
 5 files changed, 131 insertions(+), 89 deletions(-)

diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index 219b598..1b8c903 100644
--- a/apps/forth/dict.asm
+++ b/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, BRANCH, 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:
@@ -65,6 +70,7 @@ branchWord:
 	pop	de
 	jp	exit
 
+	.db	0b10		; Flags
 BRANCH:
 	.dw	branchWord
 
@@ -82,6 +88,7 @@ cbranchWord:
 	ld	(ix+1), h
 	jp	exit
 
+	.db	0b10		; Flags
 CBRANCH:
 	.dw	cbranchWord
 
@@ -102,6 +109,8 @@ numberWord:
 	ld	(ix+1), h
 	push	de
 	jp	exit
+
+	.db	0b10		; Flags
 NUMBER:
 	.dw	numberWord
 
@@ -119,6 +128,8 @@ litWord:
 	jp	abort
 .msg:
 	.db "undefined word", 0
+
+	.db	0b10		; Flags
 LIT:
 	.dw	litWord
 
@@ -143,16 +154,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 +176,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 +191,9 @@ BYE:
 
 ; ( c -- )
 	.db "EMIT"
-	.fill 4
+	.fill 3
 	.dw BYE
+	.db 0
 EMIT:
 	.dw nativeWord
 	pop	hl
@@ -188,8 +203,9 @@ EMIT:
 
 ; ( c port -- )
 	.db "PC!"
-	.fill 5
+	.fill 4
 	.dw EMIT
+	.db 0
 PSTORE:
 	.dw nativeWord
 	pop	bc
@@ -199,8 +215,9 @@ PSTORE:
 
 ; ( port -- c )
 	.db "PC@"
-	.fill 5
+	.fill 4
 	.dw PSTORE
+	.db 0
 PFETCH:
 	.dw nativeWord
 	pop	bc
@@ -211,8 +228,8 @@ PFETCH:
 
 ; ( addr -- )
 	.db "EXECUTE"
-	.db 0
 	.dw PFETCH
+	.db 0
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
@@ -226,8 +243,9 @@ executeCodeLink:
 	jp	(hl)	; go!
 
 	.db ":"
-	.fill 7
+	.fill 6
 	.dw EXECUTE
+	.db 0
 DEFINE:
 	.dw nativeWord
 	call	entryhead
@@ -273,8 +291,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,21 +315,21 @@ 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)
@@ -323,8 +342,9 @@ LITERAL:
 
 ; ( -- c )
 	.db "KEY"
-	.fill 5
+	.fill 4
 	.dw LITERAL
+	.db 0
 KEY:
 	.dw nativeWord
 	call	stdioGetC
@@ -334,8 +354,9 @@ KEY:
 	jp	exit
 
 	.db "CREATE"
-	.fill 2
+	.fill 1
 	.dw KEY
+	.db 0
 CREATE:
 	.dw nativeWord
 	call	entryhead
@@ -349,23 +370,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 +402,9 @@ DOT:
 
 ; ( n a -- )
 	.db "!"
-	.fill 7
+	.fill 6
 	.dw DOT
+	.db 0
 STORE:
 	.dw nativeWord
 	pop	iy
@@ -391,8 +415,9 @@ STORE:
 
 ; ( n a -- )
 	.db "C!"
-	.fill 6
+	.fill 5
 	.dw STORE
+	.db 0
 CSTORE:
 	.dw nativeWord
 	pop	hl
@@ -402,8 +427,9 @@ CSTORE:
 
 ; ( a -- n )
 	.db "@"
-	.fill 7
+	.fill 6
 	.dw CSTORE
+	.db 0
 FETCH:
 	.dw nativeWord
 	pop	hl
@@ -413,8 +439,9 @@ FETCH:
 
 ; ( a -- c )
 	.db "C@"
-	.fill 6
+	.fill 5
 	.dw FETCH
+	.db 0
 CFETCH:
 	.dw nativeWord
 	pop	hl
@@ -425,8 +452,9 @@ CFETCH:
 
 ; ( -- a )
 	.db "LIT@"
-	.fill 4
+	.fill 3
 	.dw CFETCH
+	.db 0
 LITFETCH:
 	.dw nativeWord
 	call	readLITTOS
@@ -435,8 +463,9 @@ LITFETCH:
 
 ; ( a b -- b a )
 	.db "SWAP"
-	.fill 4
+	.fill 3
 	.dw LITFETCH
+	.db 0
 SWAP:
 	.dw nativeWord
 	pop	hl
@@ -446,8 +475,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 +492,9 @@ SWAP2:
 
 ; ( a -- a a )
 	.db "DUP"
-	.fill 5
+	.fill 4
 	.dw SWAP2
+	.db 0
 DUP:
 	.dw nativeWord
 	pop	hl
@@ -473,8 +504,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 +519,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 +533,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 +552,9 @@ OVER2:
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.fill 7
+	.fill 6
 	.dw OVER2
+	.db 0
 PLUS:
 	.dw nativeWord
 	pop	hl
@@ -530,8 +565,9 @@ PLUS:
 
 ; ( a b -- c ) A - B
 	.db "-"
-	.fill 7
+	.fill 6
 	.dw PLUS
+	.db 0
 MINUS:
 	.dw nativeWord
 	pop	de		; B
@@ -543,8 +579,9 @@ MINUS:
 
 ; ( a b -- c ) A * B
 	.db "*"
-	.fill 7
+	.fill 6
 	.dw MINUS
+	.db 0
 MULT:
 	.dw nativeWord
 	pop	de
@@ -555,8 +592,9 @@ MULT:
 
 ; ( a b -- c ) A / B
 	.db "/"
-	.fill 7
+	.fill 6
 	.dw MULT
+	.db 0
 DIV:
 	.dw nativeWord
 	pop	de
@@ -567,8 +605,9 @@ DIV:
 
 ; ( a1 a2 -- b )
 	.db "SCMP"
-	.fill 4
+	.fill 3
 	.dw DIV
+	.db 0
 SCMP:
 	.dw nativeWord
 	pop	de
@@ -580,8 +619,9 @@ SCMP:
 
 ; ( n1 n2 -- f )
 	.db "CMP"
-	.fill 5
+	.fill 4
 	.dw SCMP
+	.db 0
 CMP:
 	.dw nativeWord
 	pop	hl
@@ -594,8 +634,8 @@ CMP:
 
 	.db "IF"
 	.fill 5
-	.db 1		; IMMEDIATE
 	.dw CMP
+	.db 1		; IMMEDIATE
 IF:
 	.dw nativeWord
 	; Spit a conditional branching atom, followed by an empty 1b cell. Then,
@@ -611,8 +651,8 @@ IF:
 
 	.db "ELSE"
 	.fill 3
-	.db 1		; IMMEDIATE
 	.dw IF
+	.db 1		; IMMEDIATE
 ELSE:
 	.dw nativeWord
 	; First, let's set IF's branching cell.
@@ -637,8 +677,8 @@ ELSE:
 
 	.db "THEN"
 	.fill 3
-	.db 1		; IMMEDIATE
 	.dw ELSE
+	.db 1		; IMMEDIATE
 THEN:
 	.dw nativeWord
 	; See comments in IF and ELSE
@@ -652,8 +692,8 @@ THEN:
 	jp	exit
 
 	.db "RECURSE"
-	.db 0
 	.dw THEN
+	.db 0
 RECURSE:
 	.dw nativeWord
 	call	popRS
diff --git a/apps/forth/main.asm b/apps/forth/main.asm
index b3bf1e1..be98a48 100644
--- a/apps/forth/main.asm
+++ b/apps/forth/main.asm
@@ -8,6 +8,13 @@
 ; 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
diff --git a/apps/forth/util.asm b/apps/forth/util.asm
index 6e9ae82..ea491b1 100644
--- a/apps/forth/util.asm
+++ b/apps/forth/util.asm
@@ -87,13 +87,6 @@ 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.
@@ -176,16 +169,9 @@ 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
-	jr	z, .notWord
+	; Alright, not a literal, but is it a word?
+	call	HLPointsUNWORD
+	jr	nz, .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
 	call	intoHL
@@ -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
diff --git a/apps/lib/util.asm b/apps/lib/util.asm
index 613b860..715c072 100644
--- a/apps/lib/util.asm
+++ b/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
+
diff --git a/apps/zasm/util.asm b/apps/zasm/util.asm
index b1bba10..1c133a7 100644
--- a/apps/zasm/util.asm
+++ b/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.