2023-09-01 23:10:52 +00:00
|
|
|
s" defs.jrt" loadfile
|
2023-09-02 01:51:22 +00:00
|
|
|
dbg" loading asm.jrt"
|
2023-09-01 23:10:52 +00:00
|
|
|
s" asm.jrt" loadfile
|
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
dbg" assembling..."
|
2023-09-01 23:10:52 +00:00
|
|
|
( 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
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
all other registers can and will be clobbered.
|
|
|
|
DF must be cleared before calling NEXT, as LODSW is used to
|
|
|
|
increment the instruction pointer.
|
2023-09-01 23:10:52 +00:00
|
|
|
)
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
JMP 9 @>
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
: 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 ! ;
|
2023-09-01 23:10:54 +00:00
|
|
|
: DICTLIST ( word -- tptr ) b@ 0x0f & cells [ L@ DICTIONARY lit ] + ;
|
2023-09-01 23:10:52 +00:00
|
|
|
: 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 ;
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
: WORD= ( word len tptr -- f )
|
|
|
|
3 + dup b@t <rot != if 2drop 0 return then 1 + ( word tword )
|
|
|
|
begin over b@ over b@t = while
|
|
|
|
over b@ not if 2drop 1 return then ( 0 byte, matched )
|
|
|
|
1 + swap 1 + swap
|
|
|
|
repeat 2drop 0 ;
|
|
|
|
|
|
|
|
: t' word dup strlen over DICTLIST ( word len tptr-next-entry )
|
|
|
|
begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat
|
2023-09-01 23:10:52 +00:00
|
|
|
drop drop drop 0 ;
|
2023-09-02 01:51:22 +00:00
|
|
|
: t& t' cell + ;
|
2023-09-01 23:10:54 +00:00
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
: :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
|
2023-09-02 01:51:22 +00:00
|
|
|
L@ LATEST CONST &latest
|
2023-09-01 23:10:52 +00:00
|
|
|
|
|
|
|
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
|
|
|
|
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
|
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
( some helpers for making manually defining colon words slightly less ugly )
|
|
|
|
: '>t t' w>t ;
|
|
|
|
: @>t t& @t w>t ;
|
|
|
|
: :t DEF [ t& $DOCOLON @t lit ] w>t ;
|
|
|
|
|
2023-09-01 23:10:52 +00:00
|
|
|
:CP $DODEFERRED
|
|
|
|
INC BX INC BX
|
|
|
|
MOV BX @[ BX]
|
|
|
|
JMP @[ BX]
|
|
|
|
|
|
|
|
:ASM LIT_
|
|
|
|
LODSW
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
:ASM INLINEDATA_
|
|
|
|
LODSW
|
|
|
|
PUSH SI
|
|
|
|
MOV SI AX
|
|
|
|
NEXT
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
:ASM BZ_
|
|
|
|
POP CX
|
|
|
|
JCXZ 0 @>
|
|
|
|
LODSW
|
|
|
|
NEXT
|
|
|
|
L: GOTO_IMPL 0 <:
|
2023-09-01 23:10:52 +00:00
|
|
|
LODSW
|
|
|
|
MOV SI AX
|
|
|
|
NEXT
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
DEF GOTO_ L@ GOTO_IMPL w>t
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
L: BASE 10 w>t
|
|
|
|
:ASM number ( str -- num 1 | str 0 )
|
|
|
|
( AX - current number
|
2023-09-01 23:10:54 +00:00
|
|
|
BH - 0
|
|
|
|
BL - current character
|
2023-09-01 23:10:54 +00:00
|
|
|
CX - current digit count, used to detect 0x prefix
|
2023-09-01 23:10:54 +00:00
|
|
|
DX - clobbered by IMUL
|
|
|
|
SI - remainder of string to be parsed
|
|
|
|
DI - saved IP, as SI will be clobbered by LODSB )
|
|
|
|
MOV DI SI ( save IP )
|
2023-09-01 23:10:54 +00:00
|
|
|
POP SI
|
|
|
|
PUSH SI
|
|
|
|
MOV BASE 10 #
|
|
|
|
|
|
|
|
XOR AX AX
|
2023-09-01 23:10:54 +00:00
|
|
|
XOR BX BX
|
2023-09-01 23:10:54 +00:00
|
|
|
XOR CX CX
|
|
|
|
L: next-digit
|
|
|
|
MOV BL AL
|
|
|
|
LODSB
|
2023-09-01 23:10:54 +00:00
|
|
|
XCHG AL BL
|
|
|
|
CMP BL 0 #
|
2023-09-01 23:10:54 +00:00
|
|
|
JZ 1 @> ( string end )
|
2023-09-01 23:10:54 +00:00
|
|
|
CMP BL key 9 #
|
2023-09-01 23:10:54 +00:00
|
|
|
JG 2 @> ( hex or fail )
|
2023-09-01 23:10:54 +00:00
|
|
|
SUB BL key 0 #
|
2023-09-01 23:10:54 +00:00
|
|
|
JL 0 @> ( not a number )
|
|
|
|
L: parsed-digit
|
2023-09-01 23:10:54 +00:00
|
|
|
IMUL BASE
|
|
|
|
ADD AX BX
|
2023-09-01 23:10:54 +00:00
|
|
|
INC CX
|
|
|
|
JMP next-digit
|
|
|
|
L: fail-digit 0 <:
|
2023-09-01 23:10:54 +00:00
|
|
|
MOV SI DI
|
|
|
|
XOR CX CX
|
|
|
|
PUSH CX
|
2023-09-01 23:10:54 +00:00
|
|
|
NEXT
|
|
|
|
1 <: ( string end )
|
|
|
|
JCXZ fail-digit ( empty string is not zero )
|
2023-09-01 23:10:54 +00:00
|
|
|
MOV SI DI
|
2023-09-01 23:10:54 +00:00
|
|
|
POP DX
|
|
|
|
PUSH AX
|
2023-09-01 23:10:54 +00:00
|
|
|
PUSH CX ( we know cx is nonzero and will be treated as true )
|
2023-09-01 23:10:54 +00:00
|
|
|
NEXT
|
|
|
|
2 <: ( hex or fail )
|
2023-09-01 23:10:54 +00:00
|
|
|
CMP BL key x # ( lowercase x )
|
2023-09-01 23:10:54 +00:00
|
|
|
JNZ 0 @>
|
|
|
|
CMP CX 1 # ( x is second character )
|
|
|
|
JNZ 1 @>
|
2023-09-01 23:10:54 +00:00
|
|
|
CMP AX 0 # ( first character was a 0 )
|
2023-09-01 23:10:54 +00:00
|
|
|
JNZ 2 @>
|
|
|
|
MOV BASE 16 #
|
|
|
|
JMP next-digit
|
|
|
|
0 <: 1 <: 2 <: ( actual parsing of hex digit )
|
2023-09-01 23:10:54 +00:00
|
|
|
SUB BL key A #
|
2023-09-01 23:10:54 +00:00
|
|
|
JL fail-digit
|
2023-09-01 23:10:54 +00:00
|
|
|
ADD BL 10 #
|
|
|
|
CMP BL BASE
|
2023-09-01 23:10:54 +00:00
|
|
|
JL parsed-digit
|
2023-09-01 23:10:54 +00:00
|
|
|
SUB BL key a key A - 10 - #
|
2023-09-01 23:10:54 +00:00
|
|
|
JL fail-digit
|
2023-09-01 23:10:54 +00:00
|
|
|
ADD BL 10 #
|
|
|
|
CMP BL BASE
|
2023-09-01 23:10:54 +00:00
|
|
|
JL parsed-digit
|
|
|
|
JMP fail-digit
|
|
|
|
|
|
|
|
:ASM drop
|
|
|
|
POP AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM dup
|
|
|
|
POP AX
|
|
|
|
PUSH AX
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM swap
|
|
|
|
POP AX
|
|
|
|
POP BX
|
|
|
|
PUSH AX
|
|
|
|
PUSH BX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM over
|
|
|
|
POP AX
|
|
|
|
POP BX
|
|
|
|
POP BX
|
|
|
|
POP AX
|
|
|
|
POP BX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM <rot
|
|
|
|
POP AX
|
|
|
|
POP BX
|
|
|
|
POP CX
|
|
|
|
PUSH BX
|
|
|
|
PUSH AX
|
|
|
|
PUSH CX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM emit
|
2023-09-01 23:10:54 +00:00
|
|
|
MOV AH 2 #
|
2023-09-01 23:10:54 +00:00
|
|
|
POP DX
|
|
|
|
INT 0x21 #
|
|
|
|
NEXT
|
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
:ASM key
|
|
|
|
MOV AH 8 #
|
|
|
|
INT 0x21 #
|
|
|
|
XOR AH AH
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
:ASM terminate
|
|
|
|
MOV AH 0x4c #
|
|
|
|
MOV AL 0 # ( todo: pop )
|
|
|
|
INT 0x21 #
|
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
:ASM execute
|
|
|
|
POP BX
|
|
|
|
JMP @[ BX]
|
|
|
|
|
|
|
|
:ASM +
|
|
|
|
POP AX POP BX
|
|
|
|
ADD AX BX
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM -
|
|
|
|
POP BX POP AX
|
|
|
|
SUB AX BX
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM *
|
|
|
|
POP BX POP AX
|
|
|
|
IMUL BX
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM @
|
|
|
|
POP BX
|
|
|
|
MOV AX @[ BX]
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM b@
|
|
|
|
POP BX
|
|
|
|
MOV AL @[ BX]
|
|
|
|
CBW
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM @far
|
|
|
|
POP ES POP BX
|
|
|
|
MOV AX @[ ES: BX]
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM b@far
|
|
|
|
POP ES POP BX
|
|
|
|
MOV AL @[ ES: BX]
|
|
|
|
CBW
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM !
|
|
|
|
POP BX POP AX
|
|
|
|
MOV @[ BX] AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM b!
|
|
|
|
POP BX POP AX
|
|
|
|
MOV @[ BX] AL
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM !far
|
|
|
|
POP ES POP BX POP AX
|
|
|
|
MOV @[ ES: BX] AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM b!far
|
|
|
|
POP ES POP BX POP AX
|
|
|
|
MOV @[ ES: BX] AL
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM >r
|
|
|
|
POP AX
|
|
|
|
MOV @[ BP] AX
|
|
|
|
INC BP INC BP
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM <r
|
|
|
|
DEC BP DEC BP
|
|
|
|
MOV AX @[ BP]
|
|
|
|
PUSH AX
|
|
|
|
NEXT
|
|
|
|
|
|
|
|
:ASM r@
|
|
|
|
MOV AX @[ -2 @+ BP]
|
|
|
|
PUSH AX
|
|
|
|
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
|
|
|
|
|
|
|
|
0 VAR, &here
|
|
|
|
:t here '>t &here '>t @ '>t return
|
|
|
|
:t here! '>t &here '>t ! '>t return
|
|
|
|
0xffff CONST there
|
|
|
|
|
|
|
|
:t latest '>t &latest '>t @ '>t return
|
|
|
|
:t latest! '>t &latest '>t ! '>t return
|
|
|
|
|
|
|
|
0 VAR, lastseg
|
|
|
|
:t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t +
|
|
|
|
'>t dup '>t lastseg '>t ! '>t return
|
|
|
|
|
2023-09-01 23:10:54 +00:00
|
|
|
( test program )
|
2023-09-02 01:51:22 +00:00
|
|
|
ARRAY hex65 key 6 >t key 5 >t 0 >t
|
2023-09-01 23:10:54 +00:00
|
|
|
L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t
|
2023-09-01 23:10:54 +00:00
|
|
|
|
|
|
|
9 <: ( actual entry point )
|
|
|
|
LEA SI test-word
|
2023-09-02 01:51:22 +00:00
|
|
|
PUSH CS
|
|
|
|
POP AX
|
|
|
|
ADD AX 4096 #
|
|
|
|
MOV SS AX
|
|
|
|
MOV t& lastseg @+ AX
|
|
|
|
MOV SP 0xfe #
|
|
|
|
MOV BP 0x00 #
|
|
|
|
NEXT
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
target @ t& &here !t
|
2023-09-01 23:10:52 +00:00
|
|
|
|
2023-09-02 01:51:22 +00:00
|
|
|
dbg" Program assembled, saving tinyjort.com"
|
2023-09-01 23:10:52 +00:00
|
|
|
s" tinyjort.com" overwrite
|
2023-09-01 23:10:52 +00:00
|
|
|
0x100 target @ :noname for i tseg b@far fputc next ; execute
|
2023-09-01 23:10:52 +00:00
|
|
|
close
|