forth: Forth-ify main loop a bit

Add words "COMPILE" and "DROP". The goal is to soon make "DEFINE" immediate
and have it compile from input directly. This whole "main loop compiles
everything and DEFINE picks up compiled atoms" is a bit messy.

apps/forth/dict.asm

@@ -206,7 +206,6 @@ PFETCH:
 EXECUTE:
 	.dw nativeWord
 	pop	iy	; is a wordref
-executeCodeLink:
 	ld	l, (iy)
 	ld	h, (iy+1)
 	; HL points to code pointer
@@ -216,9 +215,68 @@ executeCodeLink:
 	jp	(hl)	; go!
 
 
+	.db	"COMPILE"
+	.dw	EXECUTE
+	.db	1		; IMMEDIATE
+COMPILE:
+	.dw	nativeWord
+	pop	hl		; word addr
+	call	find
+	jr	nz, .maybeNum
+	ex	de, hl
+	call	HLisIMMED
+	jr	z, .immed
+	ex	de, hl
+	call	.writeDE
+	jp	next
+.maybeNum:
+	push	hl		; --> lvl 1. save string addr
+	call	parseLiteral
+	pop	hl		; <-- lvl 1
+	jr	nz, .undef
+	; a valid number in DE!
+	ex	de, hl
+	ld	de, NUMBER
+	call	.writeDE
+	ex	de, hl		; number in DE
+	call	.writeDE
+	jp	next
+.undef:
+	; When encountering an undefined word during compilation, we spit a
+	; reference to litWord, followed by the null-terminated word.
+	; This way, if a preceding word expect a string literal, it will read it
+	; by calling readLIT, and if it doesn't, the routine will be
+	; called, triggering an abort.
+	ld	de, LIT
+	call	.writeDE
+	ld	de, (HERE)
+	call	strcpyM
+	ld	(HERE), de
+	jp	next
+.immed:
+	; For this IMMEDIATE word to be compatible with regular execution model,
+	; it needs to be compiled as an atom somewhere in memory.
+	; For example, RECURSE backtracks in RS and steps back 2 bytes. This
+	; can only work with our compiled atom being next to an EXIT atom.
+	ex	de, hl		; atom to write in DE
+	ld	hl, (OLDHERE)
+	push	hl \ pop iy
+	call	DEinHL
+	ld	de, EXIT
+	call	DEinHL
+	jp	compiledWord
+.writeDE:
+	push	hl
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
+	pop	hl
+	ret
+
+
 	.db	";"
 	.fill	6
-	.dw	EXECUTE
+	.dw	COMPILE
 	.db	0
 ENDDEF:
 	.dw	nativeWord
@@ -377,7 +435,6 @@ KEY:
 WORD:
 	.dw nativeWord
 	call	readword
-	jp	nz, abort
 	push	hl
 	jp	next
 
@@ -487,10 +544,20 @@ LITFETCH:
 	push	hl
 	jp	next
 
+; ( a -- )
+	.db "DROP"
+	.fill 3
+	.dw LITFETCH
+	.db 0
+DROP:
+	.dw nativeWord
+	pop	hl
+	jp	next
+
 ; ( a b -- b a )
 	.db "SWAP"
 	.fill 3
-	.dw LITFETCH
+	.dw DROP
 	.db 0
 SWAP:
 	.dw nativeWord

apps/forth/dictionary.txt

@@ -51,6 +51,7 @@ VARIABLE c  --              Creates cell x with 2 bytes allocation.
 *** Flow ***
 (fbr)       --              Branches forward by the number specified in its
                             atom's cell.
+COMPILE     a --            Compile string word at addr a and spit it to HERE.
 ELSE        I:a --          *I* Compiles a (fbr) and set branching cell at a.
 EXECUTE     a --            Execute wordref at addr a
 IF          -- I:a          *I* Compiles a (fbr?) and pushes its cell's addr
@@ -64,6 +65,7 @@ SKIP?       f --            If f is true, skip the execution of the next atom.
 THEN        I:a --          *I* Set branching cell at a.
 
 *** Parameter Stack ***
+DROP        a --
 DUP         a -- a a
 OVER        a b -- a b a
 SWAP        a b -- b a

apps/forth/main.asm

@@ -69,7 +69,7 @@
 ; EXECUTING A WORD
 ;
 ; At it's core, executing a word is having the wordref in IY and call
-; executeCodeLink. Then, we let the word do its things. Some words are special,
+; EXECUTE. Then, we let the word do its things. Some words are special,
 ; but most of them are of the compiledWord type, and that's their execution that
 ; we describe here.
 ;
@@ -109,9 +109,7 @@ forthRdLineNoOk:
 	call	printcrlf
 	call	stdioReadLine
 	ld	(INPUTPOS), hl
-	; Setup return stack. As a safety net, we set its bottom to ABORTREF.
+	; Setup return stack. After INTERPRET, we run forthExecLine
-	ld	hl, ABORTREF
-	ld	(RS_ADDR), hl
 	ld	ix, RS_ADDR
 	; We're about to compile the line and possibly execute IMMEDIATE words.
 	; Let's save current (HERE) and temporarily set it to COMPBUF.
@@ -119,61 +117,24 @@ forthRdLineNoOk:
 	ld	(OLDHERE), hl
 	ld	hl, COMPBUF
 	ld	(HERE), hl
-forthInterpret:
+	ld	hl, .retRef
-	call	readword
+	ld	(IP), hl
-	jr	nz, .execute
+	ld	hl, INTERPRET
-	call	find
+	push	hl
-	jr	nz, .maybeNum
+	jp	EXECUTE+2
-	ex	de, hl
+.retRef:
-	call	HLisIMMED
+	.dw	$+2
-	jr	z, .immed
+	.dw	forthExecLine
-	ex	de, hl
+
-	call	.writeDE
+forthExecLine:
-	jr	forthInterpret
-.maybeNum:
-	push	hl		; --> lvl 1. save string addr
-	call	parseLiteral
-	pop	hl		; <-- lvl 1
-	jr	nz, .undef
-	; a valid number in DE!
-	ex	de, hl
-	ld	de, NUMBER
-	call	.writeDE
-	ex	de, hl		; number in DE
-	call	.writeDE
-	jr	forthInterpret
-.undef:
-	; When encountering an undefined word during compilation, we spit a
-	; reference to litWord, followed by the null-terminated word.
-	; This way, if a preceding word expect a string literal, it will read it
-	; by calling readLIT, and if it doesn't, the routine will be
-	; called, triggering an abort.
-	ld	de, LIT
-	call	.writeDE
-	ld	de, (HERE)
-	call	strcpyM
-	ld	(HERE), de
-	jr	forthInterpret
-.immed:
-	; For this IMMEDIATE word to be compatible with regular execution model,
-	; it needs to be compiled as an atom list. We need a temporary space for
-	; this, let's use (OLDHERE) while it isn't used.
-	ex	de, hl		; atom to write in DE
-	ld	hl, (OLDHERE)
-	call	DEinHL
-	; Now, let's write the .retRef
-	ld	de, .retRef
-	call	DEinHL
-	ld	iy, (OLDHERE)
-	jr	.execIY
-.execute:
 	ld	de, QUIT
-	call	.writeDE
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
 	; Compilation done, let's restore (HERE) and execute!
 	ld	hl, (OLDHERE)
 	ld	(HERE), hl
 	ld	iy, COMPBUF
-.execIY:
 	; before we execute, let's play with our RS a bit: compiledWord is
 	; going to push (IP) on the RS, but we don't expect our compiled words
 	; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and
@@ -182,16 +143,28 @@ forthInterpret:
 	ld	(IP), hl
 	ld	ix, RS_ADDR-2
 	jp	compiledWord
-.writeDE:
-	push	hl
-	ld	hl, (HERE)
-	call	DEinHL
-	ld	(HERE), hl
-	pop	hl
-	ret
 
-.retRef:
+; (we don't have RECURSE here. Calling interpret makes us needlessly use our
-	.dw	forthInterpret
+; RS stack, but it can take it, can't it? )
+; WORD DUP C@ (to check if null) SKIP? (skip if not null) EXIT COMPILE INTERPRET
+	.db	0b10		; UNWORD
+INTERPRET:
+	.dw	compiledWord
+	.dw	WORD
+	.dw	DUP
+	.dw	CFETCH
+	.dw	CSKIP
+	.dw	.stop
+	.dw	COMPILE
+	.dw	INTERPRET
+	.dw	EXIT
+
+.stop:
+	.dw	compiledWord
+	.dw	DROP
+	.dw	R2P
+	.dw	DROP
+	.dw	EXIT
 
 msgOk:
 	.db	" ok", 0