cleanup, flow control immediate words

This commit is contained in:
Jeremy Penner 2023-09-09 14:08:22 -04:00
parent 04416807fc
commit c01f114655
8 changed files with 146 additions and 49 deletions

View file

@ -56,6 +56,7 @@ array oparg2 3 cells allot
target @ >r encode-op <r target @ = target @ >r encode-op <r target @ =
if s" invalid argument types" operror then ; if s" invalid argument types" operror then ;
: oparg-complete! : oparg-complete!
dbg" oparg-complete!"
opargs-remaining @ dup if opargs-remaining @ dup if
1 - dup opargs-remaining ! 1 - dup opargs-remaining !
if arg2 if arg2
@ -236,6 +237,7 @@ var ignoreimm
1 :op LOOP 0xe2 >short-jmp* ; 1 :op LOOP 0xe2 >short-jmp* ;
1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ;
1 :op JMP 1 :op JMP
dbg" JMP!"
0xe9 >near-reljmp* 0xe9 >near-reljmp*
0xeb >short-jmp* 0xeb >short-jmp*
0xea >far-jmp* 0xea >far-jmp*
@ -311,7 +313,9 @@ var ignoreimm
0 0xc6 >extbmem* 0 0xc6 >extbmem*
0 0xc7 >extmem* 0 0xc7 >extmem*
then then
oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then ; oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then
arg2 oparg-segreg? if oparg-val @ 0x8c arg1 >extwreg|mem* then ;
2 :op ADD 0x00 >6group-math* 0 >grp1* ; 2 :op ADD 0x00 >6group-math* 0 >grp1* ;
2 :op ADC 0x10 >6group-math* 2 >grp1* ; 2 :op ADC 0x10 >6group-math* 2 >grp1* ;
2 :op AND 0x20 >6group-math* 4 >grp1* ; 2 :op AND 0x20 >6group-math* 4 >grp1* ;

View file

@ -1,5 +1,8 @@
0 const 0 0 const 0
1 const 1 1 const 1
: 1+ 1 + ;
: 1- 1 - ;
2 const cell 2 const cell
: cells cell * ; : cells cell * ;
@ -7,11 +10,11 @@
13 const '\r' 13 const '\r'
key const sp key const sp
0x100 const F_IMMEDIATE
: cr '\n' emit ; : cr '\n' emit ;
: bl sp emit ; : bl sp emit ;
0x100 const F_IMMEDIATE
: if ' BZ_ , here 0 , ; immediate : if ' BZ_ , here 0 , ; immediate
: else ' GOTO_ , 0 , here swap ! here cell - ; immediate : else ' GOTO_ , 0 , here swap ! here cell - ; immediate
: then here swap ! ; immediate : then here swap ! ; immediate

View file

@ -1,3 +1,2 @@
minijort < tinyjort.jrt minijort < tinyjort.jrt
copy tinyjort.com jort.com

3
debug.jrt Executable file
View file

@ -0,0 +1,3 @@
s" defs.jrt" loadfile
dbg" debugging!"

View file

@ -58,8 +58,6 @@
: break rswap rdrop :| yield done |; execute rswap ; : break rswap rdrop :| yield done |; execute rswap ;
: links begin yield @ dup not until drop ;done : links begin yield @ dup not until drop ;done
: files findfile begin dup while yield nextfile repeat drop ;done
: .files files each type s" " type more ;
: min ( x y -- x|y ) 2dup > if swap then drop ; : min ( x y -- x|y ) 2dup > if swap then drop ;
: max ( x y -- x|y ) 2dup < if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ;
@ -83,5 +81,5 @@
dup 0 >= over 9 <= and if [ key 0 lit ] dup 0 >= over 9 <= and if [ key 0 lit ]
else 10 - [ key A lit ] then + emit ; else 10 - [ key A lit ] then + emit ;
: .bhex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ; : .bhex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ;
: .hex dup 0xf000 & 12 >> .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ; : .hex dup 0xf000 & 12 >> 0x0f & .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ;

BIN
jort.com Executable file

Binary file not shown.

Binary file not shown.

View file

@ -14,8 +14,8 @@ dbg" assembling..."
increment the instruction pointer. increment the instruction pointer.
) )
JMP 9 @> JMP dbg" JMP" 9 @>
dbg" first jmp"
: NEXT : NEXT
LODSW LODSW
MOV BX AX MOV BX AX
@ -43,10 +43,11 @@ L: LATEST 0 w>t
: savelabel ( word -- ) : savelabel ( word -- )
dup type s" : " type dup type s" : " type
here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; here swap begin dup b@ dup while b, 1+ repeat b, drop lastlabel ! ;
: DICTLIST ( word -- tptr ) b@ BUCKETMASK & cells [ L@ DICTIONARY lit ] + ; : DICTLIST ( word -- tptr ) b@ BUCKETMASK & cells [ L@ DICTIONARY lit ] + ;
: strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ; : 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 ; : str>t ( word -- ) begin dup b@ dup while >t 1+ repeat >t drop ;
: patchpt ( -- tptr ) target @ 0 w>t ;
: patch!t ( tptr -- ) target @ swap !t ; : patch!t ( tptr -- ) target @ swap !t ;
: link>t ( tptr-head -- ) dup @t swap patch!t w>t ; : link>t ( tptr-head -- ) dup @t swap patch!t w>t ;
: DEF target @ [ L@ LATEST lit ] !t : DEF target @ [ L@ LATEST lit ] !t
@ -57,7 +58,7 @@ L: LATEST 0 w>t
cell + dup b@t <rot != if 2drop 0 return then cell + ( word tword ) cell + dup b@t <rot != if 2drop 0 return then cell + ( word tword )
begin over b@ over b@t = while begin over b@ over b@t = while
over b@ not if 2drop 1 return then ( 0 byte, matched ) over b@ not if 2drop 1 return then ( 0 byte, matched )
1 + swap 1 + swap 1+ swap 1+ swap
repeat 2drop 0 ; repeat 2drop 0 ;
: tlookup ( word -- tcp ) : tlookup ( word -- tcp )
dup strlen over DICTLIST ( word len tptr-next-entry ) dup strlen over DICTLIST ( word len tptr-next-entry )
@ -111,6 +112,14 @@ L@ $$VAR CONST $DOVAR
MOV BX @[ BX] MOV BX @[ BX]
JMP @[ 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_ :ASM LIT_
LODSW LODSW
PUSH AX PUSH AX
@ -236,12 +245,20 @@ dbg" math"
PUSH AX PUSH AX
NEXT NEXT
:ASM 1+
POP AX INC AX PUSH AX
NEXT
:ASM - :ASM -
POP BX POP AX POP BX POP AX
SUB AX BX SUB AX BX
PUSH AX PUSH AX
NEXT NEXT
:ASM 1-
POP AX DEC AX PUSH AX
NEXT
:ASM * :ASM *
POP BX POP AX POP BX POP AX
IMUL BX IMUL BX
@ -260,7 +277,7 @@ L: RETFALSE
:ASM not :ASM not
POP AX POP AX
CMP AX 0 # OR AX AX
JZ RETTRUE JZ RETTRUE
JMP RETFALSE JMP RETFALSE
@ -274,23 +291,23 @@ L: RETFALSE
:ASM < :ASM <
POP AX POP AX
POP BX POP BX
CMP AX BX CMP BX AX
JL RETTRUE JL RETTRUE
JMP RETFALSE JMP RETFALSE
:ASM > :ASM >
POP AX POP AX
POP BX POP BX
CMP AX BX CMP BX AX
JG RETTRUE JG RETTRUE
JMP RETFALSE JMP RETFALSE
:ASM and :ASM and
POP AX POP AX
POP BX POP BX
CMP AX 0 # OR AX AX
JZ RETFALSE JZ RETFALSE
CMP BX 0 # OR BX BX
JZ RETFALSE JZ RETFALSE
JMP RETTRUE JMP RETTRUE
@ -393,6 +410,13 @@ dbg" mem"
MOV @[ ES: BX] AL MOV @[ ES: BX] AL
NEXT NEXT
:ASM +!
POP BX
POP AX
ADD AX @[ BX]
MOV @[ BX] AX
NEXT
dbg" return stack" dbg" return stack"
:ASM >r :ASM >r
POP @[ BP] POP @[ BP]
@ -453,6 +477,7 @@ dbg" allocation"
:t allot here + here! ; :t allot here + here! ;
:t , here ! cell allot ; :t , here ! cell allot ;
:t b, here b! 1 allot ; :t b, here b! 1 allot ;
: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
dbg" i/o" dbg" i/o"
:ASM overwrite :ASM overwrite
@ -498,7 +523,7 @@ dbg" i/o"
-1 CONST EOF -1 CONST EOF
0 VAR, fbuffer 0 VAR, fbuffer
: skip>t 1 + cells target @ + w>t ; : skip>t 1+ cells target @ + w>t ;
:t fgetc ( fp -- c ) :t fgetc ( fp -- c )
1 fbuffer <rot fread fbuffer ub@ 1 fbuffer <rot fread fbuffer ub@
fcount @ not BZ_ [ 2 skip>t ] drop EOF ; fcount @ not BZ_ [ 2 skip>t ] drop EOF ;
@ -511,6 +536,14 @@ dbg" i/o"
NEXT NEXT
DEFERRED emit console-emit DEFERRED emit console-emit
:t cr 10 emit 13 emit ;
:t bl LIT_ [ key w>t ] emit ;
:t type
[ target @ ] dup b@ dup BZ_ [ patchpt ]
emit 1+ GOTO_ [ swap w>t patch!t ]
drop drop ;
:ASM console-key :ASM console-key
MOV AH 8 # MOV AH 8 #
INT 0x21 # INT 0x21 #
@ -518,10 +551,23 @@ DEFERRED emit console-emit
PUSH AX PUSH AX
NEXT NEXT
127 const INBUFSIZE
INBUFSIZE CONST INBUFSIZE
ARRAY inbuf INBUFSIZE 1+ ALLOT
t& inbuf VAR, inptr
:t buf-key inptr @ b@ dup BZ_ [ patchpt ] inptr @ 1+ inptr ! [ patch!t ] ;
0 VAR, infile ( 0 is a predefined file handle meaning stdin ) 0 VAR, infile ( 0 is a predefined file handle meaning stdin )
( TODO: whoops, this always calls fgetc, which works way better ) :t stdin-key
:t in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ; buf-key dup BZ_ [ 1 skip>t ] return drop
DEFERRED key in-key ( if buffer is empty, refresh from file )
INBUFSIZE inbuf 0 fread
( if there's any more data, start returning it )
fcount @ dup BZ_ [ patchpt ] inbuf + 0 swap b! inbuf inptr ! buf-key return
( otherwise, EOF ) [ patch!t ] drop EOF ;
:t file-key infile @ dup BZ_ [ patchpt ] fgetc return
[ patch!t ] drop stdin-key ;
DEFERRED key file-key
dbg" parsing" dbg" parsing"
L: BASE 10 w>t L: ISNEG? 0 >t L: BASE 10 w>t L: ISNEG? 0 >t
@ -546,7 +592,7 @@ L: next-digit
MOV BL AL MOV BL AL
LODSB LODSB
XCHG AL BL XCHG AL BL
CMP BL 0 # OR BL BL
JZ 1 @> ( string end ) JZ 1 @> ( string end )
JCXZ 3 @> ( starts with negative? ) JCXZ 3 @> ( starts with negative? )
L: parse-digit L: parse-digit
@ -587,7 +633,7 @@ L: fail-digit 0 <:
JNZ 0 @> JNZ 0 @>
CMP CX 1 # ( x is second character ) CMP CX 1 # ( x is second character )
JNZ 1 @> JNZ 1 @>
CMP AX 0 # ( first character was a 0 ) OR AX AX ( first character was a 0 )
JNZ 2 @> JNZ 2 @>
MOV BASE 16 # MOV BASE 16 #
JMP next-digit JMP next-digit
@ -597,7 +643,7 @@ L: fail-digit 0 <:
ADD BL 10 # ADD BL 10 #
CMP BL BASE CMP BL BASE
JL parsed-digit JL parsed-digit
SUB BL key a key A - 10 - # SUB BL key a key A - 10 + #
JL fail-digit JL fail-digit
ADD BL 10 # ADD BL 10 #
CMP BL BASE CMP BL BASE
@ -607,9 +653,11 @@ L: fail-digit 0 <:
L: DECDIVISORS 1 w>t 10 w>t 100 w>t 1000 w>t 10000 w>t L: DECDIVISORS 1 w>t 10 w>t 100 w>t 1000 w>t 10000 w>t
L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null ) L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
:ASM num>str :ASM num>str
MOV AX DS
MOV ES AX
MOV DI L@ NUMBUF # MOV DI L@ NUMBUF #
POP AX POP AX
CMP AX 0 # OR AX AX
JGE 0 @> JGE 0 @>
MOV BYTE @[ DI] key - # MOV BYTE @[ DI] key - #
NEG AX NEG AX
@ -622,7 +670,7 @@ L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
L: write-next-digit L: write-next-digit
XOR DX DX XOR DX DX
IDIV @[ BX+SI] IDIV @[ BX+SI]
CMP AX 0 # OR AX AX
JNZ 1 @> JNZ 1 @>
JCXZ 0 @> ( unconditionally write a zero ) JCXZ 0 @> ( unconditionally write a zero )
DEC CX ( if we haven't written any digits this will hit 0 on the ones place ) DEC CX ( if we haven't written any digits this will hit 0 on the ones place )
@ -643,11 +691,7 @@ L: write-next-digit
PUSH DI PUSH DI
NEXT NEXT
:t type [ target @ ] :t . num>str type bl ;
dup b@ dup BZ_ [ 6 skip>t ]
emit 1 + GOTO_ [ w>t ]
drop drop ;
:t . num>str type LIT_ [ key w>t ] emit ;
:ASM whitespace? :ASM whitespace?
POP AX POP AX
@ -668,7 +712,7 @@ L: write-next-digit
:ASM eoi? ( end of input ) :ASM eoi? ( end of input )
POP AX POP AX
CMP AX 0 # ( null ) OR AX AX ( null )
JZ 0 @> JZ 0 @>
CMP AX -1 # ( EOF ) CMP AX -1 # ( EOF )
JNZ 1 @> JNZ 1 @>
@ -687,31 +731,32 @@ L: write-next-digit
( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return ( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return
( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ; ( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ;
ARRAY wordbuf 48 ALLOT ARRAY wordbuf 48 ALLOT
:t redir-here ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ; :t redir-, ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
:t word LIT_ word, wordbuf redir-here ; :t tmp-, ( cp -- buf ) here redir-, ;
:t word LIT_ word, wordbuf redir-, ;
dbg" compiler" dbg" compiler"
:t wordflags cell + ; :t wordflags cell + ;
:t wordname 2 cells + ; :t wordname 2 cells + ;
:t wordlen wordflags ub@ ; :t wordlen wordflags ub@ ;
:t codepointer dup wordname swap wordlen + ( trailing null ) 1 + ; :t codepointer dup wordname swap wordlen + ( trailing null ) 1+ ;
:t dictbucket ( word -- p ) ub@ LIT_ [ BUCKETMASK w>t ] & cells dictionary + ; :t dictbucket ( word -- p ) ub@ LIT_ [ BUCKETMASK w>t ] & cells dictionary + ;
:t new-word :t new-word
( set latest ) here latest! ( set latest ) here latest!
( create entry ) 0 dup , , ( create entry ) 0 dup , ,
( save word + calc length ) here word, here swap - ( save word + calc length ) here word, here swap - 1- ( ignore null )
( save length ) latest wordflags ! ( save length ) latest wordflags !
( find bucket ) latest wordname dictbucket ( find bucket ) latest wordname dictbucket
( link to prev ) dup @ latest ! ( link to prev ) dup @ latest !
( link bucket to new ) latest swap ! ; ( link bucket to new ) latest swap ! ;
:t 2inc ( x y -- x+1 y+1 ) 1 + swap 1 + swap ; :t 2inc ( x y -- x+1 y+1 ) 1+ swap 1+ swap ;
:t strlen ( name -- len ) :t strlen ( name -- len )
0 swap [ target @ ] dup b@ BZ_ [ 3 skip>t ] 0 swap [ target @ ] dup b@ BZ_ [ 3 skip>t ]
2inc GOTO_ [ w>t ] drop ; 2inc GOTO_ [ w>t ] drop ;
: patchpt target @ 0 w>t ;
:ASM dict-lookup ( name dict -- cp meta | name 0 ) :ASM dict-lookup ( name dict -- cp meta | name 0 )
MOV AX DS
MOV ES AX
POP BX ( dictionary ) POP BX ( dictionary )
POP DI ( name ) POP DI ( name )
( strlen - in DI: str, out CX: len, clobbers AX ) ( strlen - in DI: str, out CX: len, clobbers AX )
@ -733,7 +778,7 @@ dbg" compiler"
L: check-next-entry L: check-next-entry
MOV BX @[ BX] MOV BX @[ BX]
CMP BX 0 # OR BX BX
JZ 0 @> JZ 0 @>
CMP CL @[ 2 @+ BX] CMP CL @[ 2 @+ BX]
JNZ check-next-entry JNZ check-next-entry
@ -779,8 +824,9 @@ L: check-next-entry
:t var new-word $DOVAR , 0 , ; :t var new-word $DOVAR , 0 , ;
:t interpretword ( cp meta -- ) F_IMMEDIATE & state not or :t interpretword ( cp meta -- ) F_IMMEDIATE & state not or
BZ_ [ patchpt ] execute return [ patch!t ] , ; BZ_ [ patchpt ] execute return [ patch!t ] , ;
:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ , , [ patch!t ] ; :t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ;
:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit 13 emit ; :t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ;
DEFERRED err ?err DEFERRED err ?err
:t compileword ( word -- ) :t compileword ( word -- )
lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ] lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ]
@ -790,13 +836,57 @@ DEFERRED err ?err
[ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ] [ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ]
[ patch!t ] drop ; [ patch!t ] drop ;
dbg" flow control words and misc."
:t if LIT_ BZ_ , here 0 , ; IMMEDIATE
:t else LIT_ GOTO_ , 0 , here swap ! here cell - ; IMMEDIATE
:t then here swap ! ; IMMEDIATE
:t begin here ; IMMEDIATE
:t while LIT_ BZ_ , here 0 , ; IMMEDIATE
:t repeat LIT_ GOTO_ , swap , here swap ! ; IMMEDIATE
:t again LIT_ GOTO_ , , ; IMMEDIATE
:t until LIT_ BZ_ , , ; IMMEDIATE
:t lit LIT_ LIT_ , , ;
:t ( [ target @ ] key LIT_ [ key ) w>t ] = BZ_ [ w>t ] ; IMMEDIATE
:t inline| LIT_ INLINEDATA_ , here 0 , ;
:t |inline then ;
:t :| inline| $DOCOLON , ; IMMEDIATE
:t |; LIT_ return , |inline ; IMMEDIATE
:t s", [ target @ ] key dup LIT_ [ key " w>t ] != over 0 != and
BZ_ [ 3 skip>t ] b, GOTO_ [ w>t ]
drop 0 b, ;
:t s" state BZ_ [ patchpt ] inline| s", |inline return [ patch!t ]
LIT_ s", tmp-, ; IMMEDIATE
:t ' word lookup drop state BZ_ [ patchpt ] lit return [ patch!t ] ; IMMEDIATE
:t loadfp ( fp -- fp )
infile @ >r
infile !
interpreter
infile @
<r infile ! ;
:t loadfile ( filename -- ) open loadfp close ;
:t noop ;
:t defer new-word $DODEFERRED , LIT_ noop , ;
:t redefine ( cp cpdeferred ) cell + ! ;
:t definition ( cpdeferred ) cell + @ ;
:ASM sp+ss
PUSH SP
PUSH SS
NEXT
:t .s sp+ss swap >r 0x100 [ target @ ] 2 - dup r@ < BZ_
( past top of stack ) [ 4 skip>t ] drop drop rdrop return
2dup swap @far . GOTO_ [ w>t ] ;
dbg" boot stub" dbg" boot stub"
:ASM debug NEXT :ASM debug NEXT
: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
ARRAY input t" 1 2 + ."
t& input VAR, inptr
:t keyinput inptr @ b@ dup . dup BZ_ [ patchpt ] inptr @ 1 + inptr ! [ patch!t ] ;
( t' keyinput t& key !t )
:t tinyjort interpreter terminate ; :t tinyjort interpreter terminate ;
9 <: ( actual entry point ) 9 <: ( actual entry point )