199 lines
2.5 KiB
Plaintext
Executable file
199 lines
2.5 KiB
Plaintext
Executable file
( REQUIRED: defs.jrt, asm.jrt, target.jrt, DEF, '>t )
|
|
dbg" core"
|
|
|
|
: :ASM DEF target 2 + w>t ;
|
|
|
|
: NEXT
|
|
LODSW
|
|
MOV BX AX
|
|
JMP @[ BX] ;
|
|
|
|
L: $$VAR
|
|
INC BX INC BX
|
|
PUSH BX
|
|
NEXT
|
|
|
|
: ARRAY DEF [ L@ $$VAR lit ] w>t ;
|
|
: VAR, ARRAY w>t ;
|
|
|
|
( "codepointer words" that evaluate to a pointer to the assembly -
|
|
useful to define things like $DOCOLON. )
|
|
: :CP ARRAY ;
|
|
|
|
:CP $DOCONST
|
|
INC BX INC BX
|
|
PUSH @[ BX]
|
|
NEXT
|
|
|
|
:CP $DOBCONST
|
|
INC BX INC BX
|
|
MOV AL @[ BX]
|
|
CBW
|
|
PUSH AX
|
|
NEXT
|
|
|
|
:CP $DOUBCONST
|
|
INC BX INC BX
|
|
XOR AX AX
|
|
MOV AL @[ BX]
|
|
PUSH AX
|
|
NEXT
|
|
|
|
: CONST DEF
|
|
dup byteval? if [ t& $DOBCONST lit ] w>t >t return then
|
|
dup 0 >= over 255 <= and if [ t& $DOUBCONST lit ] w>t >t return then
|
|
[ t& $DOCONST lit ] w>t w>t ;
|
|
|
|
L@ $$VAR CONST $DOVAR
|
|
0 CONST 0 1 CONST 1
|
|
|
|
:CP $DOCOLON
|
|
MOV @[ BP] SI
|
|
INC BP INC BP
|
|
INC BX INC BX
|
|
MOV SI BX
|
|
NEXT
|
|
|
|
:ASM return
|
|
DEC BP DEC BP
|
|
MOV SI @[ BP]
|
|
NEXT
|
|
|
|
:CP $DODEFERRED
|
|
INC BX INC BX
|
|
MOV BX @[ BX]
|
|
JMP @[ BX]
|
|
|
|
:CP $DOCREATE
|
|
MOV @[ BP] SI
|
|
INC BP INC BP
|
|
INC BX INC BX
|
|
MOV SI @[ BX]
|
|
INC BX INC BX PUSH BX
|
|
NEXT
|
|
|
|
:ASM LIT_
|
|
LODSW
|
|
PUSH AX
|
|
NEXT
|
|
|
|
:ASM noop NEXT
|
|
|
|
: DEFERRED DEF [ t& $DODEFERRED lit ] w>t [ ' '>t , ] ;
|
|
|
|
:ASM INLINEDATA_
|
|
LODSW
|
|
PUSH SI
|
|
MOV SI AX
|
|
NEXT
|
|
|
|
:ASM BZ_
|
|
POP CX
|
|
JCXZ 0 @>
|
|
LODSW
|
|
NEXT
|
|
L: GOTO_IMPL 0 <:
|
|
LODSW
|
|
MOV SI AX
|
|
NEXT
|
|
|
|
DEF GOTO_ L@ GOTO_IMPL w>t
|
|
|
|
:ASM drop
|
|
POP AX
|
|
NEXT
|
|
|
|
:ASM dup
|
|
POP AX
|
|
PUSH AX
|
|
PUSH AX
|
|
NEXT
|
|
|
|
:ASM 2dup
|
|
POP AX
|
|
POP BX
|
|
PUSH BX
|
|
PUSH AX
|
|
PUSH BX
|
|
PUSH AX
|
|
NEXT
|
|
|
|
:ASM 3dup
|
|
POP AX
|
|
POP BX
|
|
POP CX
|
|
PUSH CX
|
|
PUSH BX
|
|
PUSH AX
|
|
PUSH CX
|
|
PUSH BX
|
|
PUSH AX
|
|
NEXT
|
|
|
|
:ASM swap
|
|
POP AX
|
|
POP BX
|
|
PUSH AX
|
|
PUSH BX
|
|
NEXT
|
|
|
|
:ASM over
|
|
( this costs 1 extra byte but should save 20 clock cycles )
|
|
MOV BX SP
|
|
PUSH @[ 2 @+ SS: BX]
|
|
NEXT
|
|
|
|
:ASM <rot
|
|
POP AX
|
|
POP BX
|
|
POP CX
|
|
PUSH BX
|
|
PUSH AX
|
|
PUSH CX
|
|
NEXT
|
|
|
|
:ASM >rot
|
|
POP AX
|
|
POP BX
|
|
POP CX
|
|
PUSH AX
|
|
PUSH CX
|
|
PUSH BX
|
|
NEXT
|
|
|
|
:ASM terminate
|
|
MOV AH 0x4c #
|
|
MOV AL 0 # ( todo: pop? )
|
|
INT 0x21 #
|
|
|
|
:ASM execute
|
|
POP BX
|
|
JMP @[ BX]
|
|
|
|
dbg" return stack"
|
|
:ASM >r
|
|
POP @[ BP]
|
|
INC BP INC BP
|
|
NEXT
|
|
|
|
:ASM <r
|
|
DEC BP DEC BP
|
|
PUSH @[ BP]
|
|
NEXT
|
|
|
|
:ASM r@
|
|
PUSH @[ -2 @+ BP]
|
|
NEXT
|
|
|
|
:ASM rdrop
|
|
DEC BP DEC BP
|
|
NEXT
|
|
|
|
:ASM rswap
|
|
MOV AX @[ -2 @+ BP]
|
|
MOV BX @[ -4 @+ BP]
|
|
MOV @[ -2 @+ BP] BX
|
|
MOV @[ -4 @+ BP] AX
|
|
NEXT
|
|
|