dialer/tinyjort.jrt

s" defs.jrt" loadfile
s" asm.jrt" loadfile

( tinyjort calling convention:
  SP - data stack pointer, grows down
  BP - return stack pointer, grows up
  SI - instruction pointer
  BX - W register - code pointer for current word

  all other registers can and will be clobbered
)

JMP 0x1000 @+

: NEXT 
  LODSW
  MOV BX AX
  JMP @[ BX] ;

( dictionary format:
  DICTIONARY - an array of 16 pointers to linked lists of entries.
               The dictlist for a given word is chosen by taking the
               first character of the word and taking its first 4
               bits.
  Entry:
  LINK - pointer to next word in the dictionary
  FLAGS - byte
  LENGTH - byte
  NAME - bytes ending in \0
  CODE POINTER - pointer to machine code routine )

L: DICTIONARY 
0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 
0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 
L: LATEST 0 w>t

: savelabel ( word -- )
  here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ;
: DICTLIST ( word -- tptr ) b@ 0x0f & dup . cells [ L@ DICTIONARY lit ] + ;
: strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ;
: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ;
: link>t ( tptr-head -- ) dup @t swap target @ swap !t w>t ;
: DEF word dup savelabel dup DICTLIST link>t 0 >t dup strlen >t str>t ;

: WORD= ( word len tptr -- f ) ;
: t' word dup strlen over DICTLIST @t ( word len tptr )
  begin dup @t while 3dup WORD= if 5 + + swap drop return then repeat
  drop drop drop 0 ;
;
: :ASM DEF target @ 2 + w>t ;

L: $$CONST
  INC BX INC BX
  PUSH @[ BX]
  NEXT

: CONST DEF [ L@ $$CONST lit ] w>t w>t ;

L@ DICTIONARY CONST dictionary
L@ LATEST CONST latest

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 ;
L@ $$VAR CONST $DOVAR

:CP $DOCOLON
L: $$COLON
  MOV @[ BP] SI
  INC BP INC BP
  INC BX INC BX
  MOV SI BX
  NEXT

:ASM return
  DEC BP DEC BP
  MOV @[ BP] SI
  NEXT

:CP $DODEFERRED
  INC BX INC BX
  MOV BX @[ BX]
  JMP @[ BX]

:ASM LIT_
  LODSW
  PUSH AX
  NEXT

:ASM GOTO_
  LODSW
  MOV SI AX
  NEXT

( 0x1000 target ! )

.s 

s" tinyjort.com" overwrite
0x100 target @ :noname for i tseg b@far fputc next ; execute
close