From f366732424fce1bf29d5190489f9118344bb8bea Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 30 Mar 2020 19:01:28 -0400
Subject: [PATCH] forth: Forth-ify "DOES>"

---
 emul/forth/z80c.bin | Bin 1549 -> 1549 bytes
 forth/core.fs       |  24 +++++++++++++++++++++++-
 forth/forth.asm     |  30 ++++--------------------------
 3 files changed, 27 insertions(+), 27 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index ca8ccbe7b1b94b8d810bd8110ab5ac7e5c4f8e5c..5bfeeed97d7978ca5e2a59cdd3297d5d7a98cb17 100644
GIT binary patch
delta 18
ZcmeC>>E+pw!pzzwdXFb<b0+f=CIC5_1_J;9

delta 18
ZcmeC>>E+pw!pv$fx|7Fob0+f=CIB?11#SQU

diff --git a/forth/core.fs b/forth/core.fs
index 12fe851..104591b 100644
--- a/forth/core.fs
+++ b/forth/core.fs
@@ -53,8 +53,30 @@
     11                 ( 11 == cellWord )
     ,                  ( write it )
 ;
+
+( We run this when we're in an entry creation context. Many
+  things we need to do.
+  1. Change the code link to doesWord
+  2. Leave 2 bytes for regular cell variable.
+  3. Write down RS' RTOS to entry.
+  4. exit parent definition
+)
+: DOES>
+    ( Overwrite cellWord in CURRENT )
+    ( 63 == doesWord )
+    63 CURRENT @ !
+    ( When we have a DOES>, we forcefully place HERE to 4
+      bytes after CURRENT. This allows a DOES word to use ","
+      and "C," without messing everything up. )
+    CURRENT @ 4 + HERE !
+    ( HERE points to where we should write R> )
+    R> ,
+    ( We're done. Because we've popped RS, we'll exit parent
+      definition )
+;
+
 : VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE H@ ! DOES> @ ;
+: CONSTANT CREATE , DOES> @ ;
 : = CMP NOT ;
 : < CMP 0 1 - = ;
 : > CMP 1 = ;
diff --git a/forth/forth.asm b/forth/forth.asm
index e016a80..0681b69 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -136,6 +136,7 @@
 	.dw	HERE
 	.dw	CURRENT
 	jp	parseDecimal
+	jp	doesWord
 
 ; *** Code ***
 forthMain:
@@ -166,7 +167,7 @@ forthMain:
 .bootName:
 	.db	"BOOT", 0
 
-.fill 98
+.fill 95
 
 ; STABLE ABI
 ; Offset: 00cd
@@ -687,33 +688,10 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-.fill 77
-
-	.db "DOES>"
-	.dw $-EXECUTE
-	.db 5
-DOES:
-	.dw nativeWord
-	; We run this when we're in an entry creation context. Many things we
-	; need to do.
-	; 1. Change the code link to doesWord
-	; 2. Leave 2 bytes for regular cell variable.
-	; 3. Write down IP+2 to entry.
-	; 3. exit. we're done here.
-	ld	hl, (CURRENT)
-	ld	de, doesWord
-	call	DEinHL
-	inc	hl \ inc hl		; cell variable space
-	ld	de, (IP)
-	call	DEinHL
-	ld	(HERE), hl
-	jp	EXIT+2
-
-
-.fill 566
+.fill 677
 
 	.db	"_bend"
-	.dw	$-DOES
+	.dw	$-EXECUTE
 	.db	5
 ; Offset: 0647
 .out $