diff --git a/assemble.com b/assemble.com index 7832df7..cbfb0ce 100755 Binary files a/assemble.com and b/assemble.com differ diff --git a/game.jrt b/game.jrt index 8a2f7f5..33f2010 100755 --- a/game.jrt +++ b/game.jrt @@ -1,13 +1,15 @@ import text.jrt -:noname +:noname textmode 30 textx! 12 texty! blue bg! lgray fg! [ key lit ] fill-page s" Hello, inline assembler!" draw-text nextline s" What a lovely day" draw-text lblue bg! white fg! -s" it is!" draw-text -; execute -terminate +s" it is!" draw-text ; + +' main redefine + +{ s" testgame.com" writecom } diff --git a/logic.jrt b/logic.jrt index a3e014d..8b10d31 100755 --- a/logic.jrt +++ b/logic.jrt @@ -129,6 +129,18 @@ dbg" bitwise" PUSH AX NEXT +:ASM 2* + POP AX + SHL AX 1 # + PUSH AX + NEXT + +:ASM 2/ + POP AX + SHR AX 1 # + PUSH AX + NEXT + dbg" mem" :ASM @ POP BX diff --git a/testgame.com b/testgame.com new file mode 100755 index 0000000..c371e18 Binary files /dev/null and b/testgame.com differ diff --git a/text.jrt b/text.jrt index 9e7a428..a7c2df9 100755 --- a/text.jrt +++ b/text.jrt @@ -45,10 +45,10 @@ 0xb800 const TEXTMEM -} : PREP-TEXTCOPY +{ : PREP-TEXTCOPY MOV ES t& TEXTMEM @+ MOV AH textpen @+ - MOV DI textpage @+ ; { + MOV DI textpage @+ ; } :asm fill-page ( char -- ) INT 3 # @@ -59,15 +59,20 @@ NEXT 0 var, textpos -: textx textpos @ 1 >> pagew % ; -: texty textpos @ 1 >> pagew / ; -: textx! 1 << texty pagew 1 << * + textpos ! ; -: texty! pagew 1 << * textx 1 << + textpos ! ; -: nextline texty 1+ pagew 1 << * textpos ! ; +: textx textpos @ 2/ pagew % ; +: texty textpos @ 2/ pagew / ; +: textx! texty pagew * + 2* textpos ! ; +: texty! pagew * textx + 2* textpos ! ; +: textxy! pagew * + 2* textpos ! ; +: nextline texty 1+ pagew * 2* textpos ! ; -} : PREP-TEXTCOPY-XY +{ : PREP-TEXTCOPY-XY PREP-TEXTCOPY - ADD DI textpos @+ ; { + ADD DI textpos @+ ; + + : CORRECT-TEXTPOS + SUB DI textpage @+ + MOV textpos @+ DI ; } :asm draw-text ( s -- ) MOV BX SI @@ -80,8 +85,86 @@ STOSW JMP 0 <@ 0 <: - SUB DI textpage @+ - MOV textpos @+ DI + CORRECT-TEXTPOS MOV SI BX NEXT +:asm draw-char ( char -- ) + POP AX + PREP-TEXTCOPY-XY + STOSW + ADD textpos @+ 2 # + NEXT + +:asm draw-hrepeat ( count char -- ) + POP AX + POP CX + JCXZ 1 @> + PREP-TEXTCOPY-XY + SHL CX 1 # + ADD textpos @+ CX + SHR CX 1 # + REPZ STOSW +1 <: + NEXT + +:asm draw-vrepeat ( count char -- ) + POP AX + POP CX + JCXZ 1 @> + PREP-TEXTCOPY-XY +0 :> + STOSW + ADD DI pagew 1- 1 << # + DEC CX + JNZ 0 <@ + CORRECT-TEXTPOS +1 <: + NEXT + +( box drawing words ) +var boxstyle +: hstyle boxstyle @ 0x01 & ; +: hstyle! 1 & boxstyle @ 0xfe & | boxstyle ! ; +: vstyle boxstyle @ 0x02 & 1 >> ; +: vstyle! 1 & 1 << boxstyle @ 0xfd & | boxstyle ! ; +: boxstyle! dup hstyle! vstyle! ; +: filled? boxstyle @ 0x04 & ; +: filled boxstyle @ 0x04 | boxstyle ! ; +: hollow boxstyle @ 0xfb & boxstyle ! ; + +: hchar hstyle if 0xcd else 0xc4 then ; +: vchar vstyle if 0xba else 0xb3 then ; +: hline ( count -- ) hchar draw-char ; +: vline ( count -- ) vchar draw-char ; + +dictionary .hex +{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ; +dictionary .hex +0xda 0xd6 0xd5 0xc9 :corner tl +dictionary .hex +0xbf 0xb7 0xb8 0xbb :corner tr +0xc0 0xd4 0xd3 0xc8 :corner bl +0xd9 0xbe 0xbd 0xbc :corner br + +: boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ; +: boxbottom ( w -- ) bl 2 - hline br ; + +: hollow-boxmiddle ( h w -- ) + textpos @ >r + textx + textx! dup vline + r + 2 - swap + begin dup while 1- + vchar draw-char over 2 - 32 swap draw-hrepeat vchar draw-char + nextline r@ textx! + repeat 2drop rdrop ; +: boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ; + +: draw-box ( w h -- ) + swap dup boxtop ( h w ) + swap over boxmiddle + boxbottom ; + diff --git a/tinyjort.com b/tinyjort.com index 2164fff..c43cc28 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index d06bead..6177379 100755 --- a/tinyjort.jrt +++ b/tinyjort.jrt @@ -98,7 +98,7 @@ DEFERRED dictionary primary-dict :t segalloc lastseg @ 4096 + dup lastseg ! ; 2 CONST cell -:t cells cell * ; +:t cells 2* ; :t allot [ target ] dup BZ_ [ patchpt ] 1- 0 here b! here 1+ here! GOTO_ [ swap w>t patch!t ] drop ; diff --git a/zipoff.com b/zipoff.com index 387d9c5..a95a09c 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index 39fe2d5..ff83f39 100755 --- a/zipoff.jrt +++ b/zipoff.jrt @@ -45,12 +45,15 @@ asm-com : t, tlookup state if lit ' w>t , else w>t then ; immediate : '>t tlookup w>t ; -: tdict| ' tdict ' dictionary redefine ; -: |tdict ' primary-dict ' dictionary redefine ; +: with-dict ( cp dictcp ) + ' dictionary definition >r + ' dictionary redefine + execute + t |; ' compileword redefine - :| t, LIT_ w>t |; ' compilenum redefine ; - -: } |tdict asm-here +: { ' primary-dict ' dictionary redefine ' pri-targ-lookup ' lookup redefine ' , ' compileword redefine ' lit ' compilenum redefine ; -: >{ dictionary tdict = { ; -: }< if { else } then ; +: } asm-com + ' tdict ' dictionary redefine + ' targ-pri-lookup ' lookup redefine + :| cell + @ w>t |; ' compileword redefine + :| t, LIT_ w>t |; ' compilenum redefine ; ( we mark all target words with no associated code in the target segment as immediate, as it is impossible to compile a reference to them. ) -: :timm >{ new-word immediate } $DOCOLON , ] }< ; -:timm [ ['] [ ; :timm ] ] ; :timm } } ; +: :timm } new-word immediate { $DOCOLON , ] ; +:timm [ ['] [ ; :timm ] ] ; :timm ; t, return ['] [ ; - :timm ( ['] ( ; :timm if t, BZ_ patchpt ; @@ -96,14 +96,14 @@ s" coredefs.jrt" loadfile :timm again t, GOTO_ w>t ; :timm until t, BZ_ w>t ; -:timm s" t, INLINEDATA_ patchpt - begin key dup [ key " lit ] != while >t repeat drop 0 >t patch!t ; +: t", begin key dup [ key " lit ] != while >t repeat drop 0 >t ; +:timm s" state if t, INLINEDATA_ patchpt t", patch!t else target t", then ; :timm :| t, INLINEDATA_ patchpt t& $DOCOLON w>t ; :timm |; t, return patch!t ; -: :t DEF t& $DOCOLON w>t ] { ; -:timm : :t ; +:noname DEF t& $DOCOLON w>t ] ; +:timm : [ dup , ] ; :timm :t [ , ] ; :timm ' ['] t' ; :timm :noname target t& $DOCOLON w>t ] ; :timm const CONST ; @@ -114,21 +114,31 @@ s" coredefs.jrt" loadfile :timm :asm :ASM ; :timm , w>t ; :timm b, >t ; :timm lit compilenum ; +:timm deferred DEFERRED ; +dbg" CREATE" : CREATE DEF t& $DOCREATE w>t 0 w>t ; -: FINISHCREATE { latest } codepointer cell + @ cell + !t ; -: DOES> target lit ' FINISHCREATE , ' return , { ; immediate +: FINISHCREATE ' latest ' tdict with-dict codepointer cell + @ cell + !t ; +: DOES} target lit ' FINISHCREATE , ' return , } ; immediate -: import >{ >r word loadfile t repeat drop close ; -:init comfilename @ readcom { ; +:init comfilename @ readcom } ; : writeenv ( comfile wrapper -- ) swap comfilename ! @@ -139,8 +149,10 @@ DEFERRED main terminate dbg" boot" +} : start main terminate ; { + 9 <: ( actual entry point ) - MOV SI t& main # + MOV SI t& start # PUSH CS POP AX ADD AX 4096 # diff --git a/zipstub.seg b/zipstub.seg index 425cc9c..d5ab06c 100755 Binary files a/zipstub.seg and b/zipstub.seg differ