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 @ =
if s" invalid argument types" operror then ;
: oparg-complete!
dbg" oparg-complete!"
opargs-remaining @ dup if
1 - dup opargs-remaining !
if arg2
@ -236,6 +237,7 @@ var ignoreimm
1 :op LOOP 0xe2 >short-jmp* ;
1 :op JCXZ 0xe3 >short-jmp* ;
1 :op JMP
dbg" JMP!"
0xe9 >near-reljmp*
0xeb >short-jmp*
0xea >far-jmp*
@ -311,7 +313,9 @@ var ignoreimm
0 0xc6 >extbmem*
0 0xc7 >extmem*
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 ADC 0x10 >6group-math* 2 >grp1* ;
2 :op AND 0x20 >6group-math* 4 >grp1* ;

View file

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

View file

@ -1,3 +1,2 @@
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 ;
: 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 ;
: max ( x y -- x|y ) 2dup < if swap then drop ;
@ -83,5 +81,5 @@
dup 0 >= over 9 <= and if [ key 0 lit ]
else 10 - [ key A lit ] then + emit ;
: .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.
)
JMP 9 @>
JMP dbg" JMP" 9 @>
dbg" first jmp"
: NEXT
LODSW
MOV BX AX
@ -47,6 +47,7 @@ L: LATEST 0 w>t
: DICTLIST ( word -- tptr ) b@ BUCKETMASK & 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 ;
: patchpt ( -- tptr ) target @ 0 w>t ;
: patch!t ( tptr -- ) target @ swap !t ;
: link>t ( tptr-head -- ) dup @t swap patch!t w>t ;
: DEF target @ [ L@ LATEST lit ] !t
@ -111,6 +112,14 @@ L@ $$VAR CONST $DOVAR
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
@ -236,12 +245,20 @@ dbg" math"
PUSH AX
NEXT
:ASM 1+
POP AX INC AX PUSH AX
NEXT
:ASM -
POP BX POP AX
SUB AX BX
PUSH AX
NEXT
:ASM 1-
POP AX DEC AX PUSH AX
NEXT
:ASM *
POP BX POP AX
IMUL BX
@ -260,7 +277,7 @@ L: RETFALSE
:ASM not
POP AX
CMP AX 0 #
OR AX AX
JZ RETTRUE
JMP RETFALSE
@ -274,23 +291,23 @@ L: RETFALSE
:ASM <
POP AX
POP BX
CMP AX BX
CMP BX AX
JL RETTRUE
JMP RETFALSE
:ASM >
POP AX
POP BX
CMP AX BX
CMP BX AX
JG RETTRUE
JMP RETFALSE
:ASM and
POP AX
POP BX
CMP AX 0 #
OR AX AX
JZ RETFALSE
CMP BX 0 #
OR BX BX
JZ RETFALSE
JMP RETTRUE
@ -393,6 +410,13 @@ dbg" mem"
MOV @[ ES: BX] AL
NEXT
:ASM +!
POP BX
POP AX
ADD AX @[ BX]
MOV @[ BX] AX
NEXT
dbg" return stack"
:ASM >r
POP @[ BP]
@ -453,6 +477,7 @@ dbg" allocation"
:t allot here + here! ;
:t , here ! cell allot ;
:t b, here b! 1 allot ;
: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
dbg" i/o"
:ASM overwrite
@ -511,6 +536,14 @@ dbg" i/o"
NEXT
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
MOV AH 8 #
INT 0x21 #
@ -518,10 +551,23 @@ DEFERRED emit console-emit
PUSH AX
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 )
( TODO: whoops, this always calls fgetc, which works way better )
:t in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ;
DEFERRED key in-key
:t stdin-key
buf-key dup BZ_ [ 1 skip>t ] return drop
( 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"
L: BASE 10 w>t L: ISNEG? 0 >t
@ -546,7 +592,7 @@ L: next-digit
MOV BL AL
LODSB
XCHG AL BL
CMP BL 0 #
OR BL BL
JZ 1 @> ( string end )
JCXZ 3 @> ( starts with negative? )
L: parse-digit
@ -587,7 +633,7 @@ L: fail-digit 0 <:
JNZ 0 @>
CMP CX 1 # ( x is second character )
JNZ 1 @>
CMP AX 0 # ( first character was a 0 )
OR AX AX ( first character was a 0 )
JNZ 2 @>
MOV BASE 16 #
JMP next-digit
@ -597,7 +643,7 @@ L: fail-digit 0 <:
ADD BL 10 #
CMP BL BASE
JL parsed-digit
SUB BL key a key A - 10 - #
SUB BL key a key A - 10 + #
JL fail-digit
ADD BL 10 #
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: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
:ASM num>str
MOV AX DS
MOV ES AX
MOV DI L@ NUMBUF #
POP AX
CMP AX 0 #
OR AX AX
JGE 0 @>
MOV BYTE @[ DI] key - #
NEG AX
@ -622,7 +670,7 @@ L: NUMBUF 7 ALLOT ( 5 digits, - sign, ending null )
L: write-next-digit
XOR DX DX
IDIV @[ BX+SI]
CMP AX 0 #
OR AX AX
JNZ 1 @>
JCXZ 0 @> ( unconditionally write a zero )
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
NEXT
:t type [ target @ ]
dup b@ dup BZ_ [ 6 skip>t ]
emit 1 + GOTO_ [ w>t ]
drop drop ;
:t . num>str type LIT_ [ key w>t ] emit ;
:t . num>str type bl ;
:ASM whitespace?
POP AX
@ -668,7 +712,7 @@ L: write-next-digit
:ASM eoi? ( end of input )
POP AX
CMP AX 0 # ( null )
OR AX AX ( null )
JZ 0 @>
CMP AX -1 # ( EOF )
JNZ 1 @>
@ -687,8 +731,9 @@ L: write-next-digit
( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return
( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ;
ARRAY wordbuf 48 ALLOT
:t redir-here ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
:t word LIT_ word, wordbuf redir-here ;
:t redir-, ( cp buf -- buf ) here >r dup >r here! execute <r <r here! ;
:t tmp-, ( cp -- buf ) here redir-, ;
:t word LIT_ word, wordbuf redir-, ;
dbg" compiler"
:t wordflags cell + ;
@ -699,7 +744,7 @@ dbg" compiler"
:t new-word
( set latest ) here latest!
( 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 !
( find bucket ) latest wordname dictbucket
( link to prev ) dup @ latest !
@ -709,9 +754,9 @@ dbg" compiler"
0 swap [ target @ ] dup b@ BZ_ [ 3 skip>t ]
2inc GOTO_ [ w>t ] drop ;
: patchpt target @ 0 w>t ;
:ASM dict-lookup ( name dict -- cp meta | name 0 )
MOV AX DS
MOV ES AX
POP BX ( dictionary )
POP DI ( name )
( strlen - in DI: str, out CX: len, clobbers AX )
@ -733,7 +778,7 @@ dbg" compiler"
L: check-next-entry
MOV BX @[ BX]
CMP BX 0 #
OR BX BX
JZ 0 @>
CMP CL @[ 2 @+ BX]
JNZ check-next-entry
@ -779,8 +824,9 @@ L: check-next-entry
:t var new-word $DOVAR , 0 , ;
:t interpretword ( cp meta -- ) F_IMMEDIATE & state not or
BZ_ [ patchpt ] execute return [ patch!t ] , ;
:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ , , [ patch!t ] ;
:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit 13 emit ;
:t interpretnumber ( n -- n? ) state BZ_ [ patchpt ] LIT_ LIT_ , , [ patch!t ] ;
:t ?err ( word -- ) type LIT_ [ key ? w>t ] emit cr ;
DEFERRED err ?err
:t compileword ( word -- )
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 ]
[ 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"
: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 ;
9 <: ( actual entry point )