dialer/zipoff.jrt

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 ,
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 drop 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 ;

: 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 , ;
: :asm asm-here new-word here cell + , ;

s" coredefs.jrt" loadfile

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