From fb54fd51afc4a0fe6d456dafffd85c24a812874b Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 12 Mar 2020 13:52:27 -0400
Subject: [PATCH] forth: implement THEN in Forth

Also, add "," and "C,"
---
 apps/forth/core.fth       |  3 +++
 apps/forth/dict.asm       | 19 +------------------
 apps/forth/dictionary.txt |  2 ++
 apps/forth/main.asm       |  5 +++--
 4 files changed, 9 insertions(+), 20 deletions(-)

diff --git a/apps/forth/core.fth b/apps/forth/core.fth
index 5f3860f..748913b 100644
--- a/apps/forth/core.fth
+++ b/apps/forth/core.fth
@@ -3,6 +3,9 @@
 : ALLOT HERE +! ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE HERE @ ! DOES> @ ;
+: , HERE @ ! 2 ALLOT ;
+: C, HERE @ C! 1 ALLOT ;
+: THEN DUP HERE @ SWAP - SWAP C! ; IMMEDIATE
 : NOT IF 0 ELSE 1 THEN ;
 : = CMP NOT ;
 : < CMP 0 1 - = ;
diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index 97b757c..ec2c9e7 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -321,8 +321,6 @@ IMMEDIATE:
 	.dw nativeWord
 	ld	hl, (CURRENT)
 	dec	hl
-	dec	hl
-	dec	hl
 	set	FLAG_IMMED, (hl)
 	jp	exit
 
@@ -675,24 +673,9 @@ ELSE:
 	ld	(HERE), hl
 	jp	exit
 
-	.db "THEN"
-	.fill 3
-	.dw ELSE
-	.db 1		; IMMEDIATE
-THEN:
-	.dw nativeWord
-	; See comments in IF and ELSE
-	pop	de		; cell's address
-	ld	hl, (HERE)
-	; 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 THEN
+	.dw ELSE
 	.db 0
 RECURSE:
 	.dw nativeWord
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 061bb55..7b9468c 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -28,7 +28,9 @@ also be references to NUMBER and LIT.
 *** Defining words ***
 : x ...     --              Define a new word
 ;           R:I --          Exit a colon definition
+,           n --            Write n in HERE and advance it.
 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
diff --git a/apps/forth/main.asm b/apps/forth/main.asm
index 7fb5607..a57a10a 100644
--- a/apps/forth/main.asm
+++ b/apps/forth/main.asm
@@ -19,6 +19,7 @@
 .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
 ; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
@@ -88,7 +89,7 @@ forthRdLine:
 	; 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)
-	push	hl			; Saving HERE
+	ld	(OLDHERE), hl
 	ld	hl, COMPBUF
 	ld	(HERE), hl
 forthInterpret:
@@ -136,7 +137,7 @@ forthInterpret:
 	ld	de, QUIT
 	call	.writeDE
 	; Compilation done, let's restore (HERE) and execute!
-	pop	hl		; Restore old (HERE)
+	ld	hl, (OLDHERE)
 	ld	(HERE), hl
 	ld	iy, COMPBUF
 	jp	compiledWord