{ and } for switching between host / target compilers

better word-lookup logic
endless bugfixes

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> )

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
 
 

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-XY
     PREP-TEXTCOPY
-  ADD DI textpos @+ ;
+    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
+

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 <r }< ;
+
+import logic.jrt
 
 var comfilename
 
 : readcom ( filename ) open 0x100 target! 
   begin dup fgetc dup EOF != while >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
+