dictionary words, limited "target" compiler
This commit is contained in:
parent
8d5fbe0143
commit
74171670b2
5
boot.jor
5
boot.jor
|
|
@ -7,8 +7,7 @@
|
|||
13 const '\r'
|
||||
key const sp
|
||||
|
||||
128 const F_IMMEDIATE
|
||||
0x100 const F_USERWORD
|
||||
0x100 const F_IMMEDIATE
|
||||
|
||||
: cr '\n' emit ;
|
||||
: bl sp emit ;
|
||||
|
|
@ -60,7 +59,7 @@ key const sp
|
|||
( image loading )
|
||||
: noop ;
|
||||
|
||||
: defer word new-word $DODEFERRED , ' noop , ;
|
||||
: defer new-word $DODEFERRED , ' noop , ;
|
||||
: redefine ( cp cpdeferred ) cell + ! ;
|
||||
: definition ( cpdeferred ) cell + @ ;
|
||||
|
||||
|
|
|
|||
4
defs.jrt
4
defs.jrt
|
|
@ -27,8 +27,8 @@
|
|||
|
||||
: :noname here $DOCOLON , ] ;
|
||||
|
||||
: array word new-word $DOVAR , ;
|
||||
: create word new-word $DOCREATE , 0 , ;
|
||||
: array new-word $DOVAR , ;
|
||||
: create new-word $DOCREATE , 0 , ;
|
||||
|
||||
: finishcreate ( ipfirst -- )
|
||||
( set cell after codepointer to first instruction of does> )
|
||||
|
|
|
|||
14
lookup.jrt
Executable file
14
lookup.jrt
Executable file
|
|
@ -0,0 +1,14 @@
|
|||
:t entry= ( name len entry -- f )
|
||||
dup wordname swap wordlen <rot = BZ_ [ ( p1 - fail ) patchpt ]
|
||||
[ ( l1 ) target @ ] over b@ dup BZ_ [ ( p2 - success ) patchpt ]
|
||||
over b@ = BZ_ [ ( p3 - fail ) patchpt ]
|
||||
2inc GOTO_ [ ( l1 ) <rot w>t ]
|
||||
( fail ) [ patch!t swap patch!t ] drop drop 0 return
|
||||
( success ) [ patch!t ] drop drop 1 ;
|
||||
|
||||
:t lookup ( name -- cp meta | name 0 )
|
||||
dup strlen over dictbucket
|
||||
[ target @ ] @ dup . dup BZ_ [ patchpt ]
|
||||
3dup entry= BZ_ [ swap w>t ]
|
||||
( entry found ) >rot drop drop dup codepointer swap wordflags @ return
|
||||
( end of list ) [ patch!t ] drop drop 0 ;
|
||||
|
|
@ -345,7 +345,7 @@ void f_bcomma() {
|
|||
DROP(1);
|
||||
}
|
||||
|
||||
void f_create() { // name --
|
||||
void f_create() { // word --
|
||||
int namelen;
|
||||
HERE->p = LATEST;
|
||||
LATEST = HERE;
|
||||
|
|
@ -357,6 +357,10 @@ void f_create() { // name --
|
|||
DROP(1);
|
||||
}
|
||||
|
||||
void f_newword() {
|
||||
f_word();
|
||||
f_create();
|
||||
}
|
||||
void f_cdef() { // func name --
|
||||
f_create();
|
||||
f_comma();
|
||||
|
|
@ -765,7 +769,7 @@ void f_init() {
|
|||
CDEF("word", f_word);
|
||||
CDEF("immediate", f_immediate);
|
||||
CDEF("execute", f_execute);
|
||||
CDEF("new-word", f_create);
|
||||
CDEF("new-word", f_newword);
|
||||
CDEF("here", f_here);
|
||||
CDEF("here!", f_here_set);
|
||||
CDEF("there", f_there);
|
||||
|
|
|
|||
BIN
minijort.exe
BIN
minijort.exe
Binary file not shown.
|
|
@ -34,8 +34,8 @@ extern cell *rstack;
|
|||
extern cell *stack;
|
||||
extern FILE *IN_FILE;
|
||||
extern FILE *OUT_FILE;
|
||||
#define F_NAMELEN_MASK 0x7f
|
||||
#define F_IMMEDIATE 0x80
|
||||
#define F_NAMELEN_MASK 0xff
|
||||
#define F_IMMEDIATE 0x100
|
||||
|
||||
#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b))
|
||||
#define TOP() (*(stack - 1))
|
||||
|
|
|
|||
BIN
minijort.prj
BIN
minijort.prj
Binary file not shown.
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
318
tinyjort.jrt
318
tinyjort.jrt
|
|
@ -28,8 +28,9 @@ JMP 9 @>
|
|||
bits.
|
||||
Entry:
|
||||
LINK - pointer to next word in the dictionary
|
||||
FLAGS - byte
|
||||
LENGTH - byte
|
||||
META - word, made up of:
|
||||
LENGTH - byte
|
||||
FLAGS - byte
|
||||
NAME - bytes ending in \0
|
||||
CODE POINTER - pointer to machine code routine )
|
||||
|
||||
|
|
@ -38,26 +39,30 @@ 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
|
||||
L: LATEST 0 w>t
|
||||
|
||||
0x0f const BUCKETMASK
|
||||
|
||||
: savelabel ( word -- )
|
||||
dup type s" : " type
|
||||
here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ;
|
||||
: DICTLIST ( word -- tptr ) b@ 0x0f & 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 ;
|
||||
: 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
|
||||
: patch!t ( tptr -- ) target @ swap !t ;
|
||||
: link>t ( tptr-head -- ) dup @t swap patch!t w>t ;
|
||||
: DEF word dup savelabel dup DICTLIST link>t dup strlen w>t str>t
|
||||
target @ cell + .hex cr ;
|
||||
|
||||
: WORD= ( word len tptr -- f )
|
||||
3 + dup b@t <rot != if 2drop 0 return then 1 + ( word tword )
|
||||
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
|
||||
repeat 2drop 0 ;
|
||||
|
||||
: t' word dup strlen over DICTLIST ( word len tptr-next-entry )
|
||||
: tlookup ( word -- tcp )
|
||||
dup strlen over DICTLIST ( word len tptr-next-entry )
|
||||
begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat
|
||||
drop drop drop 0 ;
|
||||
: t' word tlookup ;
|
||||
: t& t' cell + ;
|
||||
|
||||
: :ASM DEF target @ 2 + w>t ;
|
||||
|
|
@ -71,6 +76,7 @@ L: $$CONST
|
|||
|
||||
: CONST DEF [ L@ $$CONST lit ] w>t w>t ;
|
||||
|
||||
L@ $$CONST CONST $DOCONST
|
||||
L@ DICTIONARY CONST dictionary
|
||||
L@ LATEST CONST &latest
|
||||
|
||||
|
|
@ -99,22 +105,35 @@ L@ $$VAR CONST $DOVAR
|
|||
MOV SI @[ BP]
|
||||
NEXT
|
||||
|
||||
( some helpers for making manually defining colon words slightly less ugly )
|
||||
: '>t t' w>t ;
|
||||
: :t DEF [ t& $DOCOLON lit ] w>t ;
|
||||
|
||||
:CP $DODEFERRED
|
||||
INC BX INC BX
|
||||
MOV BX @[ BX]
|
||||
JMP @[ BX]
|
||||
|
||||
: DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ;
|
||||
|
||||
:ASM LIT_
|
||||
LODSW
|
||||
PUSH AX
|
||||
NEXT
|
||||
|
||||
( some helpers for making manually defining colon words less ugly )
|
||||
: '>t t' w>t ;
|
||||
|
||||
: stch? ( str -- f ) ' @ , key lit ' = , ; immediate
|
||||
( DOES NOT SUPPORT ARBITRARY IMMEDIATE WORDS.
|
||||
Supports [], comments, ; and numeric literals ONLY.
|
||||
You must use [ for anything fancy. )
|
||||
: :t DEF [ t& $DOCOLON lit ] w>t ]
|
||||
begin word dup stch? ; not while
|
||||
state if dup stch? [ if drop [ ' [ , ] else
|
||||
dup stch? ( if drop [ ' ( , ] else
|
||||
dup tlookup dup if w>t drop else drop
|
||||
number if [ t' LIT_ lit ] w>t w>t else
|
||||
type s" ?" type cr then then then then else
|
||||
compileword then
|
||||
repeat drop [ t' return lit ] w>t [ ' [ , ] ;
|
||||
|
||||
: DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ;
|
||||
|
||||
:ASM INLINEDATA_
|
||||
LODSW
|
||||
PUSH SI
|
||||
|
|
@ -143,6 +162,27 @@ DEF GOTO_ L@ GOTO_IMPL w>t
|
|||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM 2dup
|
||||
POP AX
|
||||
POP BX
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM 3dup
|
||||
POP AX
|
||||
POP BX
|
||||
POP CX
|
||||
PUSH CX
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
PUSH CX
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM swap
|
||||
POP AX
|
||||
POP BX
|
||||
|
|
@ -151,11 +191,14 @@ DEF GOTO_ L@ GOTO_IMPL w>t
|
|||
NEXT
|
||||
|
||||
:ASM over
|
||||
POP AX
|
||||
POP BX
|
||||
POP BX
|
||||
POP AX
|
||||
( this costs 1 extra byte but should save 20 clock cycles )
|
||||
MOV BX SP
|
||||
PUSH @[ 4 @+ SS: BX]
|
||||
( POP AX
|
||||
POP BX
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
PUSH BX )
|
||||
NEXT
|
||||
|
||||
:ASM <rot
|
||||
|
|
@ -167,9 +210,18 @@ DEF GOTO_ L@ GOTO_IMPL w>t
|
|||
PUSH CX
|
||||
NEXT
|
||||
|
||||
:ASM >rot
|
||||
POP AX
|
||||
POP BX
|
||||
POP CX
|
||||
PUSH AX
|
||||
PUSH CX
|
||||
PUSH BX
|
||||
NEXT
|
||||
|
||||
:ASM terminate
|
||||
MOV AH 0x4c #
|
||||
MOV AL 0 # ( todo: pop )
|
||||
MOV AL 0 # ( todo: pop? )
|
||||
INT 0x21 #
|
||||
|
||||
:ASM execute
|
||||
|
|
@ -248,9 +300,9 @@ L: RETFALSE
|
|||
JZ RETFALSE
|
||||
JMP RETTRUE
|
||||
|
||||
:t != '>t = '>t not '>t return
|
||||
:t <= '>t > '>t not '>t return
|
||||
:t >= '>t < '>t not '>t return
|
||||
:t != = not ;
|
||||
:t <= > not ;
|
||||
:t >= < not ;
|
||||
|
||||
dbg" bitwise"
|
||||
:ASM &
|
||||
|
|
@ -281,7 +333,7 @@ dbg" bitwise"
|
|||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM >>
|
||||
:ASM >> ( val count )
|
||||
POP CX
|
||||
POP AX
|
||||
SHR AX CL
|
||||
|
|
@ -291,8 +343,7 @@ dbg" bitwise"
|
|||
dbg" mem"
|
||||
:ASM @
|
||||
POP BX
|
||||
MOV AX @[ BX]
|
||||
PUSH AX
|
||||
PUSH @[ BX]
|
||||
NEXT
|
||||
|
||||
:ASM b@
|
||||
|
|
@ -311,8 +362,7 @@ dbg" mem"
|
|||
|
||||
:ASM @far
|
||||
POP ES POP BX
|
||||
MOV AX @[ ES: BX]
|
||||
PUSH AX
|
||||
PUSH @[ ES: BX]
|
||||
NEXT
|
||||
|
||||
:ASM b@far
|
||||
|
|
@ -323,8 +373,8 @@ dbg" mem"
|
|||
NEXT
|
||||
|
||||
:ASM !
|
||||
POP BX POP AX
|
||||
MOV @[ BX] AX
|
||||
POP BX
|
||||
POP @[ BX]
|
||||
NEXT
|
||||
|
||||
:ASM b!
|
||||
|
|
@ -333,8 +383,8 @@ dbg" mem"
|
|||
NEXT
|
||||
|
||||
:ASM !far
|
||||
POP ES POP BX POP AX
|
||||
MOV @[ ES: BX] AX
|
||||
POP ES POP BX
|
||||
POP @[ ES: BX]
|
||||
NEXT
|
||||
|
||||
:ASM b!far
|
||||
|
|
@ -344,20 +394,17 @@ dbg" mem"
|
|||
|
||||
dbg" return stack"
|
||||
:ASM >r
|
||||
POP AX
|
||||
MOV @[ BP] AX
|
||||
POP @[ BP]
|
||||
INC BP INC BP
|
||||
NEXT
|
||||
|
||||
:ASM <r
|
||||
DEC BP DEC BP
|
||||
MOV AX @[ BP]
|
||||
PUSH AX
|
||||
PUSH @[ BP]
|
||||
NEXT
|
||||
|
||||
:ASM r@
|
||||
MOV AX @[ -2 @+ BP]
|
||||
PUSH AX
|
||||
PUSH @[ -2 @+ BP]
|
||||
NEXT
|
||||
|
||||
:ASM rdrop
|
||||
|
|
@ -390,21 +437,21 @@ dbg" patched"
|
|||
)
|
||||
dbg" allocation"
|
||||
0 VAR, &here
|
||||
:t here '>t &here '>t @ '>t return
|
||||
:t here! '>t &here '>t ! '>t return
|
||||
:t here &here @ ;
|
||||
:t here! &here ! ;
|
||||
0xffff CONST there
|
||||
|
||||
:t latest '>t &latest '>t @ '>t return
|
||||
:t latest! '>t &latest '>t ! '>t return
|
||||
:t latest &latest @ ;
|
||||
:t latest! &latest ! ;
|
||||
|
||||
0 VAR, lastseg
|
||||
:t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t +
|
||||
'>t dup '>t lastseg '>t ! '>t return
|
||||
:t segalloc lastseg @ 4096 + dup lastseg ! ;
|
||||
|
||||
2 CONST cell
|
||||
:t allot '>t here '>t + '>t here! '>t return
|
||||
:t , '>t here '>t ! '>t cell '>t allot '>t return
|
||||
:t b, '>t here '>t b! '>t LIT_ 1 w>t '>t allot '>t return
|
||||
:t cells cell * ;
|
||||
:t allot here + here! ;
|
||||
:t , here ! cell allot ;
|
||||
:t b, here b! 1 allot ;
|
||||
|
||||
dbg" i/o"
|
||||
:ASM overwrite
|
||||
|
|
@ -450,12 +497,11 @@ dbg" i/o"
|
|||
|
||||
-1 CONST EOF
|
||||
0 VAR, fbuffer
|
||||
:t fgetc '>t LIT_ 1 w>t '>t fbuffer '>t <rot '>t fread
|
||||
'>t fbuffer '>t ub@
|
||||
'>t fcount '>t @ '>t not '>t BZ_ target @ 3 cells + w>t
|
||||
'>t drop '>t EOF '>t return
|
||||
:t fputc '>t swap '>t fbuffer '>t b!
|
||||
'>t LIT_ 1 w>t '>t fbuffer '>t <rot '>t fwrite '>t return
|
||||
: 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 ;
|
||||
:t fputc ( c fp -- ) swap fbuffer b! 1 fbuffer <rot fwrite ;
|
||||
|
||||
:ASM console-emit
|
||||
MOV AH 2 #
|
||||
|
|
@ -472,12 +518,10 @@ DEFERRED emit console-emit
|
|||
NEXT
|
||||
|
||||
0 VAR, infile ( 0 is a predefined file handle meaning stdin )
|
||||
:t in-key '>t infile '>t @ '>t dup '>t BZ_ target @ 4 cells + w>t
|
||||
'>t drop '>t console-key '>t return
|
||||
'>t fgetc '>t return
|
||||
:t in-key infile @ dup BZ_ [ 3 skip>t ] drop console-key return fgetc ;
|
||||
DEFERRED key in-key
|
||||
|
||||
dbg" number"
|
||||
dbg" parsing"
|
||||
L: BASE 10 w>t L: ISNEG? 0 >t
|
||||
:ASM number ( str -- num 1 | str 0 )
|
||||
( AX - current number
|
||||
|
|
@ -595,17 +639,163 @@ L: write-next-digit
|
|||
PUSH t& &here @+
|
||||
NEXT
|
||||
|
||||
:t type target @ '>t dup '>t b@ '>t dup '>t BZ_ target @ 7 cells + w>t
|
||||
'>t emit '>t LIT_ 1 w>t '>t + '>t GOTO_ w>t '>t drop '>t drop '>t return
|
||||
:t . '>t num>str '>t type '>t LIT_ key w>t '>t emit '>t return
|
||||
: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 ;
|
||||
|
||||
dbg" test"
|
||||
( test program )
|
||||
ARRAY hex65 key - >t key 6 >t key 5 >t 0 >t
|
||||
L: test-word '>t hex65 '>t number '>t . '>t . '>t terminate
|
||||
:ASM whitespace?
|
||||
POP AX
|
||||
CMP AX key #
|
||||
JZ 0 @>
|
||||
CMP AX 13 # ( newline )
|
||||
JZ 1 @>
|
||||
CMP AX 10 # ( linefeed )
|
||||
JZ 2 @>
|
||||
CMP AX 9 # ( tab )
|
||||
JNZ 3 @>
|
||||
0 <: 1 <: 2 <:
|
||||
PUSH TRUE
|
||||
NEXT
|
||||
3 <:
|
||||
PUSH FALSE
|
||||
NEXT
|
||||
|
||||
:ASM eoi? ( end of input )
|
||||
POP AX
|
||||
CMP AX 0 # ( null )
|
||||
JZ 0 @>
|
||||
CMP AX -1 # ( EOF )
|
||||
JNZ 1 @>
|
||||
0 <:
|
||||
PUSH TRUE
|
||||
NEXT
|
||||
1 <:
|
||||
PUSH FALSE
|
||||
NEXT
|
||||
|
||||
:t word,
|
||||
( consume leading whitespace )
|
||||
0 [ target @ ] drop key dup whitespace? not BZ_ [ w>t ]
|
||||
( consume non-whitespace / eoi characters )
|
||||
[ target @ ] dup whitespace? over eoi? or
|
||||
( if whitespace or eoi, end ) BZ_ [ 5 skip>t ] drop 0 b, return
|
||||
( otherwise, write byte and continue ) b, key GOTO_ [ w>t ] ;
|
||||
|
||||
:t word here word, dup here! ;
|
||||
|
||||
dbg" compiler"
|
||||
:t wordflags cell + ;
|
||||
:t wordname 2 cells + ;
|
||||
:t wordlen wordflags ub@ ;
|
||||
: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 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 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 )
|
||||
POP BX ( dictionary )
|
||||
POP DI ( name )
|
||||
( strlen - in DI: str, out CX: len, clobbers AX )
|
||||
XOR CX CX DEC CX ( start CX at -1 so we search until we find the 0 )
|
||||
XOR AX AX ( search for 0 )
|
||||
REPNZ SCASB
|
||||
NEG CX DEC CX
|
||||
SUB DI CX ( restore DI )
|
||||
DEC CX ( ignore trailing zero )
|
||||
|
||||
( keeping CX + DI, find the next entry pointer and store in BX )
|
||||
MOV AL @[ DI]
|
||||
AND AL BUCKETMASK #
|
||||
SHL AX 1 #
|
||||
ADD BX AX
|
||||
|
||||
( save SI )
|
||||
MOV DX SI
|
||||
|
||||
L: check-next-entry
|
||||
MOV BX @[ BX]
|
||||
CMP BX 0 #
|
||||
JZ 0 @>
|
||||
CMP CL @[ 2 @+ BX]
|
||||
JNZ check-next-entry
|
||||
|
||||
( we have a matching length; compare the string )
|
||||
PUSH CX
|
||||
PUSH DI
|
||||
MOV SI BX
|
||||
ADD SI 4 #
|
||||
REPZ CMPSB
|
||||
POP DI
|
||||
POP CX
|
||||
JNZ check-next-entry
|
||||
|
||||
( we have a matching word! return success )
|
||||
MOV AX @[ 2 @+ BX] ( read flag word )
|
||||
ADD BX CX ( strlen )
|
||||
ADD BX 5 # ( header + null byte )
|
||||
PUSH BX
|
||||
PUSH AX
|
||||
MOV SI DX ( restore SI )
|
||||
NEXT
|
||||
|
||||
0 <: ( failure; we've hit a null pointer in our linked list )
|
||||
PUSH DI ( push word pointer back onto the stack )
|
||||
PUSH FALSE
|
||||
MOV SI DX ( restore SI )
|
||||
NEXT
|
||||
|
||||
:t lookup dictionary dict-lookup ;
|
||||
|
||||
0x100 CONST F_IMMEDIATE
|
||||
:t immediate latest wordflags dup @ F_IMMEDIATE | swap ! ;
|
||||
: IMMEDIATE [ L@ LATEST lit ] @t cell + dup @t 0x100 | swap !t ;
|
||||
|
||||
0 VAR, &state
|
||||
:t state &state @ ;
|
||||
:t ] 1 &state ! ;
|
||||
:t [ 0 &state ! ; IMMEDIATE
|
||||
:t : new-word $DOCOLON , ] ;
|
||||
:t ; LIT_ return , [ '>t [ ] ; IMMEDIATE
|
||||
:t const new-word $DOCONST , , ;
|
||||
: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 ;
|
||||
DEFERRED err ?err
|
||||
:t compileword ( word -- )
|
||||
lookup dup BZ_ [ patchpt ] interpretword return [ patch!t ]
|
||||
drop number BZ_ [ patchpt ] interpretnumber return [ patch!t ]
|
||||
err ;
|
||||
:t interpreter
|
||||
[ target @ ] word dup b@ BZ_ [ patchpt ] compileword GOTO_ [ swap w>t ]
|
||||
[ patch!t ] drop ;
|
||||
|
||||
dbg" boot stub"
|
||||
:ASM debug NEXT
|
||||
: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
|
||||
ARRAY input t" +"
|
||||
t& input VAR, inptr
|
||||
:t keyinput inptr @ b@ dup BZ_ [ patchpt ] inptr @ 1 + inptr ! [ patch!t ] ;
|
||||
t' keyinput t& key !t
|
||||
:t tinyjort 1 2 word lookup drop execute . terminate ;
|
||||
|
||||
9 <: ( actual entry point )
|
||||
LEA SI test-word
|
||||
MOV SI t& tinyjort #
|
||||
PUSH CS
|
||||
POP AX
|
||||
ADD AX 4096 #
|
||||
|
|
|
|||
Loading…
Reference in a new issue