2023-09-13 03:27:46 +00:00
|
|
|
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
|
|
|
|
|
2023-09-15 20:10:12 +00:00
|
|
|
: DEF asm-com tcomp| new-word latest wordname lastlabel ! |tcomp $DOFAR , target , ;
|
|
|
|
: :asm asm-here new-word here cell + , ;
|
2023-09-13 03:27:46 +00:00
|
|
|
|
|
|
|
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
|
|
|
|
|
2023-09-15 20:10:12 +00:00
|
|
|
: t" target begin key dup [ key " lit ] != while >t repeat 0 >t drop ;
|
2023-09-13 03:27:46 +00:00
|
|
|
|
|
|
|
s" logic.jrt" loadfile
|
|
|
|
|
2023-09-15 20:10:12 +00:00
|
|
|
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
|