From 1e886f5f34fd32bd302b6ebd1f41178e66268f28 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 22 Mar 2020 11:25:39 -0400
Subject: [PATCH] forth: add word "ROUTINE"

---
 forth/dictionary.txt |  3 +++
 forth/forth.asm      | 53 +++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 55 insertions(+), 1 deletion(-)

diff --git a/forth/dictionary.txt b/forth/dictionary.txt
index 9499b1a..68e6626 100644
--- a/forth/dictionary.txt
+++ b/forth/dictionary.txt
@@ -52,6 +52,9 @@ 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.
+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
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 
 Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
diff --git a/forth/forth.asm b/forth/forth.asm
index 45b80f1..3217e85 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -781,9 +781,60 @@ WR:
 	jp	next
 
 
+	.db	"ROUTINE"
+	.dw	WR
+	.db	0
+ROUTINE:
+	.dw	compiledWord
+	.dw	WORD
+	.dw	.private
+	.dw	EXIT
+
+.private:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	ld	a, (hl)
+	ld	de, cellWord
+	cp	'C'
+	jr	z, .end
+	ld	de, compiledWord
+	cp	'L'
+	jr	z, .end
+	ld	de, nativeWord
+	cp	'V'
+	jr	z, .end
+	ld	de, next
+	cp	'N'
+	jr	z, .end
+	ld	de, sysvarWord
+	cp	'Y'
+	jr	z, .end
+	ld	de, doesWord
+	cp	'D'
+	jr	z, .end
+	ld	de, LIT
+	cp	'S'
+	jr	z, .end
+	ld	de, NUMBER
+	cp	'N'
+	jr	nz, .notgood
+	; continue to end on match
+.end:
+	; is our slen 1?
+	inc	hl
+	ld	a, (hl)
+	or	a
+	jr	z, .good
+.notgood:
+	ld	de, 0
+.good:
+	push	de
+	jp	next
+
 ; ( addr -- )
 	.db "EXECUTE"
-	.dw WR
+	.dw ROUTINE
 	.db 0
 EXECUTE:
 	.dw nativeWord