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 + ;
: '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
r> >in ! r> #tib ! r> 'tib ! ;
: query begin ['] eval-buffer catch
: 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 ['] evaluate-buffer catch
if ." ERROR" cr then prompt refill drop again ;
: 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 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;

6
ueforth/common/opcodes.h
View File

@ -71,9 +71,9 @@ 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); \
DROP; if (tmp) (w = tmp); \
if (tmp) goto **(void **) w) \
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--) \
X(";", OP_SEMICOLON, *g_sys.heap++ = g_sys.DOEXIT_XT; g_sys.state = 0) \