From 8214784bc6c77adb989fcfaaa845f03cd91d840d Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sun, 3 Sep 2023 15:21:56 -0400
Subject: [PATCH] rearranging code, implementing "type", progress / debug
 output

---
 tinyjort.com | Bin 1810 -> 1954 bytes
 tinyjort.jrt | 204 ++++++++++++++++++++++++++++++++++-----------------
 2 files changed, 135 insertions(+), 69 deletions(-)

diff --git a/tinyjort.com b/tinyjort.com
index 46113e9f2f7c25d1ec69261822d18a606a9f3365..7187a32b97e66a0cb17bf24a855470bdea961329 100755
GIT binary patch
literal 1954
zcmY+Fe@t6d6vxlK@4fpTpc5o9nM-iZ7&<oybsJ_IbktHN2F8!Et<Vfs%40)Ii;vd<
z3)z|&2o*I96PZ6UlP&%s3fZ#yhnd9b;wDj&Ib$T6EjVVhBUz$Z(kv`I&%Ljp{?okk
zx!-fnJ?GwYn;cYg<qwr_lqI%RyT>lFha{{$qkcxK)Qierv{_3j03MI^{AB!!^)vuv
zws!{2&PX_5^utCX5kzW1C}8S6CfXZ_$FomJiwLm%irNG22E_HGiGYTtr?$FwFVvIx
zG4Oglp7^bmu*}fSs1b%SQd5JA0v{!ig+3MDN^e7hw*uWfo{^`-F68Q}##Z=}OxCRg
z$g0{~UA5O+;cj%d!W@}A5Wgyx1_?+nG`GScX<A^D0!^luaO=vR+Q!;exKBPHAh#Ql
zZpfuRA<`&F?a^-7Kz((qN#vg1KsS_7pTEwo5<|$5W4Zw^A@lqE!Zm@hN{xsKtq7a;
z)zu5SmO_T98(p1YY!)1+iR$w(>)`Fv`}ANG*;~{viX)rhUGyY#t9eNwd_w)cP5&X!
z!Zec9qOGwk0ITF06`8D(8T$i+OJUr{AJn&t%~11Za=|)Bft0}mjK5>f{62ZZYD7>9
znGy#Bmy%yuHxamCod72%lIJlrNP%!W6d@9E&g{y=Xs45JSi33EhygF+O2(Wylss<b
zOF$iE&`VPEcRETanx))aD{(UyO&2#cVY&&B0vJMXN4m7b5|9BnE#ldwMUb?>1QKUj
zGs<I@!nD-n`*GeDo#k;|aGj$+|7}}2+?M<!sttZ4K-<dUzT|&hJ#C{H9&!|!CL=4p
zW5Zu0kjpy)2IR@AzhK3CQ39n+;O!i*hN#EwIiO1R`{JtT{w5jIIKYo&*d}fnWCsrz
zK~G;nTGt?BK!Jw@PK&ScN(^{U_Qfl4M(hj43pQX%uBjQR1bdgqF^y3UU&|wv%QpEO
z0~+EE|BOQ6_#H>$&fev^k(P(?mgRWmL$P=QD=Iju8#)fwSq%?a7Dg{olzC~CWGJ9;
z;K0*Tls)n&d6|M@3e84hSs%&3(sSQSY6y4Pseo!D?o>m#Q;lFfW{-XZ^8jq7py78Q
z6p92<)P=dG31p8`2kjDBUR6L2>Y)%m8x-2H04_CA`nWPq^OaE&P=IU^_8$3t<zpnb
zc*||nBu^6p9PXANgO6sf(TTHlS4osQXPRdn=`+S8k#0Q<lqJf}(^Wo(MF&HX9v#-P
zgv&qc5S?1WQagf?XxJ1bY-FHx7<!-`%2{H!zqx7F5ogaaA>GDMYNtHJ66OD2T$Vuc
z)>dL=mQ}|<?P!a3bl~H``_j*Y9??zS6kft0J49V<kTJQK&Ev2n$pw}}qimGKxw1Pd
zl-uYavrFcBKdwH;;E`Y?+!G1ug?d+~33ph6*C%$@#XuHtiri*DFvwa_zM}WTqiRB%
zb*xOmReZlY!yTO=emwxzs@yE(x?Ym6&Pxv5kyp*3S?VZx8}pvRQR1spWUHD9a0*)%
zj&`+Sb-Ef)wH&y{_9J&*cK+&|8D<C7;VYjG&Bd0$T)(h2wzT7<JGNLnkeMpluaY@;
za^8wBJ7?^NbK!o>bx;M9rsm?y&FR-Pwp1AXR`BRg!+8hQ<dhX#>Wk*S_JBm!lmSFD
zc*1N*zGKA}-2)e5S2B0z?N<lR#1@|zIJaVrCdVzG3M%f@)ngivt&O-;#pk?nDHBpl
zV@fehjPYRioR=r85>*jR+=6$<?C;jG5f1vdXhfryV*Jp?DWfhehvx8?PXkhfnl)Of
zHci$;3Y+w#n5n*!?by>o{O!|%*uukFAAPgrgto?~K=xbL<1C_lu?*8-{|o*D9u9p|

literal 1810
zcmY+FYitx%6vxlKGjs2DG0;eSL=-bZYfy?bN)>5K>vl^>TDGM~ww<KSb~_7;%Wj>{
z(xQzlArRK0G({r@@C%X{p_RyL4DvD<v}&V(iH#^eD#5V{pD;~R((&9o+o~USGv{~z
z=YP++j~VB0c0^smLToqxSnJ^x{0{krf5=xWS9t|{Sy`a%WB`GH`}AP;qWdTS_&efJ
zJDy5LtnE-l6oQBsCnC1lWn;XE1OiP`x{Lr@Toc+@y&iERX(r&qFc7K>t%F9A-3Gy6
zAdtO2W6LblPFqPBAocY)DDh?jb1<hSSQ}iwK3Ickfk5BGvI@0s?S?iuPX-%i4Cbs|
zSGRUuu%>!LbsLP5!HwBVa%eXJ<++wN7$?nRY*3=X{1BF|tqE-iwZU!T#{gI|y|vx6
z;69q2Xx;b)^HD#PUMRg*I=uJdi9Ms4DX<r2rdIAK%8W1X^-nDGQ8HTX{O)F_ONSe!
z_1Nv~bW4NxoSEuL&)+pk(sL^S(gnh<5S*Nw8L#dg$z1e5yU<5_PiMyO?L9veop4UM
zhY6@1R;m+@(6ICzprCZ5J7JK98)n;8ySgKtaDj%625-Hwd^NQVi~k;(5jJFM4!z2)
zlnoBT=B9jMM=2E8rnNPm#BBpr$<>{N5giS<*<(i2$nIARxy<BoSfqpvGCDgiDS;J=
z5nl2i@))c^GBNIHTo=GCYgFX?ZdsG};Kv@4SjUS>col0>?4O-6w?qL_0lUzD<*5CQ
zbH%+*ft14=67+uReCBRKMI{`QV8{E;NwfwflI(y_5J{hRRxL!ggU&v8m;y~%a0N#S
zM(sV$OYV>YRIh+;vQtSZ{bV18<sv*P!y_10if}-N)dWZ}6sloE&$sp$PTmWTASuX`
zNhGcC6q3?Bc|b+aa#*7_hp+zX^}iHRWhJx-^yk0JRs{*w=;I#vjR0-0f>%`IResPz
zeg%{?vH`)C|KY(771XL&#De!!ZWPaCr&Z9}B|b0kti?4fPlv0j5zcbC`lqmzb{%dY
z+3S(7(NGtLlb9JU&g*^>h7uQQ0_Vkzq7w@iYvF7y-d1T@DH^um8Lhs)uNJ&2RSl?B
z1$A0q?X*V%8fcb0!x0q9#ODQ)XVw<FzScY0*6D2R9XaU30*W`AmWfyVZXa&4DuZsa
zU)!SglLMG5fR4MhU%QOtHU-U=nj+%5PiVmMZ=h~cPejV+8gLJZq<SKfevquo?lL#w
zJOCe2@ZobLkw`^RG=X!SB~Yj<$LWNeWl94zY9<o+0;6yXYZOu&rH3_L8PfX6xCUgY
zj4!K2>`B&7Hse~fduR;Z2naZ=K!LcL-Buj$md$eIrNb>FdVY@?-rG(y3Hw;C;v}8r
z4>HiAiBy*f$5^h?7}4cQ?Z#GP(NsEV%N9OBQOq(U9q<*)tu|VkNAxT^!=&^aL#a3A
zO_r<r|KMH~lwhb9J9FJ18Sq$pIu^s1hgcVdqv<Bo7K<WUn8$C@FWEfaubyUG)Rf|o
zRs0Zjv9b9=*_oEgb95f}S{C{nIQlk&yP~ONS1Mtam|NpEBzaEsC###lwj~@Q32tzh
zGoyUL+zxN?oNq**xdoT-OA=4U;t6p)0FH7ImIz%p8RA>i<J2MFVnuKAe)16h7T{G9
wqeJ8@e^(xzp0X8~ihmBjhaRFkIaOXOyT#{*H7I=jyDXd3&P>Bu@V+|#0Q%fodH?_b

diff --git a/tinyjort.jrt b/tinyjort.jrt
index adbdae4..af13ac8 100755
--- a/tinyjort.jrt
+++ b/tinyjort.jrt
@@ -60,6 +60,8 @@ L: LATEST 0 w>t
 
 : :ASM DEF target @ 2 + w>t ;
 
+dbg" core"
+
 L: $$CONST
   INC BX INC BX
   PUSH @[ BX]
@@ -97,7 +99,6 @@ L@ $$VAR CONST $DOVAR
 
 ( some helpers for making manually defining colon words slightly less ugly )
 : '>t t' w>t ;
-: @>t t& @t w>t ;
 : :t DEF [ t& $DOCOLON lit ] w>t ;
 
 :CP $DODEFERRED
@@ -130,72 +131,6 @@ L: GOTO_IMPL 0 <:
 
 DEF GOTO_ L@ GOTO_IMPL w>t
 
-L: BASE 10 w>t
-:ASM number ( str -- num 1 | str 0 )
-  ( AX - current number
-    BH - 0
-    BL - current character
-    CX - current digit count, used to detect 0x prefix
-    DX - clobbered by IMUL
-    SI - remainder of string to be parsed
-    DI - saved IP, as SI will be clobbered by LODSB )
-  MOV DI SI ( save IP )
-  POP SI
-  PUSH SI
-  MOV BASE 10 #
-  
-  XOR AX AX
-  XOR BX BX
-  XOR CX CX
-L: next-digit
-  MOV BL AL
-  LODSB
-  XCHG AL BL
-  CMP BL 0 #
-  JZ 1 @> ( string end )
-  CMP BL key 9 #
-  JG 2 @> ( hex or fail )
-  SUB BL key 0 #
-  JL 0 @> ( not a number )
-L: parsed-digit
-  IMUL BASE
-  ADD AX BX
-  INC CX
-  JMP next-digit
-L: fail-digit 0 <:
-  MOV SI DI
-  XOR CX CX
-  PUSH CX
-  NEXT
-1 <: ( string end )
-  JCXZ fail-digit ( empty string is not zero )
-  MOV SI DI
-  POP DX
-  PUSH AX
-  PUSH CX ( we know cx is nonzero and will be treated as true )
-  NEXT
-2 <: ( hex or fail )
-  CMP BL key x # ( lowercase x )
-  JNZ 0 @>
-  CMP CX 1 # ( x is second character )
-  JNZ 1 @>
-  CMP AX 0 # ( first character was a 0 ) 
-  JNZ 2 @>
-  MOV BASE 16 #
-  JMP next-digit
-0 <: 1 <: 2 <: ( actual parsing of hex digit )
-  SUB BL key A #
-  JL fail-digit
-  ADD BL 10 #
-  CMP BL BASE
-  JL parsed-digit
-  SUB BL key a key A - 10 - #
-  JL fail-digit
-  ADD BL 10 #
-  CMP BL BASE
-  JL parsed-digit
-  JMP fail-digit
-
 :ASM drop
   POP AX
   NEXT
@@ -239,6 +174,7 @@ L: fail-digit 0 <:
   POP BX
   JMP @[ BX]
 
+dbg" math"
 :ASM +
   POP AX POP BX 
   ADD AX BX
@@ -257,6 +193,7 @@ L: fail-digit 0 <:
   PUSH AX
   NEXT
 
+dbg" comparisons"
 L: TRUE 0xffff w>t
 L: FALSE 0 w>t
 L: RETTRUE
@@ -313,6 +250,7 @@ L: RETFALSE
 :t <= '>t > '>t not '>t return
 :t >= '>t < '>t not '>t return
 
+dbg" bitwise"
 :ASM &
   POP AX
   POP BX
@@ -348,6 +286,7 @@ L: RETFALSE
   PUSH AX
   NEXT
 
+dbg" mem"
 :ASM @
   POP BX
   MOV AX @[ BX]
@@ -401,6 +340,7 @@ L: RETFALSE
   MOV @[ ES: BX] AL
   NEXT
 
+dbg" return stack"
 :ASM >r
   POP AX
   MOV @[ BP] AX
@@ -429,6 +369,24 @@ L: RETFALSE
   MOV @[ -4 @+ BP] AX
   NEXT
 
+dbg" ASMEXEC"
+( usage: push a CP onto the stack, then CALL ASMEXEC.
+  will execute the word and then return to your assembly code. 
+  note that this will clobber AX and BX and possibly all other registers!! )
+( does not work - I think LEA @> is broken
+L: ASMEXEC
+  LEA BX 1 @> dbg" forward label?"
+  JMP @[ BX]
+:ASM asmret
+  DEC BP DEC BP
+  MOV @[ BP] SI
+  RET
+1 find-patch @ . 1 find-patch cell + @ .
+1 <:
+dbg" patched"  
+  t& $DOCOLON w>t '>t >r '>t execute '>t <r '>t asmret
+)
+dbg" allocation"
 0 VAR, &here
 :t here '>t &here '>t @ '>t return
 :t here! '>t &here '>t ! '>t return
@@ -446,6 +404,7 @@ L: RETFALSE
 :t , '>t here '>t ! '>t cell '>t allot '>t return
 :t b, '>t here '>t b! '>t LIT_ 1 w>t '>t allot '>t return
 
+dbg" i/o"
 :ASM overwrite
   MOV AH 0x3c #
   XOR CX CX ( non-system, non-hidden )
@@ -516,9 +475,116 @@ DEFERRED emit console-emit
    '>t fgetc '>t return
 DEFERRED key in-key
 
+dbg" number"
+L: BASE 10 w>t L: ISNEG? 0 >t
+:ASM number ( str -- num 1 | str 0 )
+  ( AX - current number
+    BH - 0
+    BL - current character
+    CX - current digit count, used to detect 0x prefix
+    DX - clobbered by IMUL
+    SI - remainder of string to be parsed
+    DI - saved IP, as SI will be clobbered by LODSB )
+  MOV DI SI ( save IP )
+  POP SI
+  PUSH SI
+  MOV BASE 10 #
+  
+  XOR AX AX
+  XOR BX BX
+  XOR CX CX
+  MOV BYTE ISNEG? AL
+L: next-digit
+  MOV BL AL
+  LODSB
+  XCHG AL BL
+  CMP BL 0 #
+  JZ 1 @> ( string end )
+  JCXZ 3 @> ( starts with negative? )
+L: parse-digit
+  CMP BL key 9 #
+  JG 2 @> ( hex or fail )
+  SUB BL key 0 #
+  JL 0 @> ( not a number )
+L: parsed-digit
+  IMUL BASE
+  ADD AX BX
+  INC CX
+  JMP next-digit
+L: fail-digit 0 <:
+  MOV SI DI
+  XOR CX CX
+  PUSH CX
+  NEXT
+1 <: ( string end )
+  JCXZ fail-digit ( empty string is not zero )
+  CMP BYTE ISNEG? 0 #
+  JZ 1 @>
+  NEG AX
+1 <:
+  MOV SI DI
+  POP DX
+  PUSH AX
+  PUSH CX ( we know cx is nonzero and will be treated as true )
+  NEXT
+3 <: ( negative? )
+  CMP BL key - #  
+  JNZ parse-digit
+  CMP BYTE ISNEG? 0 #
+  JNZ fail-digit ( only one negative sign allowed )
+  MOV BYTE ISNEG? BL ( any nonzero value will do )
+  JMP next-digit
+2 <: ( hex or fail )
+  CMP BL key x # ( lowercase x )
+  JNZ 0 @>
+  CMP CX 1 # ( x is second character )
+  JNZ 1 @>
+  CMP AX 0 # ( first character was a 0 ) 
+  JNZ 2 @>
+  MOV BASE 16 #
+  JMP next-digit
+0 <: 1 <: 2 <: ( actual parsing of hex digit )
+  SUB BL key A #
+  JL fail-digit
+  ADD BL 10 #
+  CMP BL BASE
+  JL parsed-digit
+  SUB BL key a key A - 10 - #
+  JL fail-digit
+  ADD BL 10 #
+  CMP BL BASE
+  JL parsed-digit
+  JMP fail-digit
+
+dbg" num>str"
+:ASM num>str
+  MOV DI t& &here @+
+  POP AX
+L: write-next-digit
+  XOR DX DX
+  MOV BX 10 #
+  IDIV BX
+  XCHG DX AX
+  ADD AX key 0 #
+  STOSB
+  XCHG DX AX
+  CMP AX 0 #
+  JNZ write-next-digit
+  XOR AX AX
+  STOSB ( trailing 0 )
+  PUSH t& &here @+
+  NEXT
+
+dbg" type"
+:t type target @ '>t dup '>t b@ '>t dup '>t BZ_ target @ 7 cells + w>t 
+   '>t emit '>t LIT_ 1 w>t '>t + '>t GOTO_ w>t '>t drop '>t drop '>t return
+dbg" ."
+:t . '>t num>str '>t type '>t LIT_ key  w>t '>t emit '>t return
+
+dbg" test"
 ( test program )
-ARRAY hex65 key 6 >t key 5 >t 0 >t   
-L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t
+ARRAY hex65 key - >t key 6 >t key 5 >t 0 >t   
+L: test-word '>t hex65 '>t number '>t drop '>t . '>t terminate
 
 9 <: ( actual entry point )
   LEA SI test-word