diff --git a/assemble.com b/assemble.com index 085c1c2..7832df7 100755 Binary files a/assemble.com and b/assemble.com differ diff --git a/defs.jrt b/defs.jrt index 0b88ebc..1463516 100755 --- a/defs.jrt +++ b/defs.jrt @@ -10,6 +10,7 @@ : array new-word $DOVAR , ; : create new-word $DOCREATE , 0 , ; +: var, array , ; : finishcreate ( ipfirst -- ) ( set cell after codepointer to first instruction of does> ) diff --git a/game.jrt b/game.jrt index 979947d..8a2f7f5 100755 --- a/game.jrt +++ b/game.jrt @@ -1,9 +1,13 @@ -s" text.jrt" loadfile +import text.jrt -key fill-page -nextline nextline nextline -t" Hello, inline assembler!" draw-text nextline -t" What a lovely day" draw-text 0xf5 textpen !t t" it is!" draw-text +:noname +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 diff --git a/text.jrt b/text.jrt index 8d20f77..9e7a428 100755 --- a/text.jrt +++ b/text.jrt @@ -1,46 +1,56 @@ -:ASM textmode +:asm textmode MOV AX 0x03 # INT 0x10 # NEXT -0 VAR, textpageid -0 VAR, textpage -:t page! dup textpageid ! 12 << textpage ! ; +0 var, textpageid +0 var, textpage -:ASM showpage +: page! dup textpageid ! 12 << textpage ! ; + +:asm showpage POP AX MOV AH 0x05 # INT 0x10 # NEXT -:ASM movecursor ( xy -- ) +:asm movecursor ( xy -- ) MOV BH textpageid @+ MOV AH 0x02 # POP DX INT 0x10 # NEXT -:ASM cursorshape! ( shape -- ) +:asm cursorshape! ( shape -- ) POP CX MOV AH 0x01 # INT 0x10 # NEXT -:t hidecursor 0x2607 cursorshape! ; -:t showcursor 0x0607 cursorshape! ; +: hidecursor 0x2607 cursorshape! ; +: showcursor 0x0607 cursorshape! ; -0x0f VAR, textpen +0x0f var, textpen -80 CONST pagew -25 CONST pageh + 0 const black 1 const blue 2 const green 3 const cyan + 4 const red 5 const magenta 6 const brown 7 const lgray + 8 const gray 9 const lblue 10 const lgreen 11 const lcyan +12 const lred 13 const lmagenta 14 const yellow 15 const white -0xb800 CONST TEXTMEM -: PREP-TEXTCOPY +: fg! textpen @ 0xf0 & | textpen ! ; +: bg! 4 << textpen @ 0x0f & | textpen ! ; + +80 const pagew +25 const pageh + +0xb800 const TEXTMEM + +} : PREP-TEXTCOPY MOV ES t& TEXTMEM @+ MOV AH textpen @+ - MOV DI textpage @+ ; + MOV DI textpage @+ ; { -:ASM fill-page ( char -- ) +:asm fill-page ( char -- ) INT 3 # POP AX PREP-TEXTCOPY @@ -48,29 +58,30 @@ REPZ STOSW NEXT -0 VAR, textpos -:t textx textpos @ 1 >> pagew % ; -:t texty textpos @ 1 >> pagew / ; -:t textx! texty pagew 1 << * + textpos ! ; -:t texty! pagew 1 << * textx + textpos ! ; -:t nextline texty 1+ pagew 1 << * textpos ! ; +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 ! ; -: PREP-TEXTCOPY-XY - PREP-TEXTCOPY - ADD DI textpos @+ ; +} : PREP-TEXTCOPY-XY + PREP-TEXTCOPY + ADD DI textpos @+ ; { -:ASM draw-text ( s -- ) +:asm draw-text ( s -- ) MOV BX SI POP SI PREP-TEXTCOPY-XY -L: draw-next-char +0 :> LODSB OR AL AL JZ 0 @> STOSW - JMP draw-next-char + JMP 0 <@ 0 <: SUB DI textpage @+ MOV textpos @+ DI MOV SI BX NEXT + diff --git a/zipoff.com b/zipoff.com index 533a9e8..387d9c5 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index eab6c38..39fe2d5 100755 --- a/zipoff.jrt +++ b/zipoff.jrt @@ -48,28 +48,41 @@ asm-com : tdict| ' tdict ' dictionary redefine ; : |tdict ' primary-dict ' dictionary redefine ; -: DEF asm-com tdict| new-word latest wordname lastlabel ! |tdict $DOFAR , target , ; +: DEF asm-com ' dictionary definition ( preserve the current dictionary ) + tdict| new-word latest wordname lastlabel ! |tdict $DOFAR , target , + ' dictionary redefine ; : :asm asm-here new-word here cell + , ; s" coredefs.jrt" loadfile -( now we have LIT_ and can hook the compiler ) -: chained-lookup +( now we have LIT_ and can hook the full compiler ) +: pri-targ-lookup primary-dict dict-lookup dup if return then drop tdict dict-lookup ; -: tcomp| tdict| - ' lookup-current ' lookup redefine +: targ-pri-lookup + ( only allow lookup from primary dict if not compiling - this allows + using assembly words without duplicating them in the target dictionary ) + tdict dict-lookup dup state or if return then + drop primary-dict dict-lookup ; + +: { tdict| asm-com + ' targ-pri-lookup ' lookup redefine :| cell + @ w>t |; ' compileword redefine :| t, LIT_ w>t |; ' compilenum redefine ; -: |tcomp |tdict - ' chained-lookup ' lookup redefine +: } |tdict asm-here + ' pri-targ-lookup ' lookup redefine ' , ' compileword redefine ' lit ' compilenum redefine ; -: :timm tcomp| new-word immediate |tcomp $DOCOLON , ] ; -:timm [[ |tcomp ['] [ ; : ]] tcomp| ] ; -:timm ; t, return |tcomp ['] [ ; +: >{ dictionary tdict = { ; +: }< if { else } then ; + +( 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 ; t, return ['] [ ; :timm ( ['] ( ; @@ -83,31 +96,58 @@ s" coredefs.jrt" loadfile :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 s" t, INLINEDATA_ patchpt + begin key dup [ key " lit ] != while >t repeat drop 0 >t patch!t ; -:timm :| t, INLINEDATA_ patchpt t, $DOCOLON ; +:timm :| t, INLINEDATA_ patchpt t& $DOCOLON w>t ; :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 DEF t& $DOCOLON w>t ] { ; +:timm : :t ; +:timm ' ['] t' ; +:timm :noname target t& $DOCOLON w>t ] ; +:timm const CONST ; +:timm var, VAR, ; +:timm var 0 VAR, ; +:timm array ARRAY ; +:timm allot ALLOT ; +:timm :asm :ASM ; +:timm , w>t ; :timm b, >t ; +:timm lit compilenum ; -: t" target begin key dup [ key " lit ] != while >t repeat 0 >t drop ; +: CREATE DEF t& $DOCREATE w>t 0 w>t ; +: FINISHCREATE { latest } codepointer cell + @ cell + !t ; +: DOES> target lit ' FINISHCREATE , ' return , { ; immediate -s" logic.jrt" loadfile +: import >{ >r word loadfile t repeat drop close ; -:init comfilename @ readcom ; +:init comfilename @ readcom { ; : writeenv ( comfile wrapper -- ) swap comfilename ! dup type cr writeself comfilename @ dup type cr writecom ; +DEFERRED main terminate + +dbg" boot" + +9 <: ( actual entry point ) + MOV SI t& main # + PUSH CS + POP AX + ADD AX 4096 # + MOV SS AX + MOV SP 0x100 # + MOV BP 0x00 # + NEXT + here s", zipstub.seg" s" zipoff.com" writeenv + diff --git a/zipstub.seg b/zipstub.seg index 3105d9f..425cc9c 100755 Binary files a/zipstub.seg and b/zipstub.seg differ