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

Move g_sys to the forth heap.

Browse Source
This commit is contained in:
Brad Nelson
2022-07-10 14:13:51 -07:00
parent ddd878ae20
commit 3b27ff93bb
8 changed files with 118 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

147
common/core.h
View File

@ -43,7 +43,7 @@ enum {
#undef V
};
static struct {
typedef struct {
cell_t *heap, **current, ***context;
cell_t *latestxt, notfound;
cell_t *heap_start;
@ -61,7 +61,8 @@ static struct {
cell_t DOLIT_XT, DOFLIT_XT, DOEXIT_XT, YIELD_XT;
void *DOCREATE_OP;
const BUILTIN_WORD *builtins;
} g_sys;
} G_SYS;
static G_SYS *g_sys = 0;
static cell_t convert(const char *pos, cell_t n, cell_t base, cell_t *ret) {
*ret = 0;
@ -127,16 +128,16 @@ static cell_t same(const char *a, const char *b, cell_t len) {
}
static cell_t find(const char *name, cell_t len) {
for (cell_t ***voc = g_sys.context; *voc; ++voc) {
for (cell_t ***voc = g_sys->context; *voc; ++voc) {
cell_t xt = (cell_t) **voc;
while (xt) {
if ((*TOFLAGS(xt) & BUILTIN_FORK)) {
cell_t vocab = TOLINK(xt)[3];
for (int i = 0; g_sys.builtins[i].name; ++i) {
if (g_sys.builtins[i].vocabulary == vocab &&
len == g_sys.builtins[i].name_length &&
same(name, g_sys.builtins[i].name, len)) {
return (cell_t) &g_sys.builtins[i].code;
for (int i = 0; g_sys->builtins[i].name; ++i) {
if (g_sys->builtins[i].vocabulary == vocab &&
len == g_sys->builtins[i].name_length &&
same(name, g_sys->builtins[i].name, len)) {
return (cell_t) &g_sys->builtins[i].code;
}
}
}
@ -151,24 +152,24 @@ static cell_t find(const char *name, cell_t len) {
}
static void finish(void) {
if (g_sys.latestxt && !*TOPARAMS(g_sys.latestxt)) {
cell_t sz = g_sys.heap - &g_sys.latestxt[1];
if (g_sys->latestxt && !*TOPARAMS(g_sys->latestxt)) {
cell_t sz = g_sys->heap - &g_sys->latestxt[1];
if (sz < 0 || sz > 0xffff) { sz = 0xffff; }
*TOPARAMS(g_sys.latestxt) = sz;
*TOPARAMS(g_sys->latestxt) = sz;
}
}
static void create(const char *name, cell_t nlength, cell_t flags, void *op) {
finish();
g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap);
char *pos = (char *) g_sys.heap;
g_sys->heap = (cell_t *) CELL_ALIGNED(g_sys->heap);
char *pos = (char *) g_sys->heap;
for (cell_t n = nlength; n; --n) { *pos++ = *name++; } // name
g_sys.heap += CELL_LEN(nlength);
*g_sys.heap++ = (cell_t) *g_sys.current; // link
*g_sys.heap++ = (nlength << 8) | flags; // flags & length
*g_sys.current = g_sys.heap;
g_sys.latestxt = g_sys.heap;
*g_sys.heap++ = (cell_t) op; // code
g_sys->heap += CELL_LEN(nlength);
*g_sys->heap++ = (cell_t) *g_sys->current; // link
*g_sys->heap++ = (nlength << 8) | flags; // flags & length
*g_sys->current = g_sys->heap;
g_sys->latestxt = g_sys->heap;
*g_sys->heap++ = (cell_t) op; // code
}
static int match(char sep, char ch) {
@ -177,14 +178,14 @@ static int match(char sep, char ch) {
static cell_t parse(cell_t sep, cell_t *ret) {
if (sep == ' ') {
while (g_sys.tin < g_sys.ntib &&
match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; }
while (g_sys->tin < g_sys->ntib &&
match(sep, g_sys->tib[g_sys->tin])) { ++g_sys->tin; }
}
*ret = (cell_t) (g_sys.tib + g_sys.tin);
while (g_sys.tin < g_sys.ntib &&
!match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; }
cell_t len = g_sys.tin - (*ret - (cell_t) g_sys.tib);
if (g_sys.tin < g_sys.ntib) { ++g_sys.tin; }
*ret = (cell_t) (g_sys->tib + g_sys->tin);
while (g_sys->tin < g_sys->ntib &&
!match(sep, g_sys->tib[g_sys->tin])) { ++g_sys->tin; }
cell_t len = g_sys->tin - (*ret - (cell_t) g_sys->tib);
if (g_sys->tin < g_sys->ntib) { ++g_sys->tin; }
return len;
}
@ -195,26 +196,26 @@ static cell_t *evaluate1(cell_t *sp, float **fp) {
if (len == 0) { *++sp = 0; return sp; } // ignore empty
cell_t xt = find((const char *) name, len);
if (xt) {
if (g_sys.state && !(((cell_t *) xt)[-1] & IMMEDIATE)) {
*g_sys.heap++ = xt;
if (g_sys->state && !(((cell_t *) xt)[-1] & IMMEDIATE)) {
*g_sys->heap++ = xt;
} else {
call = xt;
}
} else {
cell_t n;
if (convert((const char *) name, len, g_sys.base, &n)) {
if (g_sys.state) {
*g_sys.heap++ = g_sys.DOLIT_XT;
*g_sys.heap++ = n;
if (convert((const char *) name, len, g_sys->base, &n)) {
if (g_sys->state) {
*g_sys->heap++ = g_sys->DOLIT_XT;
*g_sys->heap++ = n;
} else {
*++sp = n;
}
} else {
float f;
if (fconvert((const char *) name, len, &f)) {
if (g_sys.state) {
*g_sys.heap++ = g_sys.DOFLIT_XT;
*(float *) g_sys.heap++ = f;
if (g_sys->state) {
*g_sys->heap++ = g_sys->DOFLIT_XT;
*(float *) g_sys->heap++ = f;
} else {
*++(*fp) = f;
}
@ -227,7 +228,7 @@ static cell_t *evaluate1(cell_t *sp, float **fp) {
*++sp = name;
*++sp = len;
*++sp = -1;
call = g_sys.notfound;
call = g_sys->notfound;
}
}
}
@ -240,52 +241,56 @@ static cell_t *forth_run(cell_t *initrp);
static void forth_init(int argc, char *argv[],
void *heap, cell_t heap_size,
const char *src, cell_t src_len) {
g_sys.heap_start = (cell_t *) heap;
g_sys.heap_size = heap_size;
g_sys.stack_cells = STACK_CELLS;
g_sys.boot = src;
g_sys.boot_size = src_len;
g_sys = (G_SYS *) heap;
memset(g_sys, 0, sizeof(G_SYS));
g_sys->heap_start = (cell_t *) heap;
g_sys->heap_size = heap_size;
g_sys->stack_cells = STACK_CELLS;
g_sys->boot = src;
g_sys->boot_size = src_len;
g_sys.heap = g_sys.heap_start + 4; // Leave a little room.
float *fp = (float *) (g_sys.heap + 1); g_sys.heap += STACK_CELLS;
cell_t *rp = g_sys.heap + 1; g_sys.heap += STACK_CELLS;
cell_t *sp = g_sys.heap + 1; g_sys.heap += STACK_CELLS;
// Start heap after G_SYS area.
g_sys->heap = g_sys->heap_start + sizeof(G_SYS) / sizeof(cell_t);
g_sys->heap += 4; // Leave a little room.
float *fp = (float *) (g_sys->heap + 1); g_sys->heap += STACK_CELLS;
cell_t *rp = g_sys->heap + 1; g_sys->heap += STACK_CELLS;
cell_t *sp = g_sys->heap + 1; g_sys->heap += STACK_CELLS;
// FORTH worldlist (relocated when vocabularies added).
cell_t *forth_wordlist = g_sys.heap;
*g_sys.heap++ = 0;
cell_t *forth_wordlist = g_sys->heap;
*g_sys->heap++ = 0;
// Vocabulary stack
g_sys.current = (cell_t **) forth_wordlist;
g_sys.context = (cell_t ***) g_sys.heap;
g_sys.latestxt = 0;
*g_sys.heap++ = (cell_t) forth_wordlist;
for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys.heap++ = 0; }
g_sys->current = (cell_t **) forth_wordlist;
g_sys->context = (cell_t ***) g_sys->heap;
g_sys->latestxt = 0;
*g_sys->heap++ = (cell_t) forth_wordlist;
for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys->heap++ = 0; }
forth_run(0);
#define V(name) \
create(#name "-builtins", sizeof(#name "-builtins") - 1, \
BUILTIN_FORK, g_sys.DOCREATE_OP); \
*g_sys.heap++ = VOC_ ## name;
BUILTIN_FORK, g_sys->DOCREATE_OP); \
*g_sys->heap++ = VOC_ ## name;
VOCABULARY_LIST
#undef V
g_sys.latestxt = 0; // So last builtin doesn't get wrong size.
g_sys.DOLIT_XT = FIND("DOLIT");
g_sys.DOFLIT_XT = FIND("DOFLIT");
g_sys.DOEXIT_XT = FIND("EXIT");
g_sys.YIELD_XT = FIND("YIELD");
g_sys.notfound = FIND("DROP");
cell_t *start = g_sys.heap;
*g_sys.heap++ = FIND("EVALUATE1");
*g_sys.heap++ = FIND("BRANCH");
*g_sys.heap++ = (cell_t) start;
g_sys.argc = argc;
g_sys.argv = argv;
g_sys.base = 10;
g_sys.tib = src;
g_sys.ntib = src_len;
g_sys->latestxt = 0; // So last builtin doesn't get wrong size.
g_sys->DOLIT_XT = FIND("DOLIT");
g_sys->DOFLIT_XT = FIND("DOFLIT");
g_sys->DOEXIT_XT = FIND("EXIT");
g_sys->YIELD_XT = FIND("YIELD");
g_sys->notfound = FIND("DROP");
cell_t *start = g_sys->heap;
*g_sys->heap++ = FIND("EVALUATE1");
*g_sys->heap++ = FIND("BRANCH");
*g_sys->heap++ = (cell_t) start;
g_sys->argc = argc;
g_sys->argv = argv;
g_sys->base = 10;
g_sys->tib = src;
g_sys->ntib = src_len;
*++rp = (cell_t) fp;
*++rp = (cell_t) sp;
*++rp = (cell_t) start;
g_sys.rp = rp;
g_sys.runner = forth_run;
g_sys->rp = rp;
g_sys->runner = forth_run;
}