From 6521a2127b0ddc79f9023a88874572f6a1fd4420 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Tue, 12 Sep 2023 23:27:46 -0400 Subject: [PATCH] massive refactoring; introduce "zipoff" assemble.jrt for creating assemble.com which has asm.jrt preloaded rebuild.bat for re-bootstrapping tinyjort from scratch and verifying that minijort and assemble produce the same binary small CGA textmode vocabulary with test program --- asm.jrt | 29 ++- assemble.com | Bin 0 -> 12361 bytes assemble.jrt | 13 ++ boot.jor | 8 +- build.bat | 4 +- coredefs.jrt | 188 ++++++++++++++++++++ defs.jrt | 62 +------ game.jrt | 9 + jort.com | Bin 4312 -> 4626 bytes logic.jrt | 190 ++++++++++++++++++++ lookup.jrt | 14 -- reasm.bat | 2 + rebuild.bat | 6 + target.jrt | 37 ++++ text.jrt | 47 +++++ tinyboot.jrt | 8 + tinyjort.com | Bin 4312 -> 4675 bytes tinyjort.jrt | 494 +++++++-------------------------------------------- zipoff.jrt | 96 ++++++++++ 19 files changed, 685 insertions(+), 522 deletions(-) create mode 100755 assemble.com create mode 100755 assemble.jrt create mode 100755 coredefs.jrt create mode 100755 game.jrt create mode 100755 logic.jrt delete mode 100755 lookup.jrt create mode 100755 reasm.bat create mode 100755 rebuild.bat create mode 100755 target.jrt create mode 100755 text.jrt create mode 100755 tinyboot.jrt create mode 100755 zipoff.jrt diff --git a/asm.jrt b/asm.jrt index 229e564..b56b39b 100755 --- a/asm.jrt +++ b/asm.jrt @@ -1,14 +1,4 @@ -var target -0x100 target ! -segalloc const tseg - -: @t tseg @far ; -: b@t tseg b@far ; -: !t tseg !far ; -: b!t tseg b!far ; -: +target! ( bytes -- prevtarget ) target @ dup >rot + target ! ; -: >t 1 +target! b!t ; -: w>t 2 +target! !t ; +( REQUIRES: defs.jrt, target.jrt ) var op-encode var lastop var lastlabel @@ -53,7 +43,7 @@ array oparg2 3 cells allot : encode-op ( -- ) op-encode @ execute 0 op-encode ! ; : check-encoded ( -- ) - target @ >r encode-op r encode-op ( patchid -- ) 0x13 set-oparg! @] ; : <: ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ; -: L: here create wordname lastlabel ! target @ , does> @ @+ ; +: L: here create wordname lastlabel ! 0 , target here cell - ! does> @ @+ ; : L@ [ ' ' , ] 2 cells + @ ; +( label redefinition - allows predefining labels when writing inline + assembly in the 'here' arena. ) +: L! [ ' ' , ] 2 cells + target swap ! ; : memreg create , does> @ oparg-base ! oparg-complete! ; 0 memreg BX+SI] 1 memreg BX+DI] 2 memreg BP+SI] 3 memreg BP+DI] @@ -204,7 +197,7 @@ var ignoreimm oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then then ; -: diffaddr ( opsize -- diff ) oparg-val @ swap target @ + - ; +: diffaddr ( opsize -- diff ) oparg-val @ swap target + - ; : oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ; : >short-jmp* ( op -- ) oparg-nearaddr? if 2 diffaddr dup byteval? oparg-mempatch? or @@ -236,14 +229,14 @@ var ignoreimm 1 :op LOOP 0xe2 >short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JMP + farptr? if 0x05 0xff >extmem* then 0xe9 >near-reljmp* 0xeb >short-jmp* 0xea >far-jmp* - farptr? if 0x05 0xff >extmem* then 0x04 0xff >extwreg|mem* ; 1 :op CALL - 0xe8 >near-reljmp* farptr? if 0x03 0xff >extmem* then + 0xe8 >near-reljmp* 0x02 0xff >extwreg|mem* ; ( four opcodes laid out next to each other: diff --git a/assemble.com b/assemble.com new file mode 100755 index 0000000000000000000000000000000000000000..0961549e6f2dc0bbb20f1211845ee0e5275b2bd2 GIT binary patch literal 12361 zcmZ{K3w%`7wfElp%$Zl-?*|hylP4rh9`p(gLLelALdsXxzMXOCeYwsw23Z+$xRp3LJ@4xmwlhEJ27loX? z{%fth_CD*i_sQwvqzNkz&TItf0s{B>%nErSXNl-C zUB{aE_-5wu)Ygvw$xv)&0e^5LFu?ZmhKAjnnIzxDV@O4vXO(CDdQTn1YHN4rMv5Qe zHfhItPffFDR@v^w(YYBjv9(-La+w9%Mip3#rVx0kKTqRm0)0IMFog+hR zgJ@|~lcow2TS%l{(bC$~*feX(H;8&Gs2i_oYQ+CiK@jZ2qrM^b0Dwldi?ou#&He!U znHWF0C^9M}=kGE1(!gMl{f1OPgQT7YwVJ5YM1@*OT`O!X=nwSw4)}t8_PIE?_5eHP zV$8z)Tl^g(pjoumNbxZtAk0#<`&Qx2NXchFS{h(QT0=v`cq45f1y-;sEwcHNP-KifEEGvWT1HgI&|$D?yfPYOzfP|MT?!jqHV%WvtxP z(pohgeB<=*A~_%|Wh;nqWb5J6M@}&+*a}eE*dIZuGgsEoo9eIkfRM-P^jJ0&=)0eIS=w9Wjnc@$WPzeR6Ok)r}3{%!0u zrK{0EFA~d*mV-+xk6wSwr5vTvf?PJ_A7EQ72bUcXGxRfLS>NEWpY5?6tZqH#lAdvu z+042+21f>hSnN9XBa6l*WT z>9t29FIz0Et9_)a3kkJ}+u5h2wA&w~?ep@BmML-2a?!F_f6S7s=a?L#&{`+XSdb@( zZ)imFO^Az@ox0*a0c?jQmURpc3=j7C-TwaGAlqO)NNbaeIEf`o;sM@lt+fi)5x`Vo zOx?<CAoBUI0w~*o0!`S!p_PeL=oqF-4 z9rf+I=9hK%x#_DmykKR&{)7EF6GQdzKj12ZJXZOWWz15dRBL5xRni!pp4hA|Y<#_ONO6<*|HHM<}xfpudFYbxig3)_1 zb;83};_a@ql-R4pD={JduQ3)Ws{&xgd$BPkEYM$KY|;Pp<93?`-DziUz^&3<5)y0@ za-gmi;6KWRKY&XI`-cp?GB(6Njxos@VQiQ`9rJk%5jV!#B(bZ{*R9ep6_0^ftE3M2 z`YGhY$kksU$AA2ZXiG8vDfquyJh1o4tUKwL$1O8DrZ6v@p^P^@DG?ZFOEp6tfW7^CUVxKmt z?J;kS9o6@k_r!){n?*97Xfz=x6boa~)bKi1zl=2_AOp%$iZx1H4$&RA zG_Fc)jH8rwA~r@AQ+MCs;LYfMzZ*wR*t)6mXnp0>*`J^LL;d{Y^}FNp*%R?JJ{snQpty}1FRUcMxrHY?B0c`L>qWBd&I#w8ek z9XrZPEgRxP{Kk0BuLLE`L!fklQXP+Sh=M}4e;s=zsHJe`@_3DHMps0%F3>#q8{&IG z?HD4rq|u+_G}ea-MB2iJ+*CX{O#cwFoP6mA_^a_B#M`4Zqy(h4cjDvXQH;o=hHwru zyu%iM$h0~>$3#(8o}k0K&cZxfLc%PkkqXE7>Uf8^CP7a?X+p_c?hlZq523~_M@b7J zJ=__iF`^#e-%9urD;ypw9Uf-4Cp4$aw|G;6osA51`U72kgQLsYzJ%MpVtiZd^Nj!3 zgs~aC9XZxZ2?W6LSSZPvN3+b0#N`N^n;M4h9D>QxN}sUvEane%zjQeqGD`OJ+M%#uQU zQKALw@9Q1#Z8fKk`a>a5dG{U8O_&#{g$KPy)=nP{b~@9)BP0Hn5;BAO>7!4k2Tjs*rlq5oN|U}com zw7^5gTcl=BeqzuMVTnrSOQV4Qg~l#h+mOvW?K$g$R>G^3^<{R#x^;p`m^Qq*qLwK^L z(Gwj=Q{+=Vo^s{WD4t5>(@s1s!c&O9oq{(u*iQ%BLL6+rmu8`%ud|cR2#hbmnC1cv z3$}@=v@!mZGzvO3rA@pkDHNY-YMb~Flu%lOq>u?V@uj46ND7%^6V`O%c~DZwB%8>V zlqV%cnf8MeD=SsIMlO6lwOPQ0HEUXkKbwj>6p9fqFHc_t!eo-hMkR$JzdXGJw8zqP zR7&5@2-Rm z;~BmTGWU@TNm>Zfg9gc)fg>R!o%qg*&tmxjs{gknqH1>wefmvfIy@hf4P9|^8N-*?7R>sFHUy9_g!VAe|2ZspB z$(qi{$=YI?&PdDH0{LHODTl`UR10B|LnfINBW^VFwEx8R!>s7*X^*b#l`MzI&CbcH z60YpUSs~7{EwBWwE3R$F`0I#_hpaZSGTS-e_XV72Gv6~v*JLlDq3S!gq}Z5>Q}_nt zo(GeTz<*wb+loxY33aeWEYn%+d}@-`on4@vPbH^)Hrpl+W%mxi{@zX}-pNQmPBTvO z+F@3n9pd@f(G8;Bq0b+bw~M#Hx2Vd0neFA&dE5ebbcj!~DFV)BPiBl~SBZouME~6qw$iInaBMccCK#%S3 z2>LtSGHFxgw~4@f_s0+|kR|D3+8E9T%n4g3G_9Eu@o z(60k!^Bi0-&n6*nrV6cJWkuo&to>yU<%IX5dgUP;@FYy`a!^1OIwr(^bU2heC~J?R$LeuVp1;CjQ^vS` zm5U&wGWtz3)PST?mmts!?8B*=GX8dl)sPB&6GHoimn)FU%`+J>%r`XDH#TD@O-UWp zkI~Pspf(2O7ZFF>dK|BEDIGlv9n^+R$R?0}9&_N}2>!JMqKK#LiG2@FN*&YrRJ!in zhrSp6N=^iwO|t%7=(6O1eFfN`N{XgJ%A$*iOmRL-R(lZQW)ye?G7<#fuouy8nVq3giyB$j1&l7YEoZJ;?29rA4r6y}T3}VqT*i)Lk+o{T*?Sn&sexdY zxdJLBo5mJm(9|dg_!LQq8t7~zA@ve5v*j4nsey$RVo!hnlz$8&n5(nehDL*< z!}-`Ia1cRp1fBnq>(nqqvlQ6jJaRtK#9HvFN{;tBfB${JtJkXGBhJ4MVOYCT2|wk0 z;1@K!u1+%l#`(j2n62^Jrq!z?;e_+SV=%wb+o;ALIRE(tjGJl<{H*gKhVk0yShybk z1lHjjnPG0SYk#~;5!8(Nu7AA*jyT1OE&<3SSsv$?q90F%_eKc8lOVrHK{#wzHbbzx=& z=khnmF%{&ReAOYM^(XQLZ_a-`e>!7+L5LqJut-4FGW5c* zaXMo{ya?=gft6MJw*(WV@`77*#r!5TUXmli6`R~M?u4Uo3swiz%kPp}ed-fZH*!ZA*5atjRB zH7|mpr!Y>=NSnCTu&Wy`Gg5eWp+me}ctc7{0d4^bX!Is#3-O;A5_E{UT%tuvoHryK za%3tZiQg5PS#@_{=o@4>MeLU>%s-M0#YJ_3CO8MmK}lIGMZ9U(g3$8%PSTeLphA?kr1JGq=d*#2#4D39nzrIMLG%Y#D4bB$HX#pq2;eC>C zZh?kGN$ILQ@0SMO3h)ufCH7Gv{fw}Kg&{tbk0R$$obMW(tHDX}OPusmaZX}xBwwjh zFODu_Surhxc7jf04sk^>Wt{(D7=X^Oyw9WO1|jC~FeOI*0gGF|HTW z!+a8Pui}7W=k{WF2dT%+Lf>WbpFm!Nypp*WG8>F&n<|E%;=mA{?f4vr$edS~PF8J5 zS8q?n<&HwZuBNI~p68rLJA<1o7Ag*L$2^T)y-p!j2J&r*Trm$K)DD#AH5oua0$wSi zkUj$$mPikYP=isPcb5SKC2+eGQOLsvG9r;55wg-FWu7yT%@TQ( zS{_M(LO9G%vp3;!XTTrke`ahRU5G_P>=OE!T3i9jmGsOg_#PB!GYU>g1!6{MQ$8xE zJTOsW+=1JTr0nSo3YfFx!0r73_h`R7@jhCDZ{8)8%pKzG5;`Bgi#V?m@0U;w5AmuZ z`g$F`n^_D^^p`Z9EU__4lF{29b%&y`r%I6Ml^Et%m1IIpXDmf_$tooa0B@lF@zJSWHwWSVm2Y6ZvUV`-QQcAJxQ5Jm+y=emBHx@sufI9 zZ(cw(cG4Sd~w_T$n|dP4_OKVpAn1qyUu}oM%c^MXDs*reKLf{B;4%igcI} zE!-y{NSWMPKzHr8qgQ(ylygO^c*zTqU-tn(B%e*(;vVDFZNM$Te?y9wXBUj>ccXOCPlwp+ChW&JA+*%4R2W@RFJ`GCQG+798f! zGHS!7WS>Mun-)-MVCpvVz-1g%@uTW?r(yQF(1eH+o`GkfzmYjyDX%B$3x7qGV1Ph%S*23Bkt=dL^Plt=l4z&lk{1 zU$sS!3RMm8iM%MpGb@02lxr?B5L`R~Ie}NuaILbS(LhWR!LNm|`Y3dh0qGK2UQBmX z%3pUFh*=_C6%dL-4;zq0LZ6^!uJx!o|0`+t;;gBR9Wo&PPeqvD!`?*{G4>ih#D(Ms zw!sDX9V7akO!Wz^&7wX~H=|jjPtzHd%_28#u~sR6$uLq;CkizBI)17GzpzAN^t*oW USdydfd<>V%^zUNrghg@we=&~@jQ{`u literal 0 HcmV?d00001 diff --git a/assemble.jrt b/assemble.jrt new file mode 100755 index 0000000..1373d40 --- /dev/null +++ b/assemble.jrt @@ -0,0 +1,13 @@ +s" defs.jrt" loadfile +s" target.jrt" loadfile +s" asm.jrt" loadfile + +:init segalloc ' comseg redefine ; + +: writecom ( filename -- ) + overwrite >r 0x100 + begin dup target < while dup b@t r@ fputc 1+ repeat + drop r here 0x100 - 0x100 r@ fwrite r infile ! @@ -66,3 +66,7 @@ key const sp : redefine ( cp cpdeferred ) cell + ! ; : definition ( cpdeferred ) cell + @ ; +( minijort implementations of words defined in assembly in tinyjort ) +: >rot r 2dup r@ >rot t ) +dbg" core" + +: :ASM DEF target 2 + w>t ; + +: NEXT + LODSW + MOV BX AX + JMP @[ BX] ; + +L: $$CONST + INC BX INC BX + PUSH @[ BX] + NEXT + +: CONST DEF [ L@ $$CONST lit ] w>t w>t ; + +L@ $$CONST CONST $DOCONST +0 CONST 0 1 CONST 1 + +L: $$VAR + INC BX INC BX + PUSH BX + NEXT + +: ARRAY DEF [ L@ $$VAR lit ] w>t ; +: VAR, ARRAY w>t ; + +( "codepointer words" that evaluate to a pointer to the assembly - + useful to define things like $DOCOLON. ) +: :CP ARRAY ; +L@ $$VAR CONST $DOVAR + +:CP $DOCOLON + MOV @[ BP] SI + INC BP INC BP + INC BX INC BX + MOV SI BX + NEXT + +:ASM return + DEC BP DEC BP + MOV SI @[ BP] + NEXT + +:CP $DODEFERRED + INC BX INC BX + MOV BX @[ BX] + JMP @[ BX] + +:CP $DOCREATE + MOV @[ BP] SI + INC BP INC BP + INC BX INC BX + MOV SI @[ BX] + INC BX INC BX PUSH BX + NEXT + +:ASM LIT_ + LODSW + PUSH AX + NEXT + +:ASM noop NEXT + +: DEFERRED DEF [ t& $DODEFERRED lit ] w>t [ ' '>t , ] ; + +:ASM INLINEDATA_ + LODSW + PUSH SI + MOV SI AX + NEXT + + +:ASM BZ_ + POP CX + JCXZ 0 @> + LODSW + NEXT +L: GOTO_IMPL 0 <: + LODSW + MOV SI AX + NEXT + +DEF GOTO_ L@ GOTO_IMPL w>t + +:ASM drop + POP AX + NEXT + +:ASM dup + POP AX + PUSH AX + PUSH AX + NEXT + +:ASM 2dup + POP AX + POP BX + PUSH BX + PUSH AX + PUSH BX + PUSH AX + NEXT + +:ASM 3dup + POP AX + POP BX + POP CX + PUSH CX + PUSH BX + PUSH AX + PUSH CX + PUSH BX + PUSH AX + NEXT + +:ASM swap + POP AX + POP BX + PUSH AX + PUSH BX + NEXT + +:ASM over + ( this costs 1 extra byte but should save 20 clock cycles ) + MOV BX SP + PUSH @[ 2 @+ SS: BX] +( POP AX + POP BX + PUSH BX + PUSH AX + PUSH BX ) + NEXT + +:ASM rot + POP AX + POP BX + POP CX + PUSH AX + PUSH CX + PUSH BX + NEXT + +:ASM terminate + MOV AH 0x4c # + MOV AL 0 # ( todo: pop? ) + INT 0x21 # + +:ASM execute + POP BX + JMP @[ BX] + +dbg" return stack" +:ASM >r + POP @[ BP] + INC BP INC BP + NEXT + +:ASM rot r 2dup r@ >rot r >r 2dup r@ >rot rswap r@ >rot r r >rot rot ; : 2drop drop drop ; -: negate 0 swap - ; -: abs dup 0 < if negate then ; - -: ~ -1 ^ ; -: f! ( b v flag -- ) - >rot >r r@ @ >rot ( val flag b r: v ) - if | else ~ & then rot ! ; : expile state if , else execute then ; +: ['] word lookup drop , ; immediate : :noname here $DOCOLON , ] ; @@ -36,46 +17,7 @@ : does> here 4 cells + lit ' finishcreate , ' return , ] ; immediate -: +towards ( from to -- from+-1 ) - over > if 1 + else 1 - then ; - -: for ( from to -- ) - ' >r , [ ' begin , ] ( from r: to ) - ' dup , ' r@ , ' != , [ ' while , ] - ' >r , ; immediate ( r: to from ) -: i ' r@ , ; immediate -: next - ' r , 1 lit ' >r , ; immediate - -: yield rswap ; -: done rdrop 0 >r rswap ; -: ;done ' done , [ ' [ , ] ; immediate -: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate -: more ' yield , [ ' repeat , ] ' rdrop , ; immediate -: break rswap rdrop :| yield done |; execute rswap ; - -: links begin yield @ dup not until drop ;done - -: min ( x y -- x|y ) 2dup > if swap then drop ; -: max ( x y -- x|y ) 2dup < if swap then drop ; - -: +!pos ( n var -- ) dup @ r >r r@ +! @ ; - -: lazy here $DODEFERRED , ' noop , ; -: >lazy! latest codepointer swap redefine ; - -: dbg" [ ' s" , ] :| type bl .s cr |; expile ; immediate +: dbg" ['] s" :| type bl .s cr |; expile ; immediate : .hexnib ( x -- ) dup 0 >= over 9 <= and if [ key 0 lit ] diff --git a/game.jrt b/game.jrt new file mode 100755 index 0000000..44cee71 --- /dev/null +++ b/game.jrt @@ -0,0 +1,9 @@ +s" zipoff.jrt" loadfile +s" text.jrt" loadfile + +key fill-page +nextline nextline nextline +t" Hello, inline assembler!" draw-text nextline +t" What a lovely day it is!" draw-text + + diff --git a/jort.com b/jort.com index 8d5ea91c4005e8f73d5361c07833627b38681728..a690dda9e6919daab6267dc666393916e8f96259 100755 GIT binary patch literal 4626 zcmc&&dvKK16+icW`+eWOUs9Ml;SuCfpbMlO@4vX{S0JN;EpDlu;x#QzUkxsAyxgxR5GF#$iM)Ww30|x!(fqw14%V zE-Z8J@1Dm!=bqOx{x_FNdEEJ#tHFKF{k*f&-sO7D+2wx7y~=*n^{)F?_jJcOcXf5X zv@bK1pABGy88yCY---r5%w#he0E30N0{k#2!4-q*>IOkPpD9GVwrVxP4Xl|Jc$fQD zKm*Hc0k5~ZI&-EVSb?~fOvNMc2&=E(wFLyciCIWQjkngjdbPI(*{Z8|P0i0f$V}oM ztG!iz?@eL5O0Vk%Fu?LU|9Uvb`c@V+7$6dj#^5Vf*ju1(#qzop-kK_Z)q1e-zO|VX z;^=2gg1eg5!xX-5Oz9I)U*QNqhGjm#Z#~TBFERrJ<0!F~HwvOVxdg#f4A%0-mAcXi z+yLJrD8w6^8&)>lyvpr_ZbNk4s)m*LR|rTVc_Q5!gZ+50QuiWR65XQ3;V{pPEy}04 zp!^f+UJ{Qc;Z+iW5(GMqXa%98grZo1F6SmlYVnRxq&2C*mwaG(Ka3OusGx1t0x85) zsX0G;gmYwuTco|U_%ed?2trHZFiWbh&lg^#1)=y-D3kJAt_hljk_>U-hI%9uP!&PK zjvq?9YOn2T`6knHEmQlAIHWk42c1%5GaJ>du45cZ=D}{Map`scFz~<=Qgh>+0?Bp> zNj&hJ)OhzzlDTjkNiJW|kzb(i7IZ{|a2mmqw=Z8^xmxHOmKZF6PWHA`!?WxPXE0Oj zdO7X$d4T+)yd+5TiM(9%=s>I}73KQh!Lbm(ys%=YQrrg}4?$=2!qERWt z$_QKdR~@v<23XqO8V8@OHqRvb|JDTW@oxpAkC z+>hdliSZyY7RVkTaRMDcv~kvTTD;=CVmOK1lA6)^e=VEgt~J&7c>VQN4fkN}alj`A z6D-G4(ct&h)*>Z<(>bxmFbrbCTvg;+e)(Higc1Ve!&f)e{XilR*@8bKWT z*{w>yL4{di%%nt;o=o{lPD@!*26S#flZvBG94^l=t%+_yy7*jwUons{<9y zBgNwVmnjOg2coG+Qke9BDnol*YYoB^>Of_4)4Gx3jIu|6*oRak)m0u<2bTW(;R0C# zua6!#pFgas(B776Z^yDpetMULZqSnCBp*Ag4)O!)S+!K&t-9sOh9Yh;*6_E`tdEH< zmJ)Qm{H#jm67>;0+pJn45RD|FVa=m;gp#ntI6$@uBZkpr0rs=S#yLg~fjFwlF*Ep# zIcCFuv+On%-53_|Gy!bI$4Pd^G=%*8HrdaM_bpIpk#QbGSR$q=h7za)JcJ--rYH6qIvweeD~F@Dfjj( zEM+qdrc9*H3FG_o-5095Ug#b&FP<{N-1SuVg}Gh7y1v_o#|*GQ!KacFM>Fx6WLD|o z6$$kF8T0PZJ%h)G&Dh0$qMVRDmq(YaeZ>eb9XB5}0QSf`P?a)fs2f+HWLRDZhcc&D ztmyotWbjZ6a@{LJ`;?i%e0;JG%{z?uV;C>s7D#Wzv`@rZ16n0iTN=x!LDErfgQU3} z4VBAHkTU&eQ>`^(jzmM1kg`x$mCN(_|3+3~ks%$82dUtA@o}7HKd-V-mOf>n)ghj+ zY{lJ>rG|UiTztT}s?%J?`z%?u&!P(6|1AMFnpB)YgQ2)bFLo|0qb{t8vNQw#P;LA% zhIFzcRydzz&9V`TL1@Iw=Gfzw_bmigT1^6M54Ud6i!HSXztt$vNNWeBd=4w}*I0A2 zY?D>Lbr?%#Cu_5oVj?_gqQnnsv1llQvm4@mp0@V#z1FnUgFGIq-k91_fz29~?^5}k z{G#D&#Un%(TZ|CV(jIao9=0e?D_)c^Nu8v&D34oOlwN*7>XY^$hdw}$~7unMZDfN-B!jcZB(+3SS_Mudcx7@ zW}I;YHVVS#^(Dh~C4-lqz5IUNoHy%wi}*ChX*_Sh z-d3r_>83ldnN?!%YQj3O$sz%v{cN7&4`^W`HZPHYRSy3|@mysNGo&IxE#4lErYj-j zc;FjgKefIL>_01m7ij||O+~4moFfEMp3i-bb4+y5*Ny{zDdF22)aFxx#aEznG)eo}l+cufCX&XX1mSx+m zGQ)z2EsezdtNhhYg~hd))~dfSY3LQ|_2B%6BD2;FtwNBlpDtD8lo<|7A$^h{afG%j zjC}_cIL$dW2R!(|Z#uI~cB*K9I26&kgmRORt{eBHU4<_F5YO&L>PkCji-~aDNx_Ui zmYke*-Hc_~m1R2|5+tTmd{SM`;oRI~ID~b$$Iym4*SO}YWxULFy)rLwah8~l#1u_Q z*SNFPMM83{)K!XgvdziZY*KC=#L_`DS=ZC}j72U=@77>@3=gSUyQIgkpMUP4^$fAj zvPWD-ok;iW57ehzDZF!~Q-+{MgC8Zpp`OC8fE*@i4zumDD~Gw6W2bS2Vdtdq3?&nRcqo=kh!SLR$*`C}RJ_~m#z5Qc zPRn{}VQvM2*br_UQslqo_H(kuCAsA?ehlxFWmD}2=%B#qXP-L`yN!?xMLIV{<0SNm e`;7Ywqy z_@m0R;v5`Oz~8+cE_8a3tu1U$QM*`Z~aX z_c9x)*icYdP*zs30mbt3`)-UcdyT1vt7Qdw+X}8K>$~%^Z2%EA7j3Hri61IWSP;SI z_XprQp4i)6xZ6&pE z4}YJD&=f?C9_}`nYPbMRkpOgYcd2RgPAvZoV<`9$ zvWGhB1MmtGO3f@%B>oOP2=DOd%$j(o>HW88J2U7H!)K%dH5l@Cl+Pyg0->nZK>b{W zupVsp`0(6dkub9PFia%VN$L;ijS<9d6{_g?8LWgm1a}piHr??u4(Tglli<$1>^Or| za0^xL6$zFc0a;R^O>l3z%5p0_h%9sGOe7u$h_CscVE7VW^SHSR9-r z+0WvoSY25VL;H76hu@z4ZT$C~K_(n0V7&Y2?0Ec1r*+62b>X355wg zN9Yv|Dms@8aj|NjVkG?|^rImeG^xtnYa(-~E|~pSQc35OAxk}`x@DaKM{2Dcge zd9hCJkz;HKlha^APASL;niEu`)jNY8Y|3NuNM`!U%86vN0$xC){($a-DS0I8Fu#H~ zk$tZ}q{Df6B)e)N*~r`&hTh!hkNCnyNZ%q;b5O5uf`!URPF3ZOiR7rPm}jXf$ZDEg zt&HUUD={VtP*75ck;dao6$P3bBF)V>j3`gV3My^U!<3{Tt5jzAHAT;i4QZdsc4+kbLVmBFs<(T>5K~4dHY14jiUQ+mJ(8@-+Q`%}FbzfSDkIwZm#R8->p=N<wYg4TNJFqH!k@f~Gpr_R6TusHV<-LffkENeZKiMnqQ+vmse{9-vI(*Yi zM$d)2cjon+OY64It=g-y>Acxb;?Ya#C(WB~=9`}EeR!?$x#{So%Ea~8b0IZy!oVY^ zdT-dL&b|=ux$r<_!J~g?5r;Y!QOTSJvjg#-b9vn__KaKC-mq8ge!Az}t=&Jpy!$?q z8Q{YQ&I%e{ipHm3Rmkz|5axZmbeAt)dH{FWgQhE{Wo)W zp(%MrESi-e{iKuz!_jw(i@QEg9~-VgsqIE-7g-ss!XvxaIKSy4O=DX^aq=0;I!i5 zMAc6IvX#2@dK;}K_#ds8aF=Oo;jL_l=93&%t9gno#;i8Qkp15p;1i32FS{mBFx4D( zby6p$Xkf8UY#X_5CSVU(9eyy#{M&Pe(ssT28>s!oWn}Nf2 z!e%j0Uwu2Zyny$qPbR`l!fP*%%t3bAb`%?7kxGrWBrjJq(l)gB)W%|c<6(>KO6yNoRvG<~IRqtTVaPuQQb zSM!(cG_=y}Hsdj#>h=5E@a=fUPGwkCn|`t=eeCOB%)MW<;+>-1(h}EuAG7i3*L^qQ zW9XK(B|P$%t=pq#9z8Dp`PteXk+XdpIeYWbajCpC`a7c%x6_j>vED7?g=wlEWX0?Q zI}UG5Sz&F_mMsMvis-G4PkpASDtOx4@lfeOImjqn3bWi%ESf>)J7h=+g^5fP=Q+EC z;hD_49CQyK!l&GQC>mtD9F&zuRK}`s-U3S@Obn|*w%>uX&?#`iIBUE@@HWoTgJfnN@1h*MdM2@rXRHDcI>{QH zXVAS+U}Y!-QRlWrMy~I7S|Q?V(u2)je`gN-#QDfYU=Q1m0Q=9zeh7IRTlK~^Ok86d z+IiZU!#{W4#{b~Fq9PgQ4YNm_RM+hR9L9;*);VZ;%dW*v8pThlIedX@6Rx}PdpmMp z$%WAc3;Aodg^8NWbuHw7bH3@U=F4$KmAA;nnWq^&z&J7dDalM}zf)wo7vCL3s73<8 z)B*G2lvF2IU_RfniwvJ*)PN=-#(rp*ScBf;F|ioCXp0<3(|A>1V54(TaHLn75EBx z32R`9hLgvoU~aq~pWbb7-}X-dTQmi_O(My;V(euHXKRTuTca|Kv0{z0?yFT=i5ky3 z1qj_tvyW!3z;6akoWL2YiD%K~ur?%D^Cz^+Q+F3C2;Gd#RB$J?Y;BK5N(8<~JB%}M z$i>()q`qcb=V;-?GplJxkFonTYTf##<^YoEDz1|jsPkfqi`F4y9b@M-i^*i>`;`1w z?JM-U$0b3NPR}}On)fggfiJ|sW9+EQLc?2c#)KfT4ks&h>#`)AlLUI`ZvzPewe?mz zhgCG3A9s%8l*eZ?y3U~jpU#g-uVcJ}N%RCefKz`rALWzcGuCRpD=Eg@Nfroud|lu5 h2kDqnT-RdxygHiXbW5N;@orSUUB)gs3g({${sB%>1uOsn diff --git a/logic.jrt b/logic.jrt new file mode 100755 index 0000000..a3e014d --- /dev/null +++ b/logic.jrt @@ -0,0 +1,190 @@ +dbg" math" +:ASM + + POP AX POP BX + ADD AX BX + PUSH AX + NEXT + +:ASM 1+ + POP AX INC AX PUSH AX + NEXT + +:ASM - + POP BX POP AX + SUB AX BX + PUSH AX + NEXT + +:ASM 1- + POP AX DEC AX PUSH AX + NEXT + +:ASM * + POP BX POP AX + IMUL BX + PUSH AX + NEXT + +:ASM /mod ( n1 n2 -- quotient remainder ) + POP BX POP AX + XOR DX DX + IDIV BX + PUSH AX + PUSH DX + NEXT + +:t / /mod drop ; +:t % /mod swap drop ; + +dbg" comparisons" +L: TRUE 0xffff w>t +L: FALSE 0 w>t +L: RETTRUE + PUSH TRUE + NEXT +L: RETFALSE + PUSH FALSE + NEXT + +:ASM not + POP AX + OR AX AX + JZ RETTRUE + JMP RETFALSE + +:ASM = + POP AX + POP BX + CMP AX BX + JZ RETTRUE + JMP RETFALSE + +:ASM < + POP AX + POP BX + CMP BX AX + JL RETTRUE + JMP RETFALSE + +:ASM > + POP AX + POP BX + CMP BX AX + JG RETTRUE + JMP RETFALSE + +:ASM and + POP AX + POP BX + OR AX AX + JZ RETFALSE + OR BX BX + JZ RETFALSE + JMP RETTRUE + +:ASM or + POP AX + POP BX + OR AX BX + JZ RETFALSE + JMP RETTRUE + +:t != = not ; +:t <= > not ; +:t >= < not ; + +dbg" bitwise" +:ASM & + POP AX + POP BX + AND AX BX + PUSH AX + NEXT + +:ASM | + POP AX + POP BX + OR AX BX + PUSH AX + NEXT + +:ASM ^ + POP AX + POP BX + XOR AX BX + PUSH AX + NEXT + +:ASM << ( val count ) + POP CX + POP AX + SHL AX CL + PUSH AX + NEXT + +:ASM >> ( val count ) + POP CX + POP AX + SHR AX CL + PUSH AX + NEXT + +dbg" mem" +:ASM @ + POP BX + PUSH @[ BX] + NEXT + +:ASM b@ + POP BX + MOV AL @[ BX] + CBW + PUSH AX + NEXT + +:ASM ub@ + POP BX + MOV AL @[ BX] + XOR AH AH + PUSH AX + NEXT + +:ASM @far + POP ES POP BX + PUSH @[ ES: BX] + NEXT + +:ASM b@far + POP ES POP BX + MOV AL @[ ES: BX] + CBW + PUSH AX + NEXT + +:ASM ! + POP BX + POP @[ BX] + NEXT + +:ASM b! + POP BX POP AX + MOV @[ BX] AL + NEXT + +:ASM !far + POP ES POP BX + POP @[ ES: BX] + NEXT + +:ASM b!far + POP ES POP BX POP AX + MOV @[ ES: BX] AL + NEXT + +:ASM +! + POP BX + POP AX + ADD AX @[ BX] + MOV @[ BX] AX + NEXT + diff --git a/lookup.jrt b/lookup.jrt deleted file mode 100755 index 470c6c1..0000000 --- a/lookup.jrt +++ /dev/null @@ -1,14 +0,0 @@ -:t entry= ( name len entry -- f ) - dup wordname swap wordlen t ] - ( fail ) [ patch!t swap patch!t ] drop drop 0 return - ( success ) [ patch!t ] drop drop 1 ; - -:t lookup ( name -- cp meta | name 0 ) - dup strlen over dictbucket - [ target @ ] @ dup . dup BZ_ [ patchpt ] - 3dup entry= BZ_ [ swap w>t ] - ( entry found ) >rot drop drop dup codepointer swap wordflags @ return - ( end of list ) [ patch!t ] drop drop 0 ; diff --git a/reasm.bat b/reasm.bat new file mode 100755 index 0000000..c61f5f9 --- /dev/null +++ b/reasm.bat @@ -0,0 +1,2 @@ +assemble.com < tinyjort.jrt +tinyjort.com < assemble.jrt diff --git a/rebuild.bat b/rebuild.bat new file mode 100755 index 0000000..8b25df3 --- /dev/null +++ b/rebuild.bat @@ -0,0 +1,6 @@ +minijort.exe < tinyboot.jrt +copy tinyjort.com jort.com +jort < assemble.jrt +assemble < tinyjort.jrt +fc /b jort.com tinyjort.com + diff --git a/target.jrt b/target.jrt new file mode 100755 index 0000000..152ffd6 --- /dev/null +++ b/target.jrt @@ -0,0 +1,37 @@ +defer target +defer target! +defer @t +defer b@t +defer !t +defer b!t + +: asm-here + ' here ' target redefine + ' here! ' target! redefine + ' @ ' @t redefine + ' b@ ' b@t redefine + ' ! ' !t redefine + ' b! ' b!t redefine ; + +segalloc const comseg +var comaddr +0x100 comaddr ! + +: asm-com + :| comaddr @ |; ' target redefine + :| comaddr ! |; ' target! redefine + :| comseg @far |; ' @t redefine + :| comseg b@far |; ' b@t redefine + :| comseg !far |; ' !t redefine + :| comseg b!far |; ' b!t redefine ; + +: +target! ( bytes -- prevtarget ) target dup >rot + target! ; +: >t 1 +target! b!t ; +: w>t 2 +target! !t ; + +asm-com + +: ALLOT ( n -- ) begin dup while 1- 0 >t repeat drop ; +: patchpt ( -- tptr ) target 0 w>t ; +: patch!t ( tptr -- ) target swap !t ; + diff --git a/text.jrt b/text.jrt new file mode 100755 index 0000000..80e0e8e --- /dev/null +++ b/text.jrt @@ -0,0 +1,47 @@ +0 VAR, textpage +0x0f VAR, textpen + +80 const pagew +25 const pageh + +0xb800 CONST TEXTMEM +: PREP-TEXTCOPY + MOV ES t& TEXTMEM @+ + MOV AH textpen @+ + MOV DI textpage @+ ; + +:ASM fill-page ( char -- ) + POP AX + PREP-TEXTCOPY + MOV CX pagew pageh * # + REPZ STOSW + NEXT + +0 VAR, textpos +: textx textpos @ pagew % ; +: texty textpos @ pagew / ; +: textx! texty pagew * + textpos ! ; +: texty! pagew * textx + textpos ! ; +: nextline texty 1+ pagew * textpos ! ; + +: PREP-TEXTCOPY-XY + PREP-TEXTCOPY + ADD SI textpos @+ ; + +:ASM draw-text ( s -- ) + MOV BX SI + POP SI + PREP-TEXTCOPY-XY +L: draw-next-char + LODSB + OR AL AL + JZ 0 @> + STOSW + JMP draw-next-char +0 <: + SUB DI textpage @+ + INC DI + MOV textpos @+ DI + MOV SI BX + NEXT + diff --git a/tinyboot.jrt b/tinyboot.jrt new file mode 100755 index 0000000..e199054 --- /dev/null +++ b/tinyboot.jrt @@ -0,0 +1,8 @@ +s" defs.jrt" loadfile +dbg" loading target.jrt" +s" target.jrt" loadfile +dbg" loading asm.jrt" +s" asm.jrt" loadfile +dbg" loading tinyjort.jrt" +s" tinyjort.jrt" loadfile + diff --git a/tinyjort.com b/tinyjort.com index 8d5ea91c4005e8f73d5361c07833627b38681728..2164fffe07ba08335bdc565929e4046a4515573e 100755 GIT binary patch literal 4675 zcmc&&dvH|M8UN0?d+*)%E4F`VK!SuQX&|dJU?2&EWCIxp31r2Dt${plU}3Yn?js>> zlql4)iNdhj45cl7Ol2%JnrcKDi>6W$Y*A55<4|=aR*B41iy$&6+wVJf1MS$q`cD^@ zIp=r2_xT=YnJ93Zls`LfaBp+x<_#qe zX9@s}Fr%ujvTj9#5As<)17J{$E5Hu}53U$gRyGLY*-Rng)fKA{ZeV_v7*Ogw!4R9+# z0p93usBgGt%58*hL9}UQLp}Z#0^&#>>u!m_Zak>hqez~FyR;}g&XePFGu>QJ{uOnX zM#FJ9@OBAI|H2oip*lLo4< z3^ae0Y`&7L{z@EDo)kil)aYkpy4N*~gQpN4lo}UJ#)m->{8aKc-jXHRDj`V`JSjCU zy+$$%UPO|MXLaP47`r*0;dXc%LC>2PFW0XU`i@Bq=0Fd7Q>x-Ac8N2{7rQ}D`%DHP zGdCj%(#%|D5DT*;VXnmCMnj`%H2(g?-!qS(lrorOX!Mti#b29vJ2M4=QdmU5;od_N zhcn+YFerzW0@(8S#8a7lD5NFS4($k`lwX-n#rIC6G9RET;V68M(6RV~6MdOA1`c^; zXjGA5iXp{r$89NX>%_JOx8<}g7h4M7On45t^Rlr?q2gY6RmjVR0+D9;8zP=8%}XS+ z6h1XHHNKVBiQXo;<-lcx&gjrWEZ#+Mo$Sw6yAMrmT?F~EzhB+0lYEL!B@initoTD6 zw8{op)X@@!I$8D4%rfW7GBOjY5qed^Rx~aTdSw4jRm8eUMkRUBFZ&y}>&V?GE{_=Z z5@VL^J`yL;5kwnjPST=@g?Vrkxg|BJ^FJn=VeuW6%e=nYiiTy_dmQkQ!34{(RW$hO zs;d#12IJfaRW+5qhMF~A1g1lkY=uZP(Ag60DQXY2#SxU)mne!hfp7?M7-rWi!v+;* z2CoX7a?xb9tURBzal0vR!Ug`lX0c!c8hw$&kX}J4n-v zLYtM3m2NysvA5{vba;{>#qP#PQ@iSp2C%WLQ%6cY$JQLr(-Wm$#adDu&lyb+i?;_tS+*S}3epKv zidFFsjpvMBHlorU5_-vW&e)B4J;=Aq=Zqw7hoGZ-Eif8^gl5G&jT(t1*KERjsp2mq z;ft6)WZN*an#};03<`u2ovoNa<>utY=GCt#vk~`!K?loVWJ=@I2DkeV2B(Hdm>C<}rd|!F78RGonSn|r6>T$DH}@WfxX zPc1f2JeldcygA|CdWj`$rqP6n)Hz{dcc$-bMekF6ht2b+&Nlb{yzlI+-d|7dcHuDt zY+Z0ha^j;+d^~2A3@?vi+`lwGIJRT-#c?yvw|kT$a?!=HC97XB!t?K#4;lcc=k2IU z88_5SDBw9J7sLMK8!J}yeB>G3-;7*$iq!tZ%wRTN*%#)$#sLi19BzT`4OsTENK2cx z5bm-xmQ91Wqs#_za~V1+mzf}8`sTP@XT%x_2NuFk3(Z@(ER*?fWXmivbcdtu)N;Id zIkU_@?zd2t9<|a^pe)V6Khz6tAp4wdswe^9u~s0CMx`PEfNld@KuMnkMFV$^50my zrGDgDV%0}hYocwFMvZ-*d|EzWxS$jXkqazF2x;9#6i7U5RvuNnD4|d-RGXD&EX~Rw z-y;o4yOdsQx4cW)WldXs+>I;R4RR{Qd@DX`10iae{n8+(Z;JiSs$fAzbxWz%sBz`; z^|n%532(Ad%Q|7Th+$e342L)2>-QcTC82+<=U9zr^xP8{->JFf^_qTphT}w<9ZsGb zxDj7WH_fl(i3=<5Ouo1Eh~e{nYnu{h29|L4r>%$OhWg}5k%xEEyDhuUSM8vSFKSCf zqZ-Z*8q(jlrP%8>oUyv*VRqVcDh9y6IB(AkMMO)uphMo}Q| zP4=S(-Sj9Z8!EspJB zn?(XbhuL=>U!aGvNMS4n_d9&w7Pq+3VTMGgU5j=E!`%yEkK?|tfZc2TJ+N;!j4q^Y z+n}{=!q~TMLOr`3x%_>HiJx*@6_E#fh1w+2YMZZm-@`80sKZ}z+<>N5@ltaxH#?W$ zI*Q-h9F}XYiQ;O-1fWE|)%ls@kB$;P%}J?jcXAf!5Mj>6+G)lbqVRvGZA>H5j2TBpqL4HeKI7$lC+4u!FsQNb*8n%x3Lc){RGvAIqa z{SO90TCY%U64G_&UbCyvs~_T7k2A$0cFyJ#;q@*`<`kRd;;i>tF3&}Y&p0HAO{e^% zcAdtDcE4diw BE9!i}wOB3T8(otPdmRdhO-EwNrbk`ZyEeE;NSbYMt;F{Eu#>R@ zJZ-gJz>Y#Rhg~NzBWqn$+AZxJ5j>ltF5VlTUlI*}gPF7*x9PP94V zl%ZXt_aGJ46X-{pofF;+IgQlywGIpi9@4XyDw?^m!4eptp9R?iD*ex_9A;Bj?{f^| zc)*u98qQ%44vTqGIeOdWrnlQN%!2iNkk`r;mJ;6VPO%*>dO(T_Ez16ENMn(r9rl~u zX{^mOlN~oBq1{F48HmT)qJc;}CR$LbONRLbqT)ktH@?pgxw~b(wcP4fpdIJL)kDgB zp5x=>i%W9LCHx;~Q;OBw4bVx6Gt8zs-*p=y9tibp3`a@m8MhI QB$ekCtjj~7|0m7A01R|E@Bjb+ literal 4312 zcmc&&dvKK16+icWul@G<1qJO4qedZs7$zZ#3V9L|hyzJTFf2*T`%ALTW_R63V#X+O zq?#olDeX)%7^@|%Gp14*%}yHyi4%u{8Xrw*Vo}sa9U|4C);6sWw`0)73}f4Y+; z_x{fN+;h&oWcG;mhWLRiFX=^XIO%KGH;(tT#oB7EPJ7FtB^_|wpH%4_PRh@Z-+3rH z9$yAvfh8MC@=J=#x4}}jl&xY`X!10MJ$_$(unQr90Vt5-tq<#=Fz#=`J%cn{0e%>y z_@m0R;v5`Oz~8+cE_8a3tu1U$QM*`Z~aX z_c9x)*icYdP*zs30mbt3`)-UcdyT1vt7Qdw+X}8K>$~%^Z2%EA7j3Hri61IWSP;SI z_XprQp4i)6xZ6&pE z4}YJD&=f?C9_}`nYPbMRkpOgYcd2RgPAvZoV<`9$ zvWGhB1MmtGO3f@%B>oOP2=DOd%$j(o>HW88J2U7H!)K%dH5l@Cl+Pyg0->nZK>b{W zupVsp`0(6dkub9PFia%VN$L;ijS<9d6{_g?8LWgm1a}piHr??u4(Tglli<$1>^Or| za0^xL6$zFc0a;R^O>l3z%5p0_h%9sGOe7u$h_CscVE7VW^SHSR9-r z+0WvoSY25VL;H76hu@z4ZT$C~K_(n0V7&Y2?0Ec1r*+62b>X355wg zN9Yv|Dms@8aj|NjVkG?|^rImeG^xtnYa(-~E|~pSQc35OAxk}`x@DaKM{2Dcge zd9hCJkz;HKlha^APASL;niEu`)jNY8Y|3NuNM`!U%86vN0$xC){($a-DS0I8Fu#H~ zk$tZ}q{Df6B)e)N*~r`&hTh!hkNCnyNZ%q;b5O5uf`!URPF3ZOiR7rPm}jXf$ZDEg zt&HUUD={VtP*75ck;dao6$P3bBF)V>j3`gV3My^U!<3{Tt5jzAHAT;i4QZdsc4+kbLVmBFs<(T>5K~4dHY14jiUQ+mJ(8@-+Q`%}FbzfSDkIwZm#R8->p=N<wYg4TNJFqH!k@f~Gpr_R6TusHV<-LffkENeZKiMnqQ+vmse{9-vI(*Yi zM$d)2cjon+OY64It=g-y>Acxb;?Ya#C(WB~=9`}EeR!?$x#{So%Ea~8b0IZy!oVY^ zdT-dL&b|=ux$r<_!J~g?5r;Y!QOTSJvjg#-b9vn__KaKC-mq8ge!Az}t=&Jpy!$?q z8Q{YQ&I%e{ipHm3Rmkz|5axZmbeAt)dH{FWgQhE{Wo)W zp(%MrESi-e{iKuz!_jw(i@QEg9~-VgsqIE-7g-ss!XvxaIKSy4O=DX^aq=0;I!i5 zMAc6IvX#2@dK;}K_#ds8aF=Oo;jL_l=93&%t9gno#;i8Qkp15p;1i32FS{mBFx4D( zby6p$Xkf8UY#X_5CSVU(9eyy#{M&Pe(ssT28>s!oWn}Nf2 z!e%j0Uwu2Zyny$qPbR`l!fP*%%t3bAb`%?7kxGrWBrjJq(l)gB)W%|c<6(>KO6yNoRvG<~IRqtTVaPuQQb zSM!(cG_=y}Hsdj#>h=5E@a=fUPGwkCn|`t=eeCOB%)MW<;+>-1(h}EuAG7i3*L^qQ zW9XK(B|P$%t=pq#9z8Dp`PteXk+XdpIeYWbajCpC`a7c%x6_j>vED7?g=wlEWX0?Q zI}UG5Sz&F_mMsMvis-G4PkpASDtOx4@lfeOImjqn3bWi%ESf>)J7h=+g^5fP=Q+EC z;hD_49CQyK!l&GQC>mtD9F&zuRK}`s-U3S@Obn|*w%>uX&?#`iIBUE@@HWoTgJfnN@1h*MdM2@rXRHDcI>{QH zXVAS+U}Y!-QRlWrMy~I7S|Q?V(u2)je`gN-#QDfYU=Q1m0Q=9zeh7IRTlK~^Ok86d z+IiZU!#{W4#{b~Fq9PgQ4YNm_RM+hR9L9;*);VZ;%dW*v8pThlIedX@6Rx}PdpmMp z$%WAc3;Aodg^8NWbuHw7bH3@U=F4$KmAA;nnWq^&z&J7dDalM}zf)wo7vCL3s73<8 z)B*G2lvF2IU_RfniwvJ*)PN=-#(rp*ScBf;F|ioCXp0<3(|A>1V54(TaHLn75EBx z32R`9hLgvoU~aq~pWbb7-}X-dTQmi_O(My;V(euHXKRTuTca|Kv0{z0?yFT=i5ky3 z1qj_tvyW!3z;6akoWL2YiD%K~ur?%D^Cz^+Q+F3C2;Gd#RB$J?Y;BK5N(8<~JB%}M z$i>()q`qcb=V;-?GplJxkFonTYTf##<^YoEDz1|jsPkfqi`F4y9b@M-i^*i>`;`1w z?JM-U$0b3NPR}}On)fggfiJ|sW9+EQLc?2c#)KfT4ks&h>#`)AlLUI`ZvzPewe?mz zhgCG3A9s%8l*eZ?y3U~jpU#g-uVcJ}N%RCefKz`rALWzcGuCRpD=Eg@Nfroud|lu5 h2kDqnT-RdxygHiXbW5N;@orSUUB)gs3g({${sB%>1uOsn diff --git a/tinyjort.jrt b/tinyjort.jrt index d0cad17..d06bead 100755 --- a/tinyjort.jrt +++ b/tinyjort.jrt @@ -1,8 +1,5 @@ -s" defs.jrt" loadfile -dbg" loading asm.jrt" -s" asm.jrt" loadfile - dbg" assembling..." + ( tinyjort calling convention: SP - data stack pointer, grows down BP - return stack pointer, grows up @@ -16,11 +13,6 @@ dbg" assembling..." JMP 9 @> -: NEXT - LODSW - MOV BX AX - JMP @[ BX] ; - ( dictionary format: DICTIONARY - an array of 16 pointers to linked lists of entries. The dictlist for a given word is chosen by taking the @@ -34,12 +26,12 @@ JMP 9 @> NAME - bytes ending in \0 CODE POINTER - pointer to machine code routine ) -: ALLOT ( n -- ) 0 for 0 >t next ; - -L: DICTIONARY 0x10 cells ALLOT -L: LATEST 0 w>t - 0x0f const BUCKETMASK +BUCKETMASK 1+ cells const LATESTOFF +LATESTOFF cell + const DICTSIZE +L: DICTIONARY DICTSIZE ALLOT + +L@ DICTIONARY LATESTOFF + const &LATEST : savelabel ( word -- ) ( dup type s" : " type ) @@ -47,12 +39,10 @@ L: LATEST 0 w>t : 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 ; -: 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 +: DEF target &LATEST !t word dup savelabel dup DICTLIST link>t dup strlen w>t str>t - ( target @ cell + .hex cr ) ; + ( target cell + .hex cr ) ; : WORD= ( word len tptr -- f ) cell + dup b@t t drop drop drop 0 ; : t' word tlookup ; : t& t' cell + ; - -: :ASM DEF target @ 2 + w>t ; - -dbg" core" - -L: $$CONST - INC BX INC BX - PUSH @[ BX] - NEXT - -: CONST DEF [ L@ $$CONST lit ] w>t w>t ; - -L@ $$CONST CONST $DOCONST -L@ DICTIONARY CONST dictionary -L@ LATEST CONST &latest -0 CONST 0 1 CONST 1 - -L: $$VAR - INC BX INC BX - PUSH BX - NEXT - -: ARRAY DEF [ L@ $$VAR lit ] w>t ; -: VAR, ARRAY w>t ; - -( "codepointer words" that evaluate to a pointer to the assembly - - useful to define things like $DOCOLON. ) -: :CP ARRAY ; -L@ $$VAR CONST $DOVAR - -:CP $DOCOLON - MOV @[ BP] SI - INC BP INC BP - INC BX INC BX - MOV SI BX - NEXT - -:ASM return - DEC BP DEC BP - MOV SI @[ BP] - NEXT - -:CP $DODEFERRED - INC BX INC BX - MOV BX @[ BX] - JMP @[ BX] - -:CP $DOCREATE - MOV @[ BP] SI - INC BP INC BP - INC BX INC BX - MOV SI @[ BX] - INC BX INC BX PUSH BX - NEXT - -:ASM LIT_ - LODSW - PUSH AX - NEXT - -:ASM noop NEXT - -( some helpers for making manually defining colon words less ugly ) : '>t t' w>t ; +s" coredefs.jrt" loadfile + : stch? ( str -- f ) ' @ , key lit ' = , ; immediate ( DOES NOT SUPPORT ARBITRARY IMMEDIATE WORDS. Supports [], comments, ; and numeric literals ONLY. You must use [ for anything fancy. ) -: :t DEF [ t& $DOCOLON lit ] w>t ] +: compt begin word dup stch? ; not while state if dup stch? [ if drop [ ' [ , ] else dup stch? ( if drop [ ' ( , ] else dup tlookup dup if w>t drop else drop number if [ t' LIT_ lit ] w>t w>t else type s" ?" type cr then then then then else - compileword then + expileword then repeat drop [ t' return lit ] w>t [ ' [ , ] ; +: :t DEF [ t& $DOCOLON lit ] w>t ] compt ; -: DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ; +s" logic.jrt" loadfile -:ASM INLINEDATA_ - LODSW - PUSH SI - MOV SI AX - NEXT - -:ASM BZ_ - POP CX - JCXZ 0 @> - LODSW - NEXT -L: GOTO_IMPL 0 <: - LODSW - MOV SI AX - NEXT - -DEF GOTO_ L@ GOTO_IMPL w>t - -:ASM drop - POP AX - NEXT - -:ASM dup - POP AX - PUSH AX - PUSH AX - NEXT - -:ASM 2dup - POP AX - POP BX - PUSH BX - PUSH AX - PUSH BX - PUSH AX - NEXT - -:ASM 3dup - POP AX - POP BX - POP CX - PUSH CX - PUSH BX - PUSH AX - PUSH CX - PUSH BX - PUSH AX - NEXT - -:ASM swap - POP AX - POP BX - PUSH AX - PUSH BX - NEXT - -:ASM over - ( this costs 1 extra byte but should save 20 clock cycles ) - MOV BX SP - PUSH @[ 2 @+ SS: BX] -( POP AX - POP BX - PUSH BX - PUSH AX - PUSH BX ) - NEXT - -:ASM rot - POP AX - POP BX - POP CX - PUSH AX - PUSH CX - PUSH BX - NEXT - -:ASM terminate - MOV AH 0x4c # - MOV AL 0 # ( todo: pop? ) - INT 0x21 # - -:ASM execute - POP BX - JMP @[ BX] - -dbg" math" -:ASM + - POP AX POP BX - ADD AX BX - PUSH AX - NEXT - -:ASM 1+ - POP AX INC AX PUSH AX - NEXT - -:ASM - - POP BX POP AX - SUB AX BX - PUSH AX - NEXT - -:ASM 1- - POP AX DEC AX PUSH AX - NEXT - -:ASM * - POP BX POP AX - IMUL BX - PUSH AX - NEXT - -dbg" comparisons" -L: TRUE 0xffff w>t -L: FALSE 0 w>t -L: RETTRUE - PUSH TRUE - NEXT -L: RETFALSE - PUSH FALSE - NEXT - -:ASM not - POP AX - OR AX AX - JZ RETTRUE - JMP RETFALSE - -:ASM = - POP AX - POP BX - CMP AX BX - JZ RETTRUE - JMP RETFALSE - -:ASM < - POP AX - POP BX - CMP BX AX - JL RETTRUE - JMP RETFALSE - -:ASM > - POP AX - POP BX - CMP BX AX - JG RETTRUE - JMP RETFALSE - -:ASM and - POP AX - POP BX - OR AX AX - JZ RETFALSE - OR BX BX - JZ RETFALSE - JMP RETTRUE - -:ASM or - POP AX - POP BX - OR AX BX - JZ RETFALSE - JMP RETTRUE - -:t != = not ; -:t <= > not ; -:t >= < not ; - -dbg" bitwise" -:ASM & - POP AX - POP BX - AND AX BX - PUSH AX - NEXT - -:ASM | - POP AX - POP BX - OR AX BX - PUSH AX - NEXT - -:ASM ^ - POP AX - POP BX - XOR AX BX - PUSH AX - NEXT - -:ASM << ( val count ) - POP CX - POP AX - SHL AX CL - PUSH AX - NEXT - -:ASM >> ( val count ) - POP CX - POP AX - SHR AX CL - PUSH AX - NEXT - -dbg" mem" -:ASM @ - POP BX - PUSH @[ BX] - NEXT - -:ASM b@ - POP BX - MOV AL @[ BX] - CBW - PUSH AX - NEXT - -:ASM ub@ - POP BX - MOV AL @[ BX] - XOR AH AH - PUSH AX - NEXT - -:ASM @far - POP ES POP BX - PUSH @[ ES: BX] - NEXT - -:ASM b@far - POP ES POP BX - MOV AL @[ ES: BX] - CBW - PUSH AX - NEXT - -:ASM ! - POP BX - POP @[ BX] - NEXT - -:ASM b! - POP BX POP AX - MOV @[ BX] AL - NEXT - -:ASM !far - POP ES POP BX - POP @[ ES: BX] - NEXT - -:ASM b!far - POP ES POP BX POP AX - MOV @[ ES: BX] AL - NEXT - -:ASM +! - POP BX - POP AX - ADD AX @[ BX] - MOV @[ BX] AX - NEXT - -dbg" return stack" -:ASM >r - POP @[ BP] - INC BP INC BP - NEXT - -:ASM 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 t asmret -) dbg" allocation" + +BUCKETMASK CONST BUCKETMASK +LATESTOFF CONST LATESTOFF +DICTSIZE CONST DICTSIZE +L@ DICTIONARY CONST primary-dict +DEFERRED dictionary primary-dict +:t &latest dictionary LATESTOFF + ; + 0 VAR, &here :t here &here @ ; :t here! &here ! ; @@ -477,9 +99,11 @@ dbg" allocation" 2 CONST cell :t cells cell * ; -:t allot here + here! ; -:t , here ! cell allot ; -:t b, here b! 1 allot ; +:t allot [ target ] dup BZ_ [ patchpt ] 1- + 0 here b! here 1+ here! + GOTO_ [ swap w>t patch!t ] drop ; +:t , here ! here cell + here! ; +:t b, here b! here 1+ here! ; : t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ; dbg" i/o" @@ -542,7 +166,7 @@ DEFERRED emit console-emit :t bl LIT_ [ key w>t ] emit ; :t type - [ target @ ] dup b@ dup BZ_ [ patchpt ] + [ target ] dup b@ dup BZ_ [ patchpt ] emit 1+ GOTO_ [ swap w>t patch!t ] drop drop ; @@ -727,9 +351,9 @@ L: write-next-digit :t word, ( consume leading whitespace ) - 0 [ target @ ] drop key dup whitespace? not BZ_ [ w>t ] + 0 [ target ] drop key dup whitespace? not BZ_ [ w>t ] ( consume non-whitespace / eoi characters ) - [ target @ ] dup whitespace? over eoi? or + [ target ] dup whitespace? over eoi? or ( if whitespace or eoi, end ) BZ_ [ patchpt ] drop 0 b, return [ patch!t ] ( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ; ARRAY wordbuf 48 ALLOT @@ -742,7 +366,7 @@ dbg" compiler" :t wordname 2 cells + ; :t wordlen wordflags ub@ ; :t codepointer dup wordname swap wordlen + ( trailing null ) 1+ ; -:t dictbucket ( word -- p ) ub@ LIT_ [ BUCKETMASK w>t ] & cells dictionary + ; +:t dictbucket ( word -- p ) ub@ BUCKETMASK & cells dictionary + ; :t new-word ( set latest ) here latest! ( create entry ) 0 dup , , @@ -753,7 +377,7 @@ dbg" compiler" ( link bucket to new ) latest swap ! ; :t 2inc ( x y -- x+1 y+1 ) 1+ swap 1+ swap ; :t strlen ( name -- len ) - 0 swap [ target @ ] dup b@ BZ_ [ patchpt ] + 0 swap [ target ] dup b@ BZ_ [ patchpt ] 2inc GOTO_ [ swap w>t patch!t ] drop ; :ASM dict-lookup ( name dict -- cp meta | name 0 ) @@ -810,11 +434,12 @@ L: check-next-entry MOV SI DX ( restore SI ) NEXT -:t lookup dictionary dict-lookup ; +:t lookup-current dictionary dict-lookup ; +DEFERRED lookup lookup-current 0x100 CONST F_IMMEDIATE :t immediate latest wordflags dup @ F_IMMEDIATE | swap ! ; -: IMMEDIATE [ L@ LATEST lit ] @t cell + dup @t 0x100 | swap !t ; +: IMMEDIATE &LATEST @t cell + dup @t 0x100 | swap !t ; 0 VAR, &state :t state &state @ ; @@ -824,9 +449,13 @@ L: check-next-entry :t ; LIT_ return , [ '>t [ ] ; IMMEDIATE :t const new-word $DOCONST , , ; :t var new-word $DOVAR , 0 , ; +:t cp, , ; +:t lit LIT_ LIT_ , , ; +DEFERRED compileword cp, +DEFERRED compilenum lit :t interpretword ( cp meta -- ) F_IMMEDIATE & state not or - BZ_ [ patchpt ] execute return [ patch!t ] , ; -:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ; + BZ_ [ patchpt ] execute return [ patch!t ] compileword ; +:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] compilenum [ patch!t ] ; :t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ; DEFERRED err ?err @@ -847,14 +476,14 @@ DEFERRED err ?err :t checkstack underflow? BZ_ [ patchpt ] INLINEDATA_ [ patchpt t" underflow!" patch!t ] type cr [ patch!t ] ; -:t compileword ( word -- ) +:t expileword ( word -- ) lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] drop number BZ_ [ patchpt ] interpretnumber return [ patch!t ] err ; :t interpreter - [ target @ ] noop ( f28 ) word noop ( f2c ) dup b@ BZ_ - [ patchpt ] noop ( f36 ) compileword checkstack - GOTO_ [ swap w>t patch!t ] noop ( f40 ) drop ; + [ target ] word dup b@ BZ_ + [ patchpt ] expileword checkstack + GOTO_ [ swap w>t patch!t ] drop ; dbg" flow control words and misc." :t if LIT_ BZ_ , here 0 , ; IMMEDIATE @@ -867,8 +496,7 @@ dbg" flow control words and misc." :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 ( [ target ] key LIT_ [ key ) w>t ] = BZ_ [ w>t ] ; IMMEDIATE :t inline| LIT_ INLINEDATA_ , here 0 , ; :t |inline then ; @@ -876,12 +504,12 @@ dbg" flow control words and misc." :t :| inline| $DOCOLON , ; IMMEDIATE :t |; LIT_ return , |inline ; IMMEDIATE -:t s", [ target @ ] key dup LIT_ [ key " w>t ] != over 0 != and +:t s", [ target ] key dup LIT_ [ key " w>t ] != over 0 != and BZ_ [ patchpt ] b, GOTO_ [ swap w>t patch!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 ' word lookup drop state BZ_ [ patchpt ] lit [ patch!t ] ; IMMEDIATE :t loadfp ( fp -- fp ) infile @ >r @@ -895,12 +523,26 @@ dbg" flow control words and misc." :t redefine ( cp cpdeferred ) cell + ! ; :t definition ( cpdeferred ) cell + @ ; -:t .s sp+ss swap >r 0x100 [ target @ ] 2 - dup r@ < BZ_ +:t .s sp+ss swap >r 0x100 [ target ] 2 - dup r@ < BZ_ ( past top of stack ) [ patchpt ] drop drop rdrop return [ patch!t ] 2dup swap @far . GOTO_ [ w>t ] ; -dbg" boot stub" -:t tinyjort interpreter terminate ; +:t compile-here + LIT_ cp, LIT_ compileword redefine + LIT_ lit LIT_ compilenum redefine ; + +0 VAR, initscripts +:t :init initscripts @ here initscripts ! , ] ; +: :INIT [ t& initscripts lit ] dup @t swap target swap !t w>t ] compt ; + +:t doinit initscripts @ + [ target ] dup BZ_ [ patchpt ] dup cell + >r @ GOTO_ [ swap w>t ] + [ patch!t ] drop ; + +DEFERRED main interpreter +:t tinyjort doinit main terminate ; + +dbg" boot" 9 <: ( actual entry point ) MOV SI t& tinyjort # @@ -913,9 +555,9 @@ dbg" boot stub" MOV BP 0x00 # NEXT -target @ t& &here !t +target t& &here !t dbg" Program assembled, saving tinyjort.com" s" tinyjort.com" overwrite -0x100 target @ :noname for i tseg b@far over fputc next ; execute -close +:noname >r 0x100 begin dup target < while dup b@t r@ fputc 1+ repeat drop + +L: RETFAR + target cell + w>t + target cell + w>t + MOV SI @[ -2 @+ BP] + PUSH @[ -4 @+ BP] + PUSH @[ -6 @+ BP] + SUB BP 6 # + RETF + +L: DOFAR + POP @[ 0 @+ BP] + POP @[ 2 @+ BP] + MOV @[ 4 @+ BP] SI + ADD BP 6 # + PUSH CS + POP DS + MOV SI L@ RETFAR # + POP BX + JMP @[ BX] + +array tdict DICTSIZE allot + +array &FARCALL L@ DOFAR , comseg , +asm-here +array $DOFAR + INC BX INC BX + PUSH @[ BX] + CALL FAR &FARCALL @+ + PUSH CS + POP DS + ( NEXT isn't defined yet ;_; ) + LODSW + MOV BX AX + JMP @[ BX] +asm-com + +: te word tdict dict-lookup interpretword ; immediate +: tlookup ( -- tcp ) word tdict dict-lookup drop cell + @ ; +: t' tlookup interpretnumber ; immediate +: t& tlookup cell + interpretnumber ; immediate +: t, tlookup state if lit ' w>t , else w>t then ; immediate +: '>t tlookup w>t ; + +: chained-lookup + primary-dict dict-lookup dup if return then drop tdict dict-lookup ; + +: tcomp| + ' lookup-current ' lookup redefine + ' tdict ' dictionary redefine + :| cell + @ w>t |; ' compileword redefine + :| t, LIT_ w>t |; ' compilenum redefine ; +: |tcomp + ' chained-lookup ' lookup redefine + ' primary-dict ' dictionary redefine + ' , ' compileword redefine + ' lit ' compilenum redefine ; + +|tcomp + +: DEF tcomp| new-word latest wordname lastlabel ! |tcomp $DOFAR , target , ; + +s" coredefs.jrt" loadfile + +: :timm tcomp| new-word immediate |tcomp $DOCOLON , ] ; +:timm [[ |tcomp ['] [ ; : ]] tcomp| ] ; +:timm ; t, return |tcomp ['] [ ; + +:timm ( ['] ( ; + +:timm if t, BZ_ patchpt ; +:timm else t, GOTO_ patchpt swap patch!t ; +:timm then patch!t ; + +:timm begin target ; +:timm while t, BZ_ patchpt ; +:timm repeat t, GOTO_ swap w>t patch!t ; +:timm again t, GOTO_ w>t ; +:timm until t, BZ_ w>t ; + +:timm s" t' INLINEDATA_ w>t patchpt + begin key dup [ key " lit ] != while >t repeat drop patch!t ; + +:timm :| t, INLINEDATA_ patchpt t, $DOCOLON ; +:timm |; t, return patch!t ; + +: :t DEF [ t& $DOCOLON lit ] w>t ]] ; +: CREATE DEF [ t& $DOCREATE lit ] w>t 0 w>t ; +: FINISHCREATE tcomp| latest |tcomp codepointer cell + @ cell + !t ; +: DOES> target lit ' FINISHCREATE , ' return , tcomp| ; immediate + +: t" target begin key dup [ key " lit ] != while >t repeat ; + +s" logic.jrt" loadfile +