cleanup, flow control immediate words
This commit is contained in:
parent
04416807fc
commit
c01f114655
6
asm.jrt
6
asm.jrt
|
|
@ -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* ;
|
||||
|
|
|
|||
7
boot.jor
7
boot.jor
|
|
@ -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
|
||||
|
|
|
|||
4
defs.jrt
4
defs.jrt
|
|
@ -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
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
172
tinyjort.jrt
172
tinyjort.jrt
|
|
@ -14,8 +14,8 @@ dbg" assembling..."
|
|||
increment the instruction pointer.
|
||||
)
|
||||
|
||||
JMP 9 @>
|
||||
|
||||
JMP dbg" JMP" 9 @>
|
||||
dbg" first jmp"
|
||||
: NEXT
|
||||
LODSW
|
||||
MOV BX AX
|
||||
|
|
@ -43,10 +43,11 @@ L: LATEST 0 w>t
|
|||
|
||||
: savelabel ( word -- )
|
||||
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 ] + ;
|
||||
: 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 ;
|
||||
: 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
|
||||
|
|
@ -57,7 +58,7 @@ L: LATEST 0 w>t
|
|||
cell + dup b@t <rot != if 2drop 0 return then cell + ( word tword )
|
||||
begin over b@ over b@t = while
|
||||
over b@ not if 2drop 1 return then ( 0 byte, matched )
|
||||
1 + swap 1 + swap
|
||||
1+ swap 1+ swap
|
||||
repeat 2drop 0 ;
|
||||
: tlookup ( word -- tcp )
|
||||
dup strlen over DICTLIST ( word len tptr-next-entry )
|
||||
|
|
@ -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
|
||||
|
|
@ -498,7 +523,7 @@ dbg" i/o"
|
|||
|
||||
-1 CONST EOF
|
||||
0 VAR, fbuffer
|
||||
: skip>t 1 + cells target @ + w>t ;
|
||||
: skip>t 1+ cells target @ + w>t ;
|
||||
:t fgetc ( fp -- c )
|
||||
1 fbuffer <rot fread fbuffer ub@
|
||||
fcount @ not BZ_ [ 2 skip>t ] drop EOF ;
|
||||
|
|
@ -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,31 +731,32 @@ 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 + ;
|
||||
:t wordname 2 cells + ;
|
||||
: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 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 !
|
||||
( 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 )
|
||||
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 )
|
||||
|
|
|
|||
Loading…
Reference in a new issue