From 54fd5fbb2bdecd9837279582f99d52335b055368 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 22 Mar 2020 11:49:09 -0400
Subject: [PATCH] forth: Forth-ify "CREATE"

---
 forth/core.fs        |  6 ++++++
 forth/dictionary.txt |  1 +
 forth/forth.asm      | 20 +++++---------------
 3 files changed, 12 insertions(+), 15 deletions(-)

diff --git a/forth/core.fs b/forth/core.fs
index 9738429..afd3853 100644
--- a/forth/core.fs
+++ b/forth/core.fs
@@ -37,6 +37,12 @@
     H 1 -           ( push a. -1 for allot offset )
 ; IMMEDIATE
 
+: [LITN] LITN ; IMMEDIATE
+: CREATE
+    WORD (entry)     ( empty header with name )
+    ROUTINE C [LITN] ( push cellWord addr )
+    ,                ( write it )
+;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
 : = CMP NOT ;
diff --git a/forth/dictionary.txt b/forth/dictionary.txt
index 68e6626..9001547 100644
--- a/forth/dictionary.txt
+++ b/forth/dictionary.txt
@@ -52,6 +52,7 @@ DOES>       --              See description at top of file
 IMMED?      a -- f          Checks whether wordref at a is immediate.
 IMMEDIATE   --              Flag the latest defined word as immediate.
 LITN        n --            Write number n as a literal.
+[LITN]      n --            *I* Immediate version of LITN.
 ROUTINE x   -- a            Push the addr of the specified core routine
                             C=cellWord L=compiledWord V=nativeWord N=next S=LIT
                             N=NUMBER Y=sysvarWord D=doesWord
diff --git a/forth/forth.asm b/forth/forth.asm
index 3217e85..6a02cc8 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -783,7 +783,7 @@ WR:
 
 	.db	"ROUTINE"
 	.dw	WR
-	.db	0
+	.db	1			; IMMEDIATE
 ROUTINE:
 	.dw	compiledWord
 	.dw	WORD
@@ -1253,6 +1253,9 @@ PARSEI:
 
 ; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
+	.db	"(entry)"
+	.dw	PARSE
+	.db	0
 ENTRYHEAD:
 	.dw	nativeWord
 	pop	hl
@@ -1272,19 +1275,6 @@ ENTRYHEAD:
 	jp	next
 
 
-	.db "CREATE"
-	.fill 1
-	.dw PARSE
-	.db 0
-CREATE:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	ENTRYHEAD
-	.dw	NUMBER
-	.dw	cellWord
-	.dw	WR
-	.dw	EXIT
-
 ; WARNING: there are no limit checks. We must be cautious, in core code, not
 ; to create more than SYSV_BUFSIZE/2 sys vars.
 ; Also: SYSV shouldn't be used during runtime: SYSVNXT won't point at the
@@ -1292,7 +1282,7 @@ CREATE:
 ; this word is not documented in dictionary.txt
 	.db	"(sysv)"
 	.fill	1
-	.dw	CREATE
+	.dw	ENTRYHEAD
 	.db	0
 SYSV:
 	.dw	compiledWord