From ecca70c7f3f47d75180ef966b341ae9b401ebd15 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 1 May 2020 20:05:15 -0400
Subject: [PATCH] Add layer of indirection to EMIT

This would allow things like temporary giving control to the *CL
line on the TRS-80. For example... A very far fetched example. Not
at all the only *raison d'etre* of the layer...
---
 blk/081        |  18 +++++++++---------
 blk/143        |   4 ++--
 blk/213        |   4 ++--
 blk/352        |   2 +-
 blk/355        |  17 +++++++++++++++++
 blk/356        |  16 ----------------
 blk/359        |  30 +++++++++++++++---------------
 blk/360        |  33 +++++++++++++++++----------------
 blk/405        |   8 ++++----
 blk/442        |   4 +++-
 blk/453        |   2 +-
 blk/457        |   4 ++--
 blk/464        |   2 +-
 blk/465        |   2 +-
 blk/493        |   2 +-
 emul/forth.bin | Bin 5777 -> 5838 bytes
 emul/xcomp.fs  |   2 +-
 17 files changed, 77 insertions(+), 73 deletions(-)
 create mode 100644 blk/355

diff --git a/blk/081 b/blk/081
index 83b8219..3ff548d 100644
--- a/blk/081
+++ b/blk/081
@@ -1,16 +1,16 @@
 (cont.)
-RAMSTART  INITIAL_SP    +53       readln's variables
-+02       CURRENT       +55       adev's variables
-+04       HERE          +57       blk's variables
-+06       C<?*          +59       z80a's variables
-+08       C<* override  +5b       FUTURE USES
-+0a       PARSEPTR      +70       DRIVERS
-+0c       C<*           +80       RAMEND
-+0e       WORDBUF
+RAMSTART  INITIAL_SP    +55       EMITPTR override
++02       CURRENT       +57       readln's variables
++04       HERE          +59       blk's variables
++06       C<?           +5b       z80a's variables
++08       C<* override  +5d       adev's variables
++0a       PARSEPTR      +5f       FUTURE USES
++0c       C<*           +70       DRIVERS
++0e       WORDBUF       +80       RAMEND
 +2e       BOOT C< PTR
 +4e       INTJUMP
 +51       CURRENTPTR
-
++53       EMITPTR
 
 
                                                         (cont.)
diff --git a/blk/143 b/blk/143
index 8991213..cbe4edb 100644
--- a/blk/143
+++ b/blk/143
@@ -1,9 +1,9 @@
-: ADEVMEM+ 0x55 RAM+ @ + ;
+: ADEVMEM+ 0x5d RAM+ @ + ;
 : A@* 0 ADEVMEM+ ;
 : A!* 2 ADEVMEM+ ;
 
 : ADEV$
-    H@ 0x55 RAM+ !
+    H@ 0x5d RAM+ !
     4 ALLOT
     ['] C@ A@* !
     ['] C! A!* !
diff --git a/blk/213 b/blk/213
index abe21ea..1984516 100644
--- a/blk/213
+++ b/blk/213
@@ -1,9 +1,9 @@
-: Z80AMEM+ 0x59 RAM+ @ + ;
+: Z80AMEM+ 0x5b RAM+ @ + ;
 : ORG 0 Z80AMEM+ ;
 : BIN( 2 Z80AMEM+ ;
 : L1 4 Z80AMEM+ ; : L2 6 Z80AMEM+ ;
 : L3 8 Z80AMEM+ ; : L4 10 Z80AMEM+ ;
-: Z80A$ H@ 0x59 RAM+ ! 12 ALLOT 0 BIN( ! ;
+: Z80A$ H@ 0x5b RAM+ ! 12 ALLOT 0 BIN( ! ;
 : A 7 ; : B 0 ; : C 1 ; : D 2 ;
 : E 3 ; : H 4 ; : L 5 ; : (HL) 6 ;
 : BC 0 ; : DE 1 ; : HL 2 ; : AF 3 ; : SP AF ;
diff --git a/blk/352 b/blk/352
index 0c6979a..06305c6 100644
--- a/blk/352
+++ b/blk/352
@@ -11,5 +11,5 @@ ACIA_MEM
   +4 ACIA(
   +6 ACIA) )
 
-353 356 LOADR
+353 355 LOADR
 
diff --git a/blk/355 b/blk/355
new file mode 100644
index 0000000..8c25c82
--- /dev/null
+++ b/blk/355
@@ -0,0 +1,17 @@
+            IFZ, ( end of buffer reached? )
+                ( yes )
+                ( +4 == ACIA( )
+                ACIA_MEM 4 + LDHL(nn),
+                ( +2 == ACIAW> )
+                ACIA_MEM 2+ LD(nn)HL,
+            THEN,
+        THEN,
+    THEN,
+    DE POPqq,
+    HL POPqq,
+    AF POPqq,
+    EI,
+    RETI,
+
+
+
diff --git a/blk/356 b/blk/356
index 7dae0f2..e69de29 100644
--- a/blk/356
+++ b/blk/356
@@ -1,16 +0,0 @@
-            IFZ, ( end of buffer reached? )
-                ( yes )
-                ( +4 == ACIA( )
-                ACIA_MEM 4 + LDHL(nn),
-                ( +2 == ACIAW> )
-                ACIA_MEM 2+ LD(nn)HL,
-            THEN,
-        THEN,
-    THEN,
-    DE POPqq,
-    HL POPqq,
-    AF POPqq,
-    EI,
-    RETI,
-
-
diff --git a/blk/359 b/blk/359
index ec8e5c9..4e8634c 100644
--- a/blk/359
+++ b/blk/359
@@ -1,16 +1,16 @@
-: ACIA$
-    H@ DUP DUP ACIA( ! ACIAR> !
-    1+ ACIAW> !  ( write index starts one position later )
-    ACIABUFSZ ALLOT
-    H@ ACIA) !
-( setup ACIA
-  CR7 (1) - Receive Interrupt enabled
-  CR6:5 (00) - RTS low, transmit interrupt disabled.
-  CR4:2 (101) - 8 bits + 1 stop bit
-  CR1:0 (10) - Counter divide: 64 )
-    0b10010110 ACIA_CTL PC!
-( setup interrupt )
-    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
-    ['] ~ACIA 0x4f RAM+ !
-    (im1)
+: KEY
+    ( inc then fetch )
+    ACIAR> @ 1+ DUP ACIA) @ = IF
+        DROP ACIA( @
+    THEN
+    ( As long as R> == W>-1, it means that buffer is empty )
+    BEGIN DUP ACIAW> @ = NOT UNTIL
+    ACIAR> !
+    ACIAR> @ C@
+;
+: (emit)
+    ( As long at CTL bit 1 is low, we are transmitting. wait )
+    BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
+    ( The way is clear, go! )
+    ACIA_IO PC!
 ;
diff --git a/blk/360 b/blk/360
index 6be060e..f2d8b25 100644
--- a/blk/360
+++ b/blk/360
@@ -1,16 +1,17 @@
-: KEY
-    ( inc then fetch )
-    ACIAR> @ 1+ DUP ACIA) @ = IF
-        DROP ACIA( @
-    THEN
-    ( As long as R> == W>-1, it means that buffer is empty )
-    BEGIN DUP ACIAW> @ = NOT UNTIL
-    ACIAR> !
-    ACIAR> @ C@
-;
-: EMIT
-    ( As long at CTL bit 1 is low, we are transmitting. wait )
-    BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
-    ( The way is clear, go! )
-    ACIA_IO PC!
-;
+: ACIA$
+    H@ DUP DUP ACIA( ! ACIAR> !
+    1+ ACIAW> !  ( write index starts one position later )
+    ACIABUFSZ ALLOT
+    H@ ACIA) !
+( setup ACIA
+  CR7 (1) - Receive Interrupt enabled
+  CR6:5 (00) - RTS low, transmit interrupt disabled.
+  CR4:2 (101) - 8 bits + 1 stop bit
+  CR1:0 (10) - Counter divide: 64 )
+    0b10010110 ACIA_CTL PC!
+( setup interrupt )
+    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
+    ['] ~ACIA 0x4f RAM+ !
+    ['] (emit) 0x53 RAM+ ! ( 53==EMITPTR )
+    (im1) ;
+
diff --git a/blk/405 b/blk/405
index 57614bf..7a3264c 100644
--- a/blk/405
+++ b/blk/405
@@ -1,15 +1,15 @@
 : BOOT
     0x02 RAM+ CURRENT* !
     LIT< (parse) (find) DROP (parse*) !
-    ( 2e == SYSTEM SCRATCHPAD )
-    CURRENT @ 0x2e RAM+ !
+    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR)
     0 0x08 RAM+ !  ( 08 == C<* override )
+    LIT< (emit) (find) DROP 0x53 RAM+ ! ( 53 == EMITPTR )
+    0 0x55 RAM+ !  ( 55 == EMITPTR override )
     ( 0c == C<* )
     LIT< (boot<) (find) DROP 0x0c RAM+ !
     ( boot< always has a char waiting. 06 == C<?* )
     1 0x06 RAM+ !
     LIT< INIT (find)
-    IF EXECUTE
-    ELSE DROP INTERPRET THEN
+    IF EXECUTE ELSE DROP INTERPRET THEN
 ;
 
diff --git a/blk/442 b/blk/442
index 5ec04b2..26e6b3e 100644
--- a/blk/442
+++ b/blk/442
@@ -1,4 +1,6 @@
-( EMIT is needed for this unit to compile )
+: EMIT
+    ( 0x53==EMITPTR 0x55==override )
+    85 RAM+ @ DUP NOT IF DROP 83 RAM+ @ THEN EXECUTE ;
 
 : (print)
     BEGIN
diff --git a/blk/453 b/blk/453
index 5443342..f436650 100644
--- a/blk/453
+++ b/blk/453
@@ -1,5 +1,5 @@
 64 CONSTANT INBUFSZ
-: RDLNMEM+ 0x53 RAM+ @ + ;
+: RDLNMEM+ 0x57 RAM+ @ + ;
 ( current position in INBUF )
 : IN> 0 RDLNMEM+ ;
 ( points to INBUF )
diff --git a/blk/457 b/blk/457
index 0526a6b..47ccec0 100644
--- a/blk/457
+++ b/blk/457
@@ -1,7 +1,7 @@
 ( Initializes the readln subsystem )
 : RDLN$
-    ( 53 == rdln's memory )
-    H@ 0x53 RAM+ !
+    ( 57 == rdln's memory )
+    H@ 0x57 RAM+ !
     ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
       the last typed 0x0a and one for the following NULL. )
     INBUFSZ 4 + ALLOT
diff --git a/blk/464 b/blk/464
index 8eb9c4e..b239bce 100644
--- a/blk/464
+++ b/blk/464
@@ -1,4 +1,4 @@
-: BLKMEM+ 0x57 RAM+ @ + ;
+: BLKMEM+ 0x59 RAM+ @ + ;
 ( n -- Fetches block n and write it to BLK( )
 : BLK@* 0 BLKMEM+ ;
 ( n -- Write back BLK( to storage at block n )
diff --git a/blk/465 b/blk/465
index ca5cfa0..2ba2b0a 100644
--- a/blk/465
+++ b/blk/465
@@ -1,5 +1,5 @@
 : BLK$
-    H@ 0x57 RAM+ !
+    H@ 0x59 RAM+ !
     ( 1024 for the block, 8 for variables )
     1032 ALLOT
     ( LOAD detects end of block with ASCII EOT. This is why
diff --git a/blk/493 b/blk/493
index b264dbb..b3d2717 100644
--- a/blk/493
+++ b/blk/493
@@ -4,7 +4,7 @@ CODE KEY
     L A LDrr, H 0 LDrn,
     HL PUSHqq,
 ;CODE
-CODE EMIT
+CODE (emit)
     BC POPqq, ( c == @DSP arg )
     chkPS,
     A 0x02 LDrn, ( @DSP )
diff --git a/emul/forth.bin b/emul/forth.bin
index 3f040bcd04865ae3b4a976d41df75a4c21800ecc..cc418131a3f2f2c17c2888ba5b4af701bd293593 100644
GIT binary patch
delta 1803
zcmZ8hO>7fa5T5<9<6ZAQukCfxByD3NV{B-Gn$l4IQoQ+rHI75ElNPn8g-}vN>R2Ha
zKSFg&p!8C!<RQ^o2$3G5N^mGbY9uZ_a4LsfS}92>RS&3Y)LwExNF3PC>^dBJSo_U4
zGvCacpLe-qp+mX%E!?{c01LMjEzr^qsSiIsK9z=6-%TM71^7XB#H<{LVcrt3gp2%8
zU|+|VfiVccS)l+jRQ&}|;a52%ofW161^CUe;QcKicr<?S^Irldg}r=_k`zw!lJc@S
zt$d_d&^t7^-_G?jxWo|PH<ZR5(@NEEfz`jq&TDXyNobYXld<zE3JFZ5>X(!`k!*(Z
zMLTD@@R$qpRi$r3QnkPyP~bdTdvF{?un{fp?a#;H0;>s<vYo%DHZxmw&+5G3h?2sm
z)pM;&>Y91)P`*&i<cm=VuqCzX|A)5(w~|>QxLzv<tNt~9ej#|dVL2EF36}YbT3RUc
z0qsa|TB!-wwMSUFOZ<-ZeZ}QaF9}q&CUHcz;9VW7lxzmk<44_j(bHz@+H<>FLELoM
zcUn*GYH&|i^m9FQIzw3fgxF5P#tEyRuIT-Pc2NPDVb`#Kp)RTB(rd8RQfih3sq*CU
z(o{ML4eY7rnfNh33s!Xgm)_Of$+Ges-ZjFg<{4|~K(W0QzF>L&DqCNPun`}2tAJ@@
zpa42qkQ)fPlIlvm2RuoyOSu6Zle)`pF$)U&dsUFoG43i;r%K1t416rY7Fj!-nwUHq
zFHKCvk4=11I*JKUsMN%XbQ}rDVB&;~=zYG-ehjbW{=ByQMrbnfe^fO1Y{=wq7)_Bx
zXbcC}g4^}~Ee1bqyjJN79_Y*E2m1#%>Dc!;yiK)}u3|mxe2;<2X5~K&5>j5~B6wn2
zL*0T=b+xJErDNmi5ctvhnNbr~4M%j40`Vg!(=o(Xjga)rIPCLsAgLmgRdSJC$HJs0
zkB*l{-KLOE50j;eWm0hiWO%~2g*UXV=rvr<0FcfPTf-Jmq>$v`aIG3iUJ1WcX$yZ4
zrlET3++xoRieLd<aAymanT$8%Sd4)Nu8T_KOJNVs%4d9WB&OZ>oDyB=Bq?4|9C5+G
zM!;3kR@=e}cpQ!+4H=K%Ls56*t&z7<EBdHBFCL0ew%g#0o9#`UycN9w|KdaOW+w<N
zBwgcIBHi6K?vVix#HGlJPM-yx@6d+C0fYyl7!{+qGYlPwZ98(*1Tnfe6K$@LZjn{x
za&Qd(cD|Et3iQ#i2OulY3p3J;MDx(A)4V;z-%sHuJ+ITokyR&>k?-%%eeYu@`i2Mh
ze~$BZi~TH&$m4GEv>ltH^Dgt8IFB#jBgf+3L|NtF^J%ei`*v@PV7;>PpO`X=>o#gA
z((6(OdT0@-gmt;Ec#uYhidRQco<(3yPLNCupg4|*H<N9AuVk3>XXT{nRK!u)G^t$_
zFO9~g8IolD&I+ypY6fz{g}pCeCP{>8{3cD;e0LblzcOnAxp*T*O(NM5A4k2%f@s$z
z(RqZzAzNn`Z8!Bog>m0D;#*|bBKQc{g<=yj&YINEwfc`rWqHY5#5?YWQE6W6Hm{1f
z!K}<5nhCb7q2ExZuh~tUhhpu<tl5nOo$hrL&=KRASdTEvKa0K6a4mA5*|9Re6WgJ5
zo1?g+ajDFo#9j}1(q@S&lR<1pW1Bf(CcxkLIO>QA$TrHD{Kg0`H8yD!{_6%Ds$C%b
E2aF<*3IG5A

delta 1717
zcmZWpTWl0n82;zd?d<H%nb}*h6lEw&+2tC_Eh?>ax?AY7-BxxfZcN=QEi}lw+q5V`
zfJVF!9%wA*fjCV}l!TD<MH6C)QIkR{!3Qs?ghYHWNMbNG0bUHetp7i=)dwGD&iTLp
zdcOZZ=lk`O>%BKVf*W4~z~tv%zfzZyO;Gqo#S%vNsIo^G<KHMtLIouYzf>(KYylzJ
z)18w+=6@<<!Y2Njx8;qZcNk=_pc!Jv%7^06R5vZ05G;6g^}sTCmzBIPdoAef?dj`I
zCmEb|fGA9OCOl|U!v`AR94ZL1lDoPyet4fPC>C_=>gdj>C`2KPE(;2O<c)~9C~6|3
zs}^*3dEpFdhaIg6BD5l!+nvlr;5}vw3(87$MyQGwB-7bs05La`Yx$oZL)z-erdf3{
zL}za%o9oErLZGl&b;9#A-{jj)nP2y<^5=aMp2eJe$~Rem-DiRX*ZF3DT*&hQ{{dgg
zYYS)n_vNZM!oTxh8Fyl+XN6%<V2Ri-TaeI@(UwLK-T0_GBf8pDO?$Gf3B<L<x}w(7
zR`2XiX(!uhcbu@=4zV4Cl?bctPHC}`(Zl7VaX-|v-~G1Wr`R6MY{9(3SF+Z|M_Nk0
zjHkG*5$hdR@7`Q<6MVn|yv$aO-`4u;uoqb@fZ<4>lLhH6pChS`)VbG{w3?Le(m-aX
zScO@T?dw!QLPyh4I&;CGj@{O5)(pogqeEu7a@0Ijd9yr(1yHJ3<w)Gb0Ax@(A|ra9
zH|SpksrW@+h_&Z*UNpk|u|DuW)f}nT2LE90JRa5E^>3YjY-}EH^6gEeGd;<kwHmh6
z#CiHm)}@O`NOz{)z-m+SCk6>Iw{#I)5h;||q%q-WV~5L!N^u=LXgzD#!d0Ux(r_Vu
zU@RU%{Hmc#vqrJb%}vs{Oja#6D<U(o(V<d#Fy4Y~A>EITrHVYMSda|A@wWo2m(MG<
zK%`R?4?M-HD3dN#ac*$sUj?4scF$NDAYPtUD{R)F3>MG<cPvGo$#|n=<FNU`aZxGw
zRNyMtgUcEh6!-L1aneA_;iA~8-ZP?bjVFQ!WAn<OJR_PxD&cuJ?vyZ%*LfZvfdza7
zUfKWx)1?CcDY$K0E6%+Ecg3mTyh5J^8(yJ_HUWgY;#_bph%?U6fug;DF>GNjX!EvE
zqnDI6n~?Lo5NaByHm}oYV7|rwX}F?o*XS}#qu&Pf%ln4m*XpOzv_Ri^WHPa@r|%sc
zm<qck^vfluP8#pW!5Q>X;IcR)WZ^zmY^C>5+t(oHChY&W?FjE&6GXOB@}=>RW42<A
zA7y$1F1bKE%`|aTlM}f-HQ&Ux)R35Kp)AT#l8IqTR28ujxfLH387_NL@`F%S9F*_i
z-%S@s+dCm$y15^JCj{5Pg0A$w?Cxi<k_QOWAZ-mh_B#V;-xsz8@^OcQIzw_*yyk>(
z<F05y=YCAbe+V~hwOIk%knYarmZ1Mom|B*SXM_vV1!+(kk*C5oo@gfwN;Be<&_xli
z9?SEkktn<FN59^VM59wDPe+=Kq41LswS*2Ag@<8&I?^r-@vkH6>I=d1%pb|~hmjY(
zPeOxuw@fL|w=`_kU1_64Jai!TcEj@R-f$FdMXq7xQP3K0;`&#h846>^$H1y@hR#Z<
VR2&&QX!d65Enpwk<0Q3#@DHZzj=cZ?

diff --git a/emul/xcomp.fs b/emul/xcomp.fs
index 2067a6d..8b31d2a 100644
--- a/emul/xcomp.fs
+++ b/emul/xcomp.fs
@@ -16,7 +16,7 @@ H@ 256 /MOD 2 PC! 2 PC!
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-," : EMIT 0 PC! ; "
+," : (emit) 0 PC! ; CURRENT @ 83 RAM+ ! "
 ," : KEY 0 PC@ ; "
 422 470 XPACKR
 ," ' KEY 12 RAM+ ! "