From c01f114655d263b8452f300cc8f604b634832cea Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sat, 9 Sep 2023 14:08:22 -0400 Subject: [PATCH] cleanup, flow control immediate words --- asm.jrt | 6 +- boot.jor | 7 ++- build.bat | 3 +- debug.jrt | 3 + defs.jrt | 4 +- jort.com | Bin 0 -> 4244 bytes tinyjort.com | Bin 3260 -> 4244 bytes tinyjort.jrt | 172 +++++++++++++++++++++++++++++++++++++++------------ 8 files changed, 146 insertions(+), 49 deletions(-) create mode 100755 debug.jrt create mode 100755 jort.com diff --git a/asm.jrt b/asm.jrt index 21f8f51..b0f5b1f 100755 --- a/asm.jrt +++ b/asm.jrt @@ -56,6 +56,7 @@ array oparg2 3 cells allot target @ >r encode-op short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JMP + dbg" JMP!" 0xe9 >near-reljmp* 0xeb >short-jmp* 0xea >far-jmp* @@ -311,7 +313,9 @@ var ignoreimm 0 0xc6 >extbmem* 0 0xc7 >extmem* then - oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then ; + oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then + arg2 oparg-segreg? if oparg-val @ 0x8c arg1 >extwreg|mem* then ; + 2 :op ADD 0x00 >6group-math* 0 >grp1* ; 2 :op ADC 0x10 >6group-math* 2 >grp1* ; 2 :op AND 0x20 >6group-math* 4 >grp1* ; diff --git a/boot.jor b/boot.jor index a63697f..5d0076d 100755 --- a/boot.jor +++ b/boot.jor @@ -1,5 +1,8 @@ 0 const 0 1 const 1 +: 1+ 1 + ; +: 1- 1 - ; + 2 const cell : cells cell * ; @@ -7,11 +10,11 @@ 13 const '\r' key const sp -0x100 const F_IMMEDIATE - : cr '\n' emit ; : bl sp emit ; +0x100 const F_IMMEDIATE + : if ' BZ_ , here 0 , ; immediate : else ' GOTO_ , 0 , here swap ! here cell - ; immediate : then here swap ! ; immediate diff --git a/build.bat b/build.bat index 7e9a847..1e0a872 100755 --- a/build.bat +++ b/build.bat @@ -1,3 +1,2 @@ minijort < tinyjort.jrt - - +copy tinyjort.com jort.com diff --git a/debug.jrt b/debug.jrt new file mode 100755 index 0000000..b3000f2 --- /dev/null +++ b/debug.jrt @@ -0,0 +1,3 @@ +s" defs.jrt" loadfile +dbg" debugging!" + diff --git a/defs.jrt b/defs.jrt index f0737f0..f3c74d2 100755 --- a/defs.jrt +++ b/defs.jrt @@ -58,8 +58,6 @@ : break rswap rdrop :| yield done |; execute rswap ; : links begin yield @ dup not until drop ;done -: files findfile begin dup while yield nextfile repeat drop ;done -: .files files each type s" " type more ; : min ( x y -- x|y ) 2dup > if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ; @@ -83,5 +81,5 @@ dup 0 >= over 9 <= and if [ key 0 lit ] else 10 - [ key A lit ] then + emit ; : .bhex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ; -: .hex dup 0xf000 & 12 >> .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ; +: .hex dup 0xf000 & 12 >> 0x0f & .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ; diff --git a/jort.com b/jort.com new file mode 100755 index 0000000000000000000000000000000000000000..5075528a770e37de760cbe6b2f6622a0bfeef7f7 GIT binary patch literal 4244 zcmc&%dvKK16+icWul@EN7_DPkBnXjLkU*soHi5V#5DN*gJQh~NY_i|R)y?j9_uB+I zsR=`Cv!bG%roP(B(hgHWL`~FbQG-pv(h{}48l>Z+R5ao=ia7Whw&&b$BX!!p`cE?? z-1|H4bI&>VexqBwd*ra^xK}TUmUMbfxvul(Jx_Yx^*rOc-`nf@W=W$vTH^N?zOz3! zRJa1b22+08CEo`-3%YG{i})=9MI6XqM@;FY3K7e>0}D(cu+7c^JIsShJ8GD zazUY!3(iw$+m}w7@GPl74FVeW<$)R!Xtfr{Fjoombej~^51DU{zEhZul~WCOq5Z2z%;!g6DLla$_+U2y zLtRgg4i!3)qXzl~(EZTpV}%+?f^Z@NM-W0SyY&<1FGqh;*u^;{)9^P!N6gzsdkRmX zn`PC|%XUiLQl8z1TOVy772AEdt)cBMv0cL$l*6TRFjQ8I@+=zeg4u}ZMMRPrG(!y{ zl|^K#j5>X=THY9Z`7JB*1qjvDK!l+8E~IA(bjYD%KV6Tmwk&}k%b{Dfdn}euF*8}j z?k8;SKP)gI%djLGPQ#0Zbhivn$f2E@NcutaqooW!kVC;< z3wasUm60GQC|G1WN$Lc8F`~ipBCn3wnN#Wz3AxhIRmM<2Jx`I37>7B9mJ+{cJGPD};IF2z6^HoJ` zGRW#v*I{*if?kubiAcZVkq#?)##IKh#s0YLQ?FC=tQ(WlVnOeteg*`-Ea{@zJJT_2 z%U`GizRIJUhRduPxE;+VQ$_+FR|l#e;a}lP$b)z?W5Dz3Kuu`4Oyut87<{xfnN64? zs1am}rj2j}K2`@7hc;~-F3YL!sDkxf6*NJz@64W)-W2}XOq-hXs$ws3% zjwn;JHB{PWn3N_8p-LO%AE{N^z4A#+TDMfnBbuL2*YeCqoT;qf?Bi9M6*BR=k@|bp z39ZRQCK)#>jP{rbcWVO_pYU$7CW8P6S)cYpjYDf%n6txPZH&3_Z=P*YF`01zPZq$i zB7?a#WgrybKavBylz*)4)uu>Q{B3l}&-3hI&GD7dn~bgCunpLT%f=h-Q@l|c8n0Pb zA86QAhrxHlH*5;T5*WP*9saLBGlVZGlaApk+hIHw^s9oR=w*X8Q???0*GB6p(x8p1 z_Hmnv{zqeR>L!5CG#xT#B$g-)tSh)w_qV{*K_BZ z*FUFb5U)H`d7|=YubS0+haS3R#CF1*d~$xz7gu-J_MD#EWj{A3qqC9P(YFh^^OZ-f zJMZM#o|-IPaQxgz?);|WMcDI2MfQ&Z&%W9_DXWhjDD-@>B|BmJXDsW|4`p>S=Y`RG z3O%Q5yB_NqvM-#J(Yqe#IX$!M*W?@dQxr}RiW~zG8gvdUTkdKdaCl!-e#2A zAjVt~YR52LbGQRKZ@~7?q{6MnV%TjDR!;`gQ|$uNUTp_csn#K@|L2XG zr#?x>7Q-v#53&^s|BdZVy8@lbbc99^ou{8C^#I>xr)~uYtsdkr*$iqnoCc zn$)Yf+mUA<+BG5nzcs>;O~ZFxB$lqQMxRd!aG!Emk)97ej5pJi}AH(^4txAMphvjt~$7e4)?6?;j z;!_(9fQXSw#uE5GLOj4rDm?^Lueld*BlJTD6gp(jL1F z5=LhQr4z~h%I6B@E5PGwT*aNeU+LrXq&n%8a@cWPKBc_wnBfd?6IZnB`%@-TdF&tesjahm32!S=(RnK0UNdH5NmJ8 zgQX{CFQb4d&|23_*$T7Lr9yeeBr;8(KBs~KTFhw|-OM?Bv|Nv(bdRK6l$kc2v5-KZ zh%_P3LPVB3Z((uu4i~=UT#PLeJb6TRA=2T(+Ys*(Ik_%g)h$sEOm)k6(8PJ(<+;FF99_Mv$5qN#xW~|I%g$cB zqZb=#GV~_iPK)s}dK{bjs9gd=2iXSqi!Lg=_7u*`qQMz1nwC4=UN=q4ZF(uc-|fS7 zJN{00J1&?NMY<0&OQrCvdz-t8KkBAZc)-nBEGqI)iq+RI>X5uP+%hxb_%xuzRw2m> zoC@=}+^_i5c^KaBoHD~#6Lp3~z|wXqti@=HSy-N(awrU^65bu8=<7Bv_NXjvq>M17 z+_KUqoUl%QjjFJ4TUe;FsN~oiZiV67BxYUOq>#`_cuaA;|4GkyN)IZGO-CfDkFgoB z6A$G}n2M&Jk1AJFc6Z?{^-FY;a(iw-YmnJFkhb+FbuS~rO`ma^AoFWi%QmBEGEHYUJi3;x=t+V!!eDugQ0PlhcDq4Wfx{-SqZ(R zI&f@9c^^L@-(s)gSC-%5*wJY#MT>=X*%5l?hmnQpUIZEg9>=> RcrmAX)u(_x4c2G=zW{~TZ+R5ao=ia7Whw&&b$BX!!p`cE?? z-1|H4bI&>VexqBwd*ra^xK}TUmUMbfxvul(Jx_Yx^*rOc-`nf@W=W$vTH^N?zOz3! zRJa1b22+08CEo`-3%YG{i})=9MI6XqM@;FY3K7e>0}D(cu+7c^JIsShJ8GD zazUY!3(iw$+m}w7@GPl74FVeW<$)R!Xtfr{Fjoombej~^51DU{zEhZul~WCOq5Z2z%;!g6DLla$_+U2y zLtRgg4i!3)qXzl~(EZTpV}%+?f^Z@NM-W0SyY&<1FGqh;*u^;{)9^P!N6gzsdkRmX zn`PC|%XUiLQl8z1TOVy772AEdt)cBMv0cL$l*6TRFjQ8I@+=zeg4u}ZMMRPrG(!y{ zl|^K#j5>X=THY9Z`7JB*1qjvDK!l+8E~IA(bjYD%KV6Tmwk&}k%b{Dfdn}euF*8}j z?k8;SKP)gI%djLGPQ#0Zbhivn$f2E@NcutaqooW!kVC;< z3wasUm60GQC|G1WN$Lc8F`~ipBCn3wnN#Wz3AxhIRmM<2Jx`I37>7B9mJ+{cJGPD};IF2z6^HoJ` zGRW#v*I{*if?kubiAcZVkq#?)##IKh#s0YLQ?FC=tQ(WlVnOeteg*`-Ea{@zJJT_2 z%U`GizRIJUhRduPxE;+VQ$_+FR|l#e;a}lP$b)z?W5Dz3Kuu`4Oyut87<{xfnN64? zs1am}rj2j}K2`@7hc;~-F3YL!sDkxf6*NJz@64W)-W2}XOq-hXs$ws3% zjwn;JHB{PWn3N_8p-LO%AE{N^z4A#+TDMfnBbuL2*YeCqoT;qf?Bi9M6*BR=k@|bp z39ZRQCK)#>jP{rbcWVO_pYU$7CW8P6S)cYpjYDf%n6txPZH&3_Z=P*YF`01zPZq$i zB7?a#WgrybKavBylz*)4)uu>Q{B3l}&-3hI&GD7dn~bgCunpLT%f=h-Q@l|c8n0Pb zA86QAhrxHlH*5;T5*WP*9saLBGlVZGlaApk+hIHw^s9oR=w*X8Q???0*GB6p(x8p1 z_Hmnv{zqeR>L!5CG#xT#B$g-)tSh)w_qV{*K_BZ z*FUFb5U)H`d7|=YubS0+haS3R#CF1*d~$xz7gu-J_MD#EWj{A3qqC9P(YFh^^OZ-f zJMZM#o|-IPaQxgz?);|WMcDI2MfQ&Z&%W9_DXWhjDD-@>B|BmJXDsW|4`p>S=Y`RG z3O%Q5yB_NqvM-#J(Yqe#IX$!M*W?@dQxr}RiW~zG8gvdUTkdKdaCl!-e#2A zAjVt~YR52LbGQRKZ@~7?q{6MnV%TjDR!;`gQ|$uNUTp_csn#K@|L2XG zr#?x>7Q-v#53&^s|BdZVy8@lbbc99^ou{8C^#I>xr)~uYtsdkr*$iqnoCc zn$)Yf+mUA<+BG5nzcs>;O~ZFxB$lqQMxRd!aG!Emk)97ej5pJi}AH(^4txAMphvjt~$7e4)?6?;j z;!_(9fQXSw#uE5GLOj4rDm?^Lueld*BlJTD6gp(jL1F z5=LhQr4z~h%I6B@E5PGwT*aNeU+LrXq&n%8a@cWPKBc_wnBfd?6IZnB`%@-TdF&tesjahm32!S=(RnK0UNdH5NmJ8 zgQX{CFQb4d&|23_*$T7Lr9yeeBr;8(KBs~KTFhw|-OM?Bv|Nv(bdRK6l$kc2v5-KZ zh%_P3LPVB3Z((uu4i~=UT#PLeJb6TRA=2T(+Ys*(Ik_%g)h$sEOm)k6(8PJ(<+;FF99_Mv$5qN#xW~|I%g$cB zqZb=#GV~_iPK)s}dK{bjs9gd=2iXSqi!Lg=_7u*`qQMz1nwC4=UN=q4ZF(uc-|fS7 zJN{00J1&?NMY<0&OQrCvdz-t8KkBAZc)-nBEGqI)iq+RI>X5uP+%hxb_%xuzRw2m> zoC@=}+^_i5c^KaBoHD~#6Lp3~z|wXqti@=HSy-N(awrU^65bu8=<7Bv_NXjvq>M17 z+_KUqoUl%QjjFJ4TUe;FsN~oiZiV67BxYUOq>#`_cuaA;|4GkyN)IZGO-CfDkFgoB z6A$G}n2M&Jk1AJFc6Z?{^-FY;a(iw-YmnJFkhb+FbuS~rO`ma^AoFWi%QmBEGEHYUJi3;x=t+V!!eDugQ0PlhcDq4Wfx{-SqZ(R zI&f@9c^^L@-(s)gSC-%5*wJY#MT>=X*%5l?hmnQpUIZEg9>=> RcrmAX)u(_x4c2G=zW{~Tok28V%tFmLlp$k6bN#+^7pkLw zm?4vUe&>6i@B5uY@`$5dT9B`66OO&kOOCHP%Cru7lk*{m*EwkayZx|s67kYfC-*bFP#O17G5&=zRb1L2S_(ua_R0jQ82^y&U?9oNfQX=#JdEn*7k zHkQ;Q+`_iAl&OuiHPFK1Jy2d=S{lEW@}oe+uSX*xILfN4hk8K3eaucK%E~Ls>+8$Q zP_49d=n)D_f{j(1y>Nw%)};*Cp{izMRZV$W$>tI-B-vjY_gzcy z1fkmyZQ9gOhyR3udM-hCudfSwaHGyF3Pm37@kd|}k58^OdbyDN4I0jmgmpMVCeVUF zNw$#CQ-q>ffj-7hCiWpW-6})y6%UM zggrB_F+`eS0TEY9W{Pa)!$VS&`@QR?&|R`y2rCGh{rVn~yXo&_PJ$}&XE{+Fw(1(Z&ZXyB*hp^Al}=6mtxg?Pn1vH7k=hU{nj5kC&) z87H->Sj1SpoF@&lM${!B6OXB0K7`1xxD2|GS;-9Jj-)_}Gw>W4sk|hsDTtJs87aLi zux`EE-+_Jrc5o};w=WnBx1!K#^mUm*+6>R-r-hfZvIMREU=S&X!=Et-T6Cl6w7dj6 z>8DsTQq~di$}@bYJj{;E3?3KjL(;TtRfgFr84tjOM$kS30uNYhVsd*U0i3ZaC6VvC zxOF_!Jn!`ij&+wm1U@BEaDqR;KcWbN;ch=Xt0W3N z-`55|P!dI+txe;Zapl{J5IvxvsOj>Ik|_Sq%}tU8%4;hySHpNiQK7vh+TM=bLY0~z zqaA*o%0wwlDX;Rw%9PS1?Njoke9Ih5Q?vN{nAkK)c14Ax&ZiVJWs*OQyCKB^t>I92 zIOxyucLsDQRTGq-i0%@mEx>cEL|voWA4u--_d!riSjRK(PsCNc4FaL|K#&>+V3$hE z9FmK%K{Zdx<#X(Z7}0ihnBAtRaI9$e9NVvI0Dr-L2}L_wFuPx?@!96a-zo{jUFTgN zx-Q0)Q)+DN^%o}wkWn%wpBR{5zq@4M)|!58c6CB!6D7&(Mts3_(WKSMI|GHMRM7eC zM0{auifaevbE3Z!c=QjkWvA5SabsY9SM)Q3|76ic$W~DsIZT7(L1W-nN&m@#F>S-L zgxde=z^#Y-kKSK>EBRf60p5@>ZAn847C%2zRSLbZTaUni_1q3Ck?8Zv1vzJSqO$R< z6@KBf{#*jryR+-akuoV&B^7X8l-IyW{7Owt-woIKk!IA}B5K};9j^Cv`LS-fyj;}n zuhvGD&Ul6|<(I5kJc|#rh?T)=l=-^#E$d~L0gYH!C$~fIGuXb}UA|U-5iGK~3o<}o zT;K#pSyJwZ5HymlB*}=JlEPg`GUtq}6}=1>iB+bbWFsYtmzT}fBGa)-?;>l`fm<>lHTX}`Qq z8`5%l9)8hE=fs#FVt%=S(EYKW;d;uwj`rP}0@#LT++XEdQ7CgmmsI5Y{ys)%e4=)C0M-*Z&h`5d0AD- z=5k~-U@xgQ2y}Mhfzm@K#wcsb_L%*q#mx1fU4iUwowkWnKG9^%&J@0Crz@orZ`N(7 zN(XS&PUZQr%9uwWkU|_NvjLG2?M0TZe2l>ucE+9-GQ)_-4lJr2X&gzA&TK?`8qsv@ z+e>x}^x&mTSQIfTDB&Y^CvqD$K^H!0Q%8BsK4H0G&$m$T#~qVcW|C}mEdEq7MQ<^7 z!#>B}a9mD#X+(}K@<+%GO>z-V@@3`}^ZcaE0PH~EgQ${ts zE3n?KjNFV>8LOed#E{%tSe0|R!%DPm3dNYmnI{oP%~&axZ#ZdfPJ_ou$MLw+3VI;a jw>=!8+CJ=j8{M8g>|ErQA#LxKxN=551MHVz{&(PCcE|i3 diff --git a/tinyjort.jrt b/tinyjort.jrt index c762f83..e2933f4 100755 --- a/tinyjort.jrt +++ b/tinyjort.jrt @@ -14,8 +14,8 @@ dbg" assembling..." increment the instruction pointer. ) -JMP 9 @> - +JMP dbg" JMP" 9 @> +dbg" first jmp" : NEXT LODSW MOV BX AX @@ -43,10 +43,11 @@ L: LATEST 0 w>t : savelabel ( word -- ) dup type s" : " type - here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; + here swap begin dup b@ dup while b, 1+ repeat b, drop lastlabel ! ; : DICTLIST ( word -- tptr ) b@ BUCKETMASK & cells [ L@ DICTIONARY lit ] + ; -: strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ; -: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ; +: strlen ( word -- len ) 0 swap begin dup b@ while swap 1+ swap 1+ repeat drop ; +: str>t ( word -- ) begin dup b@ dup while >t 1+ repeat >t drop ; +: patchpt ( -- tptr ) target @ 0 w>t ; : patch!t ( tptr -- ) target @ swap !t ; : link>t ( tptr-head -- ) dup @t swap patch!t w>t ; : DEF target @ [ L@ LATEST lit ] !t @@ -57,7 +58,7 @@ L: LATEST 0 w>t cell + dup b@t POP AX POP BX - CMP AX BX + CMP BX AX JG RETTRUE JMP RETFALSE :ASM and POP AX POP BX - CMP AX 0 # + OR AX AX JZ RETFALSE - CMP BX 0 # + OR BX BX JZ RETFALSE JMP RETTRUE @@ -393,6 +410,13 @@ dbg" mem" MOV @[ ES: BX] AL NEXT +:ASM +! + POP BX + POP AX + ADD AX @[ BX] + MOV @[ BX] AX + NEXT + dbg" return stack" :ASM >r POP @[ BP] @@ -453,6 +477,7 @@ dbg" allocation" :t allot here + here! ; :t , here ! cell allot ; :t b, here b! 1 allot ; +: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ; dbg" i/o" :ASM overwrite @@ -498,7 +523,7 @@ dbg" i/o" -1 CONST EOF 0 VAR, fbuffer -: skip>t 1 + cells target @ + w>t ; +: skip>t 1+ cells target @ + w>t ; :t fgetc ( fp -- c ) 1 fbuffer t ] drop EOF ; @@ -511,6 +536,14 @@ dbg" i/o" NEXT DEFERRED emit console-emit +:t cr 10 emit 13 emit ; +:t bl LIT_ [ key w>t ] emit ; + +:t type + [ target @ ] dup b@ dup BZ_ [ patchpt ] + emit 1+ GOTO_ [ swap w>t patch!t ] + drop drop ; + :ASM console-key MOV AH 8 # INT 0x21 # @@ -518,10 +551,23 @@ DEFERRED emit console-emit PUSH AX NEXT +127 const INBUFSIZE +INBUFSIZE CONST INBUFSIZE +ARRAY inbuf INBUFSIZE 1+ ALLOT +t& inbuf VAR, inptr +:t buf-key inptr @ b@ dup BZ_ [ patchpt ] inptr @ 1+ inptr ! [ patch!t ] ; + 0 VAR, infile ( 0 is a predefined file handle meaning stdin ) -( TODO: whoops, this always calls fgetc, which works way better ) -:t in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ; -DEFERRED key in-key +:t stdin-key + buf-key dup BZ_ [ 1 skip>t ] return drop + ( if buffer is empty, refresh from file ) + INBUFSIZE inbuf 0 fread + ( if there's any more data, start returning it ) + fcount @ dup BZ_ [ patchpt ] inbuf + 0 swap b! inbuf inptr ! buf-key return + ( otherwise, EOF ) [ patch!t ] drop EOF ; +:t file-key infile @ dup BZ_ [ patchpt ] fgetc return + [ patch!t ] drop stdin-key ; +DEFERRED key file-key dbg" parsing" L: BASE 10 w>t L: ISNEG? 0 >t @@ -546,7 +592,7 @@ L: next-digit MOV BL AL LODSB XCHG AL BL - CMP BL 0 # + OR BL BL JZ 1 @> ( string end ) JCXZ 3 @> ( starts with negative? ) L: parse-digit @@ -587,7 +633,7 @@ L: fail-digit 0 <: JNZ 0 @> CMP CX 1 # ( x is second character ) JNZ 1 @> - CMP AX 0 # ( first character was a 0 ) + OR AX AX ( first character was a 0 ) JNZ 2 @> MOV BASE 16 # JMP next-digit @@ -597,7 +643,7 @@ L: fail-digit 0 <: ADD BL 10 # CMP BL BASE JL parsed-digit - SUB BL key a key A - 10 - # + SUB BL key a key A - 10 + # JL fail-digit ADD BL 10 # CMP BL BASE @@ -607,9 +653,11 @@ L: fail-digit 0 <: L: DECDIVISORS 1 w>t 10 w>t 100 w>t 1000 w>t 10000 w>t L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null ) :ASM num>str + MOV AX DS + MOV ES AX MOV DI L@ NUMBUF # POP AX - CMP AX 0 # + OR AX AX JGE 0 @> MOV BYTE @[ DI] key - # NEG AX @@ -622,7 +670,7 @@ L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null ) L: write-next-digit XOR DX DX IDIV @[ BX+SI] - CMP AX 0 # + OR AX AX JNZ 1 @> JCXZ 0 @> ( unconditionally write a zero ) DEC CX ( if we haven't written any digits this will hit 0 on the ones place ) @@ -643,11 +691,7 @@ L: write-next-digit PUSH DI NEXT -:t type [ target @ ] - dup b@ dup BZ_ [ 6 skip>t ] - emit 1 + GOTO_ [ w>t ] - drop drop ; -:t . num>str type LIT_ [ key w>t ] emit ; +:t . num>str type bl ; :ASM whitespace? POP AX @@ -668,7 +712,7 @@ L: write-next-digit :ASM eoi? ( end of input ) POP AX - CMP AX 0 # ( null ) + OR AX AX ( null ) JZ 0 @> CMP AX -1 # ( EOF ) JNZ 1 @> @@ -687,31 +731,32 @@ L: write-next-digit ( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return ( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ; ARRAY wordbuf 48 ALLOT -:t redir-here ( cp buf -- buf ) here >r dup >r here! execute r dup >r here! execute t ] & cells dictionary + ; :t new-word ( set latest ) here latest! ( create entry ) 0 dup , , - ( save word + calc length ) here word, here swap - + ( save word + calc length ) here word, here swap - 1- ( ignore null ) ( save length ) latest wordflags ! ( find bucket ) latest wordname dictbucket ( link to prev ) dup @ latest ! ( link bucket to new ) latest swap ! ; -:t 2inc ( x y -- x+1 y+1 ) 1 + swap 1 + swap ; +:t 2inc ( x y -- x+1 y+1 ) 1+ swap 1+ swap ; :t strlen ( name -- len ) 0 swap [ target @ ] dup b@ BZ_ [ 3 skip>t ] 2inc GOTO_ [ w>t ] drop ; -: patchpt target @ 0 w>t ; - :ASM dict-lookup ( name dict -- cp meta | name 0 ) + MOV AX DS + MOV ES AX POP BX ( dictionary ) POP DI ( name ) ( strlen - in DI: str, out CX: len, clobbers AX ) @@ -733,7 +778,7 @@ dbg" compiler" L: check-next-entry MOV BX @[ BX] - CMP BX 0 # + OR BX BX JZ 0 @> CMP CL @[ 2 @+ BX] JNZ check-next-entry @@ -779,8 +824,9 @@ L: check-next-entry :t var new-word $DOVAR , 0 , ; :t interpretword ( cp meta -- ) F_IMMEDIATE & state not or BZ_ [ patchpt ] execute return [ patch!t ] , ; -:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ , , [ patch!t ] ; -:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit 13 emit ; +:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ; +:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ; + DEFERRED err ?err :t compileword ( word -- ) lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] @@ -790,13 +836,57 @@ DEFERRED err ?err [ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ] [ patch!t ] drop ; +dbg" flow control words and misc." +:t if LIT_ BZ_ , here 0 , ; IMMEDIATE +:t else LIT_ GOTO_ , 0 , here swap ! here cell - ; IMMEDIATE +:t then here swap ! ; IMMEDIATE + +:t begin here ; IMMEDIATE +:t while LIT_ BZ_ , here 0 , ; IMMEDIATE +:t repeat LIT_ GOTO_ , swap , here swap ! ; IMMEDIATE +:t again LIT_ GOTO_ , , ; IMMEDIATE +:t until LIT_ BZ_ , , ; IMMEDIATE + +:t lit LIT_ LIT_ , , ; +:t ( [ target @ ] key LIT_ [ key ) w>t ] = BZ_ [ w>t ] ; IMMEDIATE + +:t inline| LIT_ INLINEDATA_ , here 0 , ; +:t |inline then ; + +:t :| inline| $DOCOLON , ; IMMEDIATE +:t |; LIT_ return , |inline ; IMMEDIATE + +:t s", [ target @ ] key dup LIT_ [ key " w>t ] != over 0 != and + BZ_ [ 3 skip>t ] b, GOTO_ [ w>t ] + drop 0 b, ; +:t s" state BZ_ [ patchpt ] inline| s", |inline return [ patch!t ] + LIT_ s", tmp-, ; IMMEDIATE +:t ' word lookup drop state BZ_ [ patchpt ] lit return [ patch!t ] ; IMMEDIATE + +:t loadfp ( fp -- fp ) + infile @ >r + infile ! + interpreter + infile @ + r 0x100 [ target @ ] 2 - dup r@ < BZ_ + ( past top of stack ) [ 4 skip>t ] drop drop rdrop return + 2dup swap @far . GOTO_ [ w>t ] ; + dbg" boot stub" :ASM debug NEXT -: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ; -ARRAY input t" 1 2 + ." -t& input VAR, inptr -:t keyinput inptr @ b@ dup . dup BZ_ [ patchpt ] inptr @ 1 + inptr ! [ patch!t ] ; -( t' keyinput t& key !t ) :t tinyjort interpreter terminate ; 9 <: ( actual entry point )