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

Allow for a vocabulary stack.

Browse Source
This commit is contained in:
Brad Nelson
2021-02-06 22:52:20 -08:00
parent 865c54b93a
commit bbf5840691
2 changed files with 18 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
ueforth/common/boot.fs
View File

@ -38,7 +38,7 @@
: base ( -- a ) 'sys 4 cells + ; : base ( -- a ) 'sys 4 cells + ;
: 'heap ( -- a ) 'sys 5 cells + ; : 'heap ( -- a ) 'sys 5 cells + ;
: current ( -- a ) 'sys 6 cells + ; : current ( -- a ) 'sys 6 cells + ;
: context ( -- a ) 'sys 7 cells + ; : 'context ( -- a ) 'sys 7 cells + ; : context 'context @ ;
: 'notfound ( -- a ) 'sys 8 cells + ; : 'notfound ( -- a ) 'sys 8 cells + ;
( Dictionary ) ( Dictionary )

28
ueforth/common/core.h
View File

@ -5,6 +5,7 @@
#define LOWER(ch) ((ch) & 0x5F) #define LOWER(ch) ((ch) & 0x5F)
#define IMMEDIATE 1 #define IMMEDIATE 1
#define SMUDGE 2 #define SMUDGE 2
#define VOCABULARY_DEPTH 16
#if PRINT_ERRORS #if PRINT_ERRORS
#include <unistd.h> #include <unistd.h>
@ -13,7 +14,7 @@
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, **current, **context, notfound; cell_t *heap, **current, ***context, notfound;
int argc; int argc;
char **argv; char **argv;
cell_t *rp; // spot to park main thread cell_t *rp; // spot to park main thread
@ -47,14 +48,16 @@ static cell_t same(const char *a, const char *b, cell_t len) {
} }
static cell_t find(const char *name, cell_t len) { static cell_t find(const char *name, cell_t len) {
cell_t *pos = *g_sys.context; for (cell_t ***voc = g_sys.context; *voc; ++voc) {
cell_t clen = CELL_LEN(len); cell_t *pos = **voc;
while (pos) { cell_t clen = CELL_LEN(len);
if (!(pos[-1] & SMUDGE) && len == pos[-3] && while (pos) {
same(name, (const char *) &pos[-3 - clen], len) == 0) { if (!(pos[-1] & SMUDGE) && len == pos[-3] &&
return (cell_t) pos; same(name, (const char *) &pos[-3 - clen], len) == 0) {
return (cell_t) pos;
}
pos = (cell_t *) pos[-2]; // Follow link
} }
pos = (cell_t *) pos[-2]; // Follow link
} }
return 0; return 0;
} }
@ -131,10 +134,13 @@ static void ueforth_init(int argc, char *argv[], void *heap,
cell_t *rp = g_sys.heap + 1; g_sys.heap += STACK_SIZE; cell_t *rp = g_sys.heap + 1; g_sys.heap += STACK_SIZE;
// FORTH vocabulary // FORTH vocabulary
*g_sys.heap++ = 0; *g_sys.heap++ = 0; cell_t *forth = g_sys.heap;
g_sys.current = (cell_t **) g_sys.heap;
g_sys.context = (cell_t **) g_sys.heap; *g_sys.heap++ = 0;
*g_sys.heap++ = 0; *g_sys.heap++ = 0; *g_sys.heap++ = 0; *g_sys.heap++ = 0; *g_sys.heap++ = 0; *g_sys.heap++ = 0;
// Vocabulary stack
g_sys.current = (cell_t **) forth;
g_sys.context = (cell_t ***) g_sys.heap;
*g_sys.heap++ = (cell_t) forth;
for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys.heap++ = 0; }
ueforth_run(0); ueforth_run(0);
(*g_sys.current)[-1] = IMMEDIATE; // Make last word ; IMMEDIATE (*g_sys.current)[-1] = IMMEDIATE; // Make last word ; IMMEDIATE