forth: add word "ROUTINE"

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",

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