dialer/coredefs.jrt

( 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