forth: Forth-ify "R>" and ">R"

forth/dictionary.txt

@@ -54,7 +54,7 @@ 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
+                            C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
                             M=NUMBER Y=sysvarWord D=doesWord
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 

forth/forth.asm

@@ -113,8 +113,10 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x17-$
+.fill 0x11-$
 JUMPTBL:
+	jp	pushRS
+	jp	popRS
 	jp	nativeWord
 	jp	next
 	jp	chkPS
@@ -782,13 +784,13 @@ ROUTINE:
 	ld	de, cellWord
 	cp	'C'
 	jr	z, .end
-	ld	de, compiledWord
-	cp	'L'
-	jr	z, .end
 	ld	de, JUMPTBL
+	cp	'J'
+	jr	z, .end
+	ld	de, JUMPTBL+6
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL+3
+	ld	de, JUMPTBL+9
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -803,7 +805,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+6
+	ld	de, JUMPTBL+12
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -1300,28 +1302,12 @@ OVER:
 	push	de
 	jp	next
 
-	.db	">R"
-	.dw	$-OVER
-	.db	2
-P2R:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	pushRS
-	jp	next
 
-	.db	"R>"
+.fill 31
-	.dw	$-P2R
-	.db	2
-R2P:
-	.dw	nativeWord
-	call	popRS
-	push	hl
-	jp	next
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.dw $-R2P
+	.dw $-OVER
 	.db 1
 PLUS:
 	.dw nativeWord

forth/icore.fs

@@ -41,15 +41,6 @@
     ,           ( write! )
 ; IMMEDIATE
 
-: X             ( can't have its real name now )
-    ['] EXIT ,
-    R> DROP     ( exit COMPILE )
-    R> DROP     ( exit : )
-; IMMEDIATE
-
-( Give ";" its real name )
-';' CURRENT @ 4 - C!
-
 : INTERPRET
     BEGIN
     WORD
@@ -63,3 +54,14 @@
     THEN
     AGAIN
 ;
+
+( ; has to be defined last because it can't be executed now )
+: X             ( can't have its real name now )
+    ['] EXIT ,
+    _c R> DROP     ( exit COMPILE )
+    _c R> DROP     ( exit : )
+; IMMEDIATE
+
+( Give ";" its real name )
+';' CURRENT @ 4 - C!
+

forth/z80c.fs

@@ -207,3 +207,16 @@ CODE J
     H 3 IX- LDrIXY,
     HL PUSHqq,
 ;CODE
+
+CODE >R
+    HL POPqq,
+    chkPS,
+    ( JUMPTBL+0 == pushRS )
+    ROUTINE J CALLnn,
+;CODE
+
+CODE R>
+    ( JUMPTBL+3 == popRS )
+    ROUTINE J 3 + CALLnn,
+    HL PUSHqq,
+;CODE