diff --git a/asm.jrt b/asm.jrt index b56b39b..7525b7e 100755 --- a/asm.jrt +++ b/asm.jrt @@ -85,6 +85,10 @@ array patchtable 10 2 cells * allot assembly in the 'here' arena. ) : L! [ ' ' , ] 2 cells + target swap ! ; +array anonlabels 10 cells allot +: <@ ( labelid -- ) cells anonlabels + @ @+ ; +: :> ( labelid -- ) cells anonlabels + 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] 4 memreg SI] 5 memreg DI] 6 memreg BP] 7 memreg BX] @@ -175,7 +179,8 @@ var ignoreimm dup 0xf6 ' >extbreg|mem* *? if drop 2ret then 0xf7 ' >extwreg|mem* *? if 2ret then ; -1 :op RET- oparg-imm? if oparg-val @ w>t then ; +1 :op RET- oparg-imm? if 0xc2 >t oparg-val @ w>t then ; +1 :op RETF- oparg-imm? if 0xca >t oparg-val @ w>t then ; 1 :op PUSH 0x50 >wreg+op* 0x06 >segreg+op* @@ -325,3 +330,18 @@ var ignoreimm 2 :op LEA oparg-wreg? arg2 oparg-mem? and if 0x8d >memreg then ; +: AL? oparg-reg? oparg-val @ 0x10 = and ; +: AX? oparg-reg? oparg-val @ 0x00 = and ; + +: >inout* ( base ) + arg2 oparg-reg? oparg-val @ 0x03 ( DX ) = and arg1 if + AL? if 8 + >t 2ret then + AX? if 9 + >t 2ret then + then + arg2 oparg-imm? arg1 if + AL? if >t oparg-val @ >t 2ret then + AX? if 1+ >t oparg-val @ >t 2ret then + then ; + +2 :op IN 0xe4 >inout* ; +2 :op OUT 0xe6 >inout* ; diff --git a/assemble.com b/assemble.com index 0961549..085c1c2 100755 Binary files a/assemble.com and b/assemble.com differ diff --git a/game.jrt b/game.jrt index 42cafc5..979947d 100755 --- a/game.jrt +++ b/game.jrt @@ -1,9 +1,9 @@ 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 ) +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 terminate diff --git a/jort.com b/jort.com index a690dda..2164fff 100755 Binary files a/jort.com and b/jort.com differ diff --git a/text.jrt b/text.jrt index f3b9bd0..8d20f77 100755 --- a/text.jrt +++ b/text.jrt @@ -1,8 +1,38 @@ +:ASM textmode + MOV AX 0x03 # + INT 0x10 # + NEXT + +0 VAR, textpageid 0 VAR, textpage +:t page! dup textpageid ! 12 << textpage ! ; + +:ASM showpage + POP AX + MOV AH 0x05 # + INT 0x10 # + NEXT + +:ASM movecursor ( xy -- ) + MOV BH textpageid @+ + MOV AH 0x02 # + POP DX + INT 0x10 # + NEXT + +:ASM cursorshape! ( shape -- ) + POP CX + MOV AH 0x01 # + INT 0x10 # + NEXT + +:t hidecursor 0x2607 cursorshape! ; +:t showcursor 0x0607 cursorshape! ; + 0x0f VAR, textpen -80 const pagew -25 const pageh +80 CONST pagew +25 CONST pageh 0xb800 CONST TEXTMEM : PREP-TEXTCOPY @@ -11,6 +41,7 @@ MOV DI textpage @+ ; :ASM fill-page ( char -- ) + INT 3 # POP AX PREP-TEXTCOPY MOV CX pagew pageh * # @@ -18,18 +49,17 @@ NEXT 0 VAR, textpos -:t textx textpos @ pagew % ; -:t texty textpos @ pagew / ; -:t textx! texty pagew * + textpos ! ; -:t texty! pagew * textx + textpos ! ; -:t nextline texty 1+ pagew * 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 ! ; : PREP-TEXTCOPY-XY PREP-TEXTCOPY - ADD SI textpos @+ ; + ADD DI textpos @+ ; :ASM draw-text ( s -- ) - INT 3 # MOV BX SI POP SI PREP-TEXTCOPY-XY @@ -41,8 +71,6 @@ L: draw-next-char JMP draw-next-char 0 <: SUB DI textpage @+ - INC DI MOV textpos @+ DI MOV SI BX NEXT - diff --git a/zipoff.com b/zipoff.com index eafd1a8..533a9e8 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index 3df9e39..eab6c38 100755 --- a/zipoff.jrt +++ b/zipoff.jrt @@ -23,6 +23,8 @@ L: DOFAR array tdict DICTSIZE allot array &FARCALL L@ DOFAR , comseg , +:init comseg &FARCALL cell + ! ; ( comseg can change! ) + asm-here array $DOFAR INC BX INC BX @@ -37,33 +39,34 @@ array $DOFAR asm-com : te word tdict dict-lookup interpretword ; immediate -: tlookup ( -- tcp ) word tdict dict-lookup drop cell + @ ; +: tlookup ( -- tcp ) word tdict dict-lookup not if dup err then 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 ; +: tdict| ' tdict ' dictionary redefine ; +: |tdict ' primary-dict ' dictionary redefine ; -: 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 asm-com tcomp| new-word latest wordname lastlabel ! |tcomp $DOFAR , target , ; +: DEF asm-com tdict| new-word latest wordname lastlabel ! |tdict $DOFAR , target , ; : :asm asm-here new-word here cell + , ; s" coredefs.jrt" loadfile +( now we have LIT_ and can hook the compiler ) +: chained-lookup + primary-dict dict-lookup dup if return then drop tdict dict-lookup ; + +: tcomp| tdict| + ' lookup-current ' lookup redefine + :| cell + @ w>t |; ' compileword redefine + :| t, LIT_ w>t |; ' compilenum redefine ; + +: |tcomp |tdict + ' chained-lookup ' lookup redefine + ' , ' compileword redefine + ' lit ' compilenum redefine ; + : :timm tcomp| new-word immediate |tcomp $DOCOLON , ] ; :timm [[ |tcomp ['] [ ; : ]] tcomp| ] ; :timm ; t, return |tcomp ['] [ ;