From b7244f89851f6555b112a42745962003634eed67 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 31 Mar 2020 21:46:52 -0400
Subject: [PATCH] forth: shrink forth.asm's binary size

---
 emul/forth/z80c.bin | Bin 1748 -> 1748 bytes
 forth/core.fs       |   4 ++--
 forth/forth.asm     |  39 +++++++++++++++------------------------
 forth/icore.fs      |   5 +++--
 4 files changed, 20 insertions(+), 28 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 9b00ce4efd37ff92e71bec86dff781de4fe13505..d141bf0a15e6b4bf7b15fa18e7ae3673ca5c0e74 100644
GIT binary patch
delta 927
zcmY*YOKTHR6#ni!laNdVAFZ*AY4J6hLN_insinQ0YOywUI<*l5DSe1oYDiN;S3z_i
z!KL;G2rgWRTM7LIfkHvZ!j0*w!KDz0=gduuE|Q$*cfWJamxI(n>dUlVdp|H7{}gLl
z5;Jp?_ZH8>bl@U(Byqj8Qr=#_;hjN@LkSAq_X9r(gI$AMxfBHce3*vK5se}XOS56W
z0JvyM{jo8E+4;~99tD1gJ)<M)keHk*1mP8aswR!6ro?z0!oeG(p-JTXwu@fx9p&z(
zRL+F}`-<0^caC|rL{)EzhE{?>xGmvgl!{8ophLF6p|)>!$pX5ft#ySYqHMbuLtAT!
z8oM8<A%WW(+X^I(&;P}^A%Q>IAwekEu1ISqPk-%oL|3Q>PxyHscq{v+qV_i8U4F4u
z@y>Jnly(gkJuLClP_RY(>Jh}w#%9&K3d_L=wks>EFGqK_*4E1#o3E<awHQt2hoJG=
zlSiS>JIzLG%9)`qb^fM<(DXUF0TpL6T+HF;{Uoo3k~PXMFHT&7&RD~A0>y(55f+vU
z!So=rXjm<gv`^OD5k(vmO->IfIXFkx?6fB7RR&h&B`V^jIxMF3tx9><yUD{djT!s9
z!N0VB5gmew@`*V3kUnj#X&qb2;}K3pG=aE-8GFwtVUQ?`NM`lutSq=9V#rc|9Yy>g
zj#Gs~IK~`D`oi%d6=tcFBCEAL`#e~ZDjxVxqAYJ!<@1+0Um{QjG)Pt7Y>BzqaDG7z
z?xJb&zvoU0uN_ou8kZu9-vzpJ=AY)KRU{QDcH^;#-vDyAxY4BxHm%=!hZOoO4e=K<
C7{=rP

delta 927
zcmY*YOK1~O6g_!wCNBxiw8c+LtuPjqPHmwep`g*y&!|I7W2O@tDJXTCf>`U2rW9AB
zbgesA-E`HRR6z)I=dQSN(UtBcAiC9Eymww&agpTRbARXFdvcsV&cC0P@x#8i*^60M
zdAKt_b$9U$Oba$LEf2%dN`137;`AWHP>!H`uJ3liVACLTrsDhVLeLGxh#;g~@q$hO
z@Y-z3&&CkEg~0Xi`)+_<GZg#qFg0EBgDc!BZW>=q54W;NS@>-fq=#bXZKK^b(jIQ-
zwa-QhY-?Vt&ROPF7C&TJ6l4U0>XwC#F$#(>fRNrP%*ly#L@yu`%Q6xk5#_gyaV%42
z%w`WI<nS&D(?znd|HC*Thi7t*O6anY*g0+eu^oy?=!Pf!oL%0^L|Rk(Lo*IX^(Pw*
z=N#jwv}2^Hv4@JO%U1EdO`%(B>)Xy%q%90#v#}CB9oyPit<~4opKs%5nybwe2O)Uv
zU9BU@I~`5dbYLFIrsQur2u*)LH=y9r0S;#PTgS<(A!kh9rNzk$kX-8$oj~*8Lj<Lz
zl0VzeEDEYDUaFHdhoXvKM3dcvS`JogSM7)<b>+f3Jfa|8s>NceZ8YjHoNGKh(>PSu
zP5!0*r;<Z3Q9coapXjqJUG-RLi$^#W(Im1K4ppxip`R$H5}EBMXJx@vk-;A2@1u&Z
z#BsV*3dWh^P)9gUqQX52B_xcCZ1Z4U6fx&MNW8pN?Jr(te?&#Oph2n{$#|Ief`zgk
z+=i?8-*Y36R~A}|#wA4aJ5P6hWBf~YRh3kv*?q_){Q7XSz=<|p&{Z`fBrQDZM(Qu<
CKD@gC

diff --git a/forth/core.fs b/forth/core.fs
index c526953..49c60e1 100644
--- a/forth/core.fs
+++ b/forth/core.fs
@@ -63,8 +63,8 @@
 )
 : DOES>
     ( Overwrite cellWord in CURRENT )
-    ( 63 == doesWord )
-    63 CURRENT @ !
+    ( 43 == doesWord )
+    43 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. )
diff --git a/forth/forth.asm b/forth/forth.asm
index 877367d..6f2e1a6 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -59,7 +59,9 @@
 	jp	compiledWord
 	jp	pushRS
 	jp	popRS
-	jp	nativeWord
+; 23
+	jp	(iy)	; nativeWord. why use a jump when the real deal is
+	nop		; more compact?
 	jp	next
 	jp	chkPS
 ; 32
@@ -68,7 +70,7 @@
 	.dw	INITIAL_SP
 	.dw	WORDBUF
 	jp	flagsToBC
-	nop \ nop \ nop	; unused
+	jp	doesWord
 ; 46
 	.dw	RS_ADDR
 	.dw	CINPTR
@@ -78,8 +80,6 @@
 	.dw	PARSEPTR
 	.dw	HERE
 	.dw	CURRENT
-	nop \ nop \ nop	; unused
-	jp	doesWord
 
 ; *** Boot dict ***
 ; There are only 5 words in the boot dict, but these words' offset need to be
@@ -91,15 +91,18 @@
 	.dw	0
 	.db	4
 EXIT:
-	.dw nativeWord
-	call	popRSIP
+	.dw	23
+	call	popRS
+	ld	(IP), hl
 	jp	next
 
+.fill 3
+
 	.db	"(br)"
 	.dw	$-EXIT
 	.db	4
 BR:
-	.dw	nativeWord
+	.dw	23
 	ld	hl, (IP)
 	ld	e, (hl)
 	inc	hl
@@ -113,7 +116,7 @@ BR:
 	.dw	$-BR
 	.db	5
 CBR:
-	.dw	nativeWord
+	.dw	23
 	pop	hl
 	call	chkPS
 	ld	a, h
@@ -126,14 +129,11 @@ CBR:
 	ld	(IP), hl
 	jp	next
 
-.fill 23
-
-; ( addr -- )
 	.db "EXECUTE"
 	.dw $-CBR
 	.db 7
 EXECUTE:
-	.dw nativeWord
+	.dw 23
 	pop	iy	; is a wordref
 	call	chkPS
 	ld	l, (iy)
@@ -144,7 +144,7 @@ EXECUTE:
 	; IY points to PFA
 	jp	(hl)	; go!
 
-; Offset: 00b8
+; Offset: 00a1
 .out $
 ; *** End of stable ABI ***
 
@@ -283,11 +283,6 @@ popRS:
 	dec ix
 	ret
 
-popRSIP:
-	call	popRS
-	ld	(IP), hl
-	ret
-
 ; Verifies that SP and RS are within bounds. If it's not, call ABORT
 chkRS:
 	push	ix \ pop hl
@@ -341,10 +336,6 @@ next:
 
 ; *** Word routines ***
 
-; Execute a word containing native code at its PF address (PFA)
-nativeWord:
-	jp	(iy)
-
 ; Execute a list of atoms, which always end with EXIT.
 ; IY points to that list. What do we do:
 ; 1. Push current IP to RS
@@ -409,16 +400,16 @@ litWord:
 	ld	(IP), hl
 	jp	next
 
-.fill 84
 ; *** Dict hook ***
 ; This dummy dictionary entry serves two purposes:
 ; 1. Allow binary grafting. Because each binary dict always end with a dummy
 ;    entry, we always have a predictable prev offset for the grafter's first
 ;    entry.
 ; 2. Tell icore's "_c" routine where the boot binary ends. See comment there.
+
 	.db	"_bend"
 	.dw	$-EXECUTE
 	.db	5
 
-; Offset: 0237
+; Offset: 01c3
 .out $
diff --git a/forth/icore.fs b/forth/icore.fs
index 0ad9d1c..5afaff4 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -240,8 +240,9 @@
 : X
     _c (entry)
     ( We cannot use LITN as IMMEDIATE because of bootstrapping
-      issues. 32 == NUMBER 14 == compiledWord )
-    [ 32 , 14 , ] _c ,
+      issues. Same thing for ",".
+      32 == NUMBER 14 == compiledWord )
+    [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] _c ,
     BEGIN
     _c WORD
     _c (find)