cleanup and bufixes, simple test program for the interpreter

This commit is contained in:
Jeremy Penner 2023-09-05 20:59:38 -04:00
parent 74171670b2
commit 04416807fc
2 changed files with 23 additions and 18 deletions

Binary file not shown.

View file

@ -34,9 +34,9 @@ JMP 9 @>
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
: ALLOT ( n -- ) 0 for 0 >t next ;
L: DICTIONARY 0x10 cells ALLOT
L: LATEST 0 w>t
0x0f const BUCKETMASK
@ -49,7 +49,8 @@ L: LATEST 0 w>t
: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ;
: 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
: DEF target @ [ L@ LATEST lit ] !t
word dup savelabel dup DICTLIST link>t dup strlen w>t str>t
target @ cell + .hex cr ;
: WORD= ( word len tptr -- f )
@ -193,7 +194,7 @@ DEF GOTO_ L@ GOTO_IMPL w>t
:ASM over
( this costs 1 extra byte but should save 20 clock cycles )
MOV BX SP
PUSH @[ 4 @+ SS: BX]
PUSH @[ 2 @+ SS: BX]
( POP AX
POP BX
PUSH BX
@ -259,7 +260,7 @@ L: RETFALSE
:ASM not
POP AX
CMP AX FALSE
CMP AX 0 #
JZ RETTRUE
JMP RETFALSE
@ -287,9 +288,9 @@ L: RETFALSE
:ASM and
POP AX
POP BX
CMP AX FALSE
CMP AX 0 #
JZ RETFALSE
CMP BX FALSE
CMP BX 0 #
JZ RETFALSE
JMP RETTRUE
@ -518,6 +519,7 @@ DEFERRED emit console-emit
NEXT
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
@ -603,8 +605,9 @@ L: fail-digit 0 <:
JMP fail-digit
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 DI t& &here @+
MOV DI L@ NUMBUF #
POP AX
CMP AX 0 #
JGE 0 @>
@ -625,7 +628,7 @@ L: write-next-digit
DEC CX ( if we haven't written any digits this will hit 0 on the ones place )
JMP 2 @>
1 <: 0 <:
XOR CX CX
XOR CX CX ( we've started outputting digits - set CX to 0 )
ADD AX key 0 #
STOSB
2 <:
@ -636,7 +639,8 @@ L: write-next-digit
XOR AX AX
STOSB ( trailing 0 )
POP SI
PUSH t& &here @+
MOV DI L@ NUMBUF #
PUSH DI
NEXT
:t type [ target @ ]
@ -682,8 +686,9 @@ L: write-next-digit
[ 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! ;
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 ;
dbg" compiler"
:t wordflags cell + ;
@ -788,11 +793,11 @@ DEFERRED err ?err
dbg" boot stub"
:ASM debug NEXT
: t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
ARRAY input t" +"
ARRAY input t" 1 2 + ."
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 ;
: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 )
MOV SI t& tinyjort #
@ -801,7 +806,7 @@ t' keyinput t& key !t
ADD AX 4096 #
MOV SS AX
MOV t& lastseg @+ AX
MOV SP 0xfe #
MOV SP 0x100 #
MOV BP 0x00 #
NEXT