IN and OUT opcodes, zipoff bugfixes, anonymous labels

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* ;

game.jrt

@@ -1,9 +1,9 @@
 s" text.jrt" loadfile
 
 key  fill-page
-( nextline nextline nextline )
+nextline nextline nextline
-t" Hello, inline assembler!" draw-text ( nextline )
+t" Hello, inline assembler!" draw-text nextline
-( t" What a lovely day it is!" draw-text )
+t" What a lovely day" draw-text 0xf5 textpen !t t"  it is!" draw-text
 terminate
 
 

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
+80 CONST pagew
-25 const pageh
+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 textx textpos @ 1 >> pagew % ;
-:t texty textpos @ pagew / ;
+:t texty textpos @ 1 >> pagew / ;
-:t textx! texty pagew * + textpos ! ;
+:t textx! texty pagew 1 << * + textpos ! ;
-:t texty! pagew * textx + textpos ! ;
+:t texty! pagew 1 << * textx + textpos ! ;
-:t nextline texty 1+ pagew * 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
-

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 
+: tdict| ' tdict ' dictionary redefine ;
-  primary-dict dict-lookup dup if return then drop tdict dict-lookup ;
+: |tdict ' primary-dict ' dictionary redefine ;
 
-: tcomp|
+: DEF asm-com tdict| new-word latest wordname lastlabel ! |tdict $DOFAR , target , ;
-  ' 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 , ;
 : :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 ['] [ ;