alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

eval -> evaluate, better errors.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-03 21:16:36 -08:00
parent f3bcf32a12
commit 0dc6719cc1
3 changed files with 32 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
ueforth/common/boot.fs
View File

@ -37,7 +37,7 @@
: base ( -- a ) 'sys 4 cells + ; : base ( -- a ) 'sys 4 cells + ;
: 'heap ( -- a ) 'sys 5 cells + ; : 'heap ( -- a ) 'sys 5 cells + ;
: last ( -- a ) 'sys 6 cells + ; : last ( -- a ) 'sys 6 cells + ;
: 'throw ( -- a ) 'sys 7 cells + ; : 'notfound ( -- a ) 'sys 7 cells + ;
( Dictionary ) ( Dictionary )
: here ( -- a ) 'heap @ ; : here ( -- a ) 'heap @ ;
@ -52,7 +52,7 @@
: ] -1 state ! ; immediate : ] -1 state ! ; immediate
( Quoting Words ) ( Quoting Words )
: ' bl parse find dup 0= 'throw @ execute ; : ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
: ['] ' aliteral ; immediate : ['] ' aliteral ; immediate
: char bl parse drop c@ ; : char bl parse drop c@ ;
: [char] char aliteral ; immediate : [char] char aliteral ; immediate
@ -114,7 +114,7 @@ variable handler
sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ; sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
: throw ( n -- ) : throw ( n -- )
dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ; dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
' throw 'throw ! ' throw 'notfound !
( Values ) ( Values )
: value ( n -- ) create , does> @ ; : value ( n -- ) create , does> @ ;
@ -159,6 +159,11 @@ variable hld
: ." postpone s" state @ if postpone type else type then ; immediate : ." postpone s" state @ if postpone type else type then ; immediate
: z" postpone s" state @ if postpone drop else drop then ; immediate : z" postpone s" state @ if postpone drop else drop then ; immediate
( Better Errors )
: notfound ( a n n -- )
if cr ." ERROR: " type ." NOT FOUND!" cr -1 throw then ;
' notfound 'notfound !
( Examine Dictionary ) ( Examine Dictionary )
: see. ( xt -- ) >name type space ; : see. ( xt -- ) >name type space ;
: see-one ( xt -- xt+1 ) : see-one ( xt -- xt+1 )
@ -180,10 +185,10 @@ create input-buffer input-limit allot
( REPL ) ( REPL )
: prompt ." ok" cr ; : prompt ." ok" cr ;
: eval-buffer begin >in @ #tib @ < while eval1 repeat ; : evaluate-buffer begin >in @ #tib @ < while evaluate1 repeat ;
: eval ( a n -- ) 'tib @ >r #tib @ >r >in @ >r : evaluate ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
#tib ! 'tib ! 0 >in ! eval-buffer #tib ! 'tib ! 0 >in ! evaluate-buffer
r> >in ! r> #tib ! r> 'tib ! ; r> >in ! r> #tib ! r> 'tib ! ;
: query begin ['] eval-buffer catch : query begin ['] evaluate-buffer catch
if ." ERROR" cr then prompt refill drop again ; if ." ERROR" cr then prompt refill drop again ;
: ok ." uEForth" cr prompt refill drop query ; : ok ." uEForth" cr prompt refill drop query ;

22
ueforth/common/core.h
View File

@ -1,12 +1,18 @@
#define PRINT_ERRORS 0
#define NEXT w = *ip++; goto **(void **) w #define NEXT w = *ip++; goto **(void **) w
#define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t)) #define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
#define FIND(name) find(name, sizeof(name) - 1) #define FIND(name) find(name, sizeof(name) - 1)
#define LOWER(ch) ((ch) & 95) #define LOWER(ch) ((ch) & 95)
#if PRINT_ERRORS
#include <unistd.h>
#endif
static struct { static struct {
const char *tib; const char *tib;
cell_t ntib, tin, state, base; cell_t ntib, tin, state, base;
cell_t *heap, *last, tthrow; cell_t *heap, *last, notfound;
cell_t DOLIT_XT, DOEXIT_XT; cell_t DOLIT_XT, DOEXIT_XT;
} g_sys; } g_sys;
@ -68,7 +74,7 @@ static cell_t parse(cell_t sep, cell_t *ret) {
return len; return len;
} }
static cell_t *eval1(cell_t *sp, cell_t *call) { static cell_t *evaluate1(cell_t *sp, cell_t *call) {
*call = 0; *call = 0;
cell_t name; cell_t name;
cell_t len = parse(' ', &name); cell_t len = parse(' ', &name);
@ -90,9 +96,13 @@ static cell_t *eval1(cell_t *sp, cell_t *call) {
*++sp = n; *++sp = n;
} }
} else { } else {
//write(2, (void *) name, len); #if PRINT_ERRORS
write(2, (void *) name, len);
#endif
*++sp = name;
*++sp = len;
*++sp = -1; *++sp = -1;
*call = g_sys.tthrow; *call = g_sys.notfound;
} }
} }
return sp; return sp;
@ -113,9 +123,9 @@ static void ueforth(void *heap, const char *src, cell_t src_len) {
g_sys.last[-1] = 1; // Make ; IMMEDIATE g_sys.last[-1] = 1; // Make ; IMMEDIATE
g_sys.DOLIT_XT = FIND("DOLIT"); g_sys.DOLIT_XT = FIND("DOLIT");
g_sys.DOEXIT_XT = FIND("EXIT"); g_sys.DOEXIT_XT = FIND("EXIT");
g_sys.tthrow = FIND("DROP"); g_sys.notfound = FIND("DROP");
ip = g_sys.heap; ip = g_sys.heap;
*g_sys.heap++ = FIND("EVAL1"); *g_sys.heap++ = FIND("EVALUATE1");
*g_sys.heap++ = FIND("BRANCH"); *g_sys.heap++ = FIND("BRANCH");
*g_sys.heap++ = (cell_t) ip; *g_sys.heap++ = (cell_t) ip;
g_sys.base = 10; g_sys.base = 10;

6
ueforth/common/opcodes.h
View File

@ -71,9 +71,9 @@ typedef uint64_t udcell_t;
X(":", OP_COLON, t = parse(32, &tmp); \ X(":", OP_COLON, t = parse(32, &tmp); \
create((const char *) tmp, t, 0, && OP_DOCOL); \ create((const char *) tmp, t, 0, && OP_DOCOL); \
g_sys.state = -1) \ g_sys.state = -1) \
X("EVAL1", OP_EVAL1, DUP; sp = eval1(sp, &tmp); \ X("EVALUATE1", OP_EVALUATE1, DUP; sp = evaluate1(sp, &tmp); \
DROP; if (tmp) (w = tmp); \ DROP; if (tmp) (w = tmp); \
if (tmp) goto **(void **) w) \ if (tmp) goto **(void **) w) \
X("EXIT", OP_EXIT, ip = (void *) *rp--) \ X("EXIT", OP_EXIT, ip = (void *) *rp--) \
X(";", OP_SEMICOLON, *g_sys.heap++ = g_sys.DOEXIT_XT; g_sys.state = 0) \ X(";", OP_SEMICOLON, *g_sys.heap++ = g_sys.DOEXIT_XT; g_sys.state = 0) \