eval -> evaluate, better errors.
This commit is contained in:
@ -37,7 +37,7 @@
|
||||
: base ( -- a ) 'sys 4 cells + ;
|
||||
: 'heap ( -- a ) 'sys 5 cells + ;
|
||||
: last ( -- a ) 'sys 6 cells + ;
|
||||
: 'throw ( -- a ) 'sys 7 cells + ;
|
||||
: 'notfound ( -- a ) 'sys 7 cells + ;
|
||||
|
||||
( Dictionary )
|
||||
: here ( -- a ) 'heap @ ;
|
||||
@ -52,7 +52,7 @@
|
||||
: ] -1 state ! ; immediate
|
||||
|
||||
( Quoting Words )
|
||||
: ' bl parse find dup 0= 'throw @ execute ;
|
||||
: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
|
||||
: ['] ' aliteral ; immediate
|
||||
: char bl parse drop c@ ;
|
||||
: [char] char aliteral ; immediate
|
||||
@ -114,7 +114,7 @@ variable handler
|
||||
sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
|
||||
: throw ( n -- )
|
||||
dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
|
||||
' throw 'throw !
|
||||
' throw 'notfound !
|
||||
|
||||
( Values )
|
||||
: value ( n -- ) create , does> @ ;
|
||||
@ -159,6 +159,11 @@ variable hld
|
||||
: ." postpone s" state @ if postpone type else type 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 )
|
||||
: see. ( xt -- ) >name type space ;
|
||||
: see-one ( xt -- xt+1 )
|
||||
@ -180,10 +185,10 @@ create input-buffer input-limit allot
|
||||
|
||||
( REPL )
|
||||
: prompt ." ok" cr ;
|
||||
: eval-buffer begin >in @ #tib @ < while eval1 repeat ;
|
||||
: eval ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
|
||||
#tib ! 'tib ! 0 >in ! eval-buffer
|
||||
: evaluate-buffer begin >in @ #tib @ < while evaluate1 repeat ;
|
||||
: evaluate ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
|
||||
#tib ! 'tib ! 0 >in ! evaluate-buffer
|
||||
r> >in ! r> #tib ! r> 'tib ! ;
|
||||
: query begin ['] eval-buffer catch
|
||||
: query begin ['] evaluate-buffer catch
|
||||
if ." ERROR" cr then prompt refill drop again ;
|
||||
: ok ." uEForth" cr prompt refill drop query ;
|
||||
|
||||
@ -1,12 +1,18 @@
|
||||
#define PRINT_ERRORS 0
|
||||
|
||||
#define NEXT w = *ip++; goto **(void **) w
|
||||
#define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
|
||||
#define FIND(name) find(name, sizeof(name) - 1)
|
||||
#define LOWER(ch) ((ch) & 95)
|
||||
|
||||
#if PRINT_ERRORS
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
static struct {
|
||||
const char *tib;
|
||||
cell_t ntib, tin, state, base;
|
||||
cell_t *heap, *last, tthrow;
|
||||
cell_t *heap, *last, notfound;
|
||||
cell_t DOLIT_XT, DOEXIT_XT;
|
||||
} g_sys;
|
||||
|
||||
@ -68,7 +74,7 @@ static cell_t parse(cell_t sep, cell_t *ret) {
|
||||
return len;
|
||||
}
|
||||
|
||||
static cell_t *eval1(cell_t *sp, cell_t *call) {
|
||||
static cell_t *evaluate1(cell_t *sp, cell_t *call) {
|
||||
*call = 0;
|
||||
cell_t name;
|
||||
cell_t len = parse(' ', &name);
|
||||
@ -90,9 +96,13 @@ static cell_t *eval1(cell_t *sp, cell_t *call) {
|
||||
*++sp = n;
|
||||
}
|
||||
} else {
|
||||
//write(2, (void *) name, len);
|
||||
#if PRINT_ERRORS
|
||||
write(2, (void *) name, len);
|
||||
#endif
|
||||
*++sp = name;
|
||||
*++sp = len;
|
||||
*++sp = -1;
|
||||
*call = g_sys.tthrow;
|
||||
*call = g_sys.notfound;
|
||||
}
|
||||
}
|
||||
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.DOLIT_XT = FIND("DOLIT");
|
||||
g_sys.DOEXIT_XT = FIND("EXIT");
|
||||
g_sys.tthrow = FIND("DROP");
|
||||
g_sys.notfound = FIND("DROP");
|
||||
ip = g_sys.heap;
|
||||
*g_sys.heap++ = FIND("EVAL1");
|
||||
*g_sys.heap++ = FIND("EVALUATE1");
|
||||
*g_sys.heap++ = FIND("BRANCH");
|
||||
*g_sys.heap++ = (cell_t) ip;
|
||||
g_sys.base = 10;
|
||||
|
||||
@ -71,7 +71,7 @@ typedef uint64_t udcell_t;
|
||||
X(":", OP_COLON, t = parse(32, &tmp); \
|
||||
create((const char *) tmp, t, 0, && OP_DOCOL); \
|
||||
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); \
|
||||
if (tmp) goto **(void **) w) \
|
||||
X("EXIT", OP_EXIT, ip = (void *) *rp--) \
|
||||
|
||||
Reference in New Issue
Block a user