JMP 9 @> L: RETFAR target cell + w>t target cell + w>t MOV SI @[ -2 @+ BP] PUSH @[ -4 @+ BP] PUSH @[ -6 @+ BP] SUB BP 6 # RETF L: DOFAR POP @[ 0 @+ BP] POP @[ 2 @+ BP] MOV @[ 4 @+ BP] SI ADD BP 6 # PUSH CS POP DS MOV SI L@ RETFAR # POP BX JMP @[ BX] array tdict DICTSIZE allot array &FARCALL L@ DOFAR , comseg , :init comseg &FARCALL cell + ! ; ( comseg can change! ) asm-here array $DOFAR INC BX INC BX PUSH @[ BX] CALL FAR &FARCALL @+ PUSH CS POP DS ( NEXT isn't defined yet ;_; ) LODSW MOV BX AX JMP @[ BX] asm-com : te word tdict dict-lookup interpretword ; immediate : 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 ; : tdict| ' tdict ' dictionary redefine ; : |tdict ' primary-dict ' dictionary redefine ; : 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 ['] [ ; :timm ( ['] ( ; :timm if t, BZ_ patchpt ; :timm else t, GOTO_ patchpt swap patch!t ; :timm then patch!t ; :timm begin target ; :timm while t, BZ_ patchpt ; :timm repeat t, GOTO_ swap w>t patch!t ; :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 :| t, INLINEDATA_ patchpt t, $DOCOLON ; :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" target begin key dup [ key " lit ] != while >t repeat 0 >t drop ; s" logic.jrt" loadfile var comfilename : readcom ( filename ) open 0x100 target! begin dup fgetc dup EOF != while >t repeat drop close ; :init comfilename @ readcom ; : writeenv ( comfile wrapper -- ) swap comfilename ! dup type cr writeself comfilename @ dup type cr writecom ; here s", zipstub.seg" s" zipoff.com" writeenv