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;
}

46
common/extra_opcodes.h
View File

@ -58,10 +58,10 @@
Y(min, tos = tos < *sp ? tos : *sp; NIP) \
Y(max, tos = tos > *sp ? tos : *sp; NIP) \
Y(abs, tos = tos < 0 ? -tos : tos) \
Y(here, DUP; tos = (cell_t) g_sys.heap) \
Y(allot, g_sys.heap = (cell_t *) (tos + (cell_t) g_sys.heap); DROP) \
Y(here, DUP; tos = (cell_t) g_sys->heap) \
Y(allot, g_sys->heap = (cell_t *) (tos + (cell_t) g_sys->heap); DROP) \
Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap)) \
Y(align, g_sys->heap = (cell_t *) CELL_ALIGNED(g_sys->heap)) \
XV(forth, ",", COMMA, COMMA(tos); DROP) \
XV(forth, "c,", CCOMMA, CCOMMA(tos); DROP) \
X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
@ -71,26 +71,26 @@
X(">link", TOLINK, tos = *TOLINK(tos)) \
X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
X(">body", TOBODY, tos = (cell_t) TOBODY(tos)) \
XV(internals, "'heap", THEAP, DUP; tos = (cell_t) &g_sys.heap) \
Y(current, DUP; tos = (cell_t) &g_sys.current) \
XV(internals, "'context", TCONTEXT, DUP; tos = (cell_t) &g_sys.context) \
XV(internals, "'latestxt", TLATESTXT, DUP; tos = (cell_t) &g_sys.latestxt) \
XV(internals, "'notfound", TNOTFOUND, DUP; tos = (cell_t) &g_sys.notfound) \
XV(internals, "'heap-start", THEAP_START, DUP; tos = (cell_t) &g_sys.heap_start) \
XV(internals, "'heap-size", THEAP_SIZE, DUP; tos = (cell_t) &g_sys.heap_size) \
XV(internals, "'stack-cells", TSTACK_CELLS, DUP; tos = (cell_t) &g_sys.stack_cells) \
XV(internals, "'boot", TBOOT, DUP; tos = (cell_t) &g_sys.boot) \
XV(internals, "'boot-size", TBOOT_SIZE, DUP; tos = (cell_t) &g_sys.boot_size) \
XV(internals, "'tib", TTIB, DUP; tos = (cell_t) &g_sys.tib) \
X("#tib", NTIB, DUP; tos = (cell_t) &g_sys.ntib) \
X(">in", TIN, DUP; tos = (cell_t) &g_sys.tin) \
Y(state, DUP; tos = (cell_t) &g_sys.state) \
Y(base, DUP; tos = (cell_t) &g_sys.base) \
XV(internals, "'argc", ARGC, DUP; tos = (cell_t) &g_sys.argc) \
XV(internals, "'argv", ARGV, DUP; tos = (cell_t) &g_sys.argv) \
XV(internals, "'runner", RUNNER, DUP; tos = (cell_t) &g_sys.runner) \
XV(internals, "'heap", THEAP, DUP; tos = (cell_t) &g_sys->heap) \
Y(current, DUP; tos = (cell_t) &g_sys->current) \
XV(internals, "'context", TCONTEXT, DUP; tos = (cell_t) &g_sys->context) \
XV(internals, "'latestxt", TLATESTXT, DUP; tos = (cell_t) &g_sys->latestxt) \
XV(internals, "'notfound", TNOTFOUND, DUP; tos = (cell_t) &g_sys->notfound) \
XV(internals, "'heap-start", THEAP_START, DUP; tos = (cell_t) &g_sys->heap_start) \
XV(internals, "'heap-size", THEAP_SIZE, DUP; tos = (cell_t) &g_sys->heap_size) \
XV(internals, "'stack-cells", TSTACK_CELLS, DUP; tos = (cell_t) &g_sys->stack_cells) \
XV(internals, "'boot", TBOOT, DUP; tos = (cell_t) &g_sys->boot) \
XV(internals, "'boot-size", TBOOT_SIZE, DUP; tos = (cell_t) &g_sys->boot_size) \
XV(internals, "'tib", TTIB, DUP; tos = (cell_t) &g_sys->tib) \
X("#tib", NTIB, DUP; tos = (cell_t) &g_sys->ntib) \
X(">in", TIN, DUP; tos = (cell_t) &g_sys->tin) \
Y(state, DUP; tos = (cell_t) &g_sys->state) \
Y(base, DUP; tos = (cell_t) &g_sys->base) \
XV(internals, "'argc", ARGC, DUP; tos = (cell_t) &g_sys->argc) \
XV(internals, "'argv", ARGV, DUP; tos = (cell_t) &g_sys->argv) \
XV(internals, "'runner", RUNNER, DUP; tos = (cell_t) &g_sys->runner) \
YV(internals, fill32, cell_t c = tos; DROP; cell_t n = tos; DROP; \
uint32_t *a = (uint32_t *) tos; DROP; \
for (;n;--n) *a++ = c) \
Y(context, DUP; tos = (cell_t) (g_sys.context + 1)) \
Y(latestxt, DUP; tos = (cell_t) g_sys.latestxt)
Y(context, DUP; tos = (cell_t) (g_sys->context + 1)) \
Y(latestxt, DUP; tos = (cell_t) g_sys->latestxt)

4
common/interp.h
View File

@ -29,8 +29,8 @@ static cell_t *forth_run(cell_t *init_rp) {
};
if (!init_rp) {
g_sys.DOCREATE_OP = ADDROF(DOCREATE);
g_sys.builtins = builtins;
g_sys->DOCREATE_OP = ADDROF(DOCREATE);
g_sys->builtins = builtins;
return 0;
}
register cell_t *ip, *rp, *sp, tos, w;

23
common/opcodes.h
View File

@ -30,9 +30,10 @@ typedef uintptr_t ucell_t;
#define DROPn(n) (NIPn(n-1), DROP)
#define DUP (*++sp = tos)
#define PUSH DUP; tos = (cell_t)
#define COMMA(n) *g_sys.heap++ = (n)
#define CCOMMA(n) *(uint8_t *) g_sys.heap = (n); g_sys.heap = (cell_t *) (1 + ((cell_t) g_sys.heap));
#define DOES(ip) **g_sys.current = (cell_t) ADDROF(DODOES); (*g_sys.current)[1] = (cell_t) ip
#define COMMA(n) *g_sys->heap++ = (n)
#define CCOMMA(n) *(uint8_t *) g_sys->heap = (n); \
g_sys->heap = (cell_t *) (1 + ((cell_t) g_sys->heap));
#define DOES(ip) **g_sys->current = (cell_t) ADDROF(DODOES); (*g_sys->current)[1] = (cell_t) ip
#define PARK DUP; *++rp = (cell_t) fp; *++rp = (cell_t) sp; *++rp = (cell_t) ip
#define UNPARK ip = (cell_t *) *rp--; sp = (cell_t *) *rp--; fp = (float *) *rp--; DROP
@ -47,8 +48,8 @@ typedef uintptr_t ucell_t;
#define TOBODY(xt) (((cell_t *) xt) + ((void *) *((cell_t *) xt) == ADDROF(DOCREATE) || \
(void *) *((cell_t *) xt) == ADDROF(DODOES) ? 2 : 1))
#define DOIMMEDIATE() *TOFLAGS(*g_sys.current) |= IMMEDIATE
#define UNSMUDGE() *TOFLAGS(*g_sys.current) &= ~SMUDGE; finish()
#define DOIMMEDIATE() *TOFLAGS(*g_sys->current) |= IMMEDIATE
#define UNSMUDGE() *TOFLAGS(*g_sys->current) &= ~SMUDGE; finish()
#ifndef SSMOD_FUNC
# if __SIZEOF_POINTER__ == 8
@ -122,13 +123,13 @@ typedef struct {
YV(internals, DODOES, DUP; tos = w + sizeof(cell_t) * 2; \
++rp; *rp = (cell_t) ip; \
ip = (cell_t *) *(cell_t *) (w + sizeof(cell_t))) \
YV(internals, ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
YV(internals, ALITERAL, COMMA(g_sys->DOLIT_XT); COMMA(tos); DROP) \
Y(CELL, DUP; tos = sizeof(cell_t)) \
XV(internals, "LONG-SIZE", LONG_SIZE, DUP; tos = sizeof(long)) \
Y(FIND, tos = find((const char *) *sp, tos); --sp) \
Y(PARSE, DUP; tos = parse(tos, sp)) \
XV(internals, "S>NUMBER?", \
CONVERT, tos = convert((const char *) *sp, tos, g_sys.base, sp); \
CONVERT, tos = convert((const char *) *sp, tos, g_sys->base, sp); \
if (!tos) --sp) \
Y(CREATE, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, 0, ADDROF(DOCREATE)); \
@ -141,14 +142,14 @@ typedef struct {
DROPn(2); COMMA(tos); DROP) \
X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
Y(IMMEDIATE, DOIMMEDIATE()) \
XV(internals, "'SYS", SYS, DUP; tos = (cell_t) &g_sys) \
XV(internals, "'SYS", SYS, DUP; tos = (cell_t) g_sys) \
YV(internals, YIELD, PARK; return rp) \
X(":", COLON, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, SMUDGE, ADDROF(DOCOL)); \
g_sys.state = -1; --sp; DROP) \
g_sys->state = -1; --sp; DROP) \
YV(internals, EVALUATE1, DUP; float *tfp = fp; \
sp = evaluate1(sp, &tfp); \
fp = tfp; w = *sp--; DROP; if (w) JMPW) \
Y(EXIT, ip = (cell_t *) *rp--) \
XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) &g_sys.builtins->code) \
XV(forth_immediate, ";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)
XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) &g_sys->builtins->code) \
XV(forth_immediate, ";", SEMICOLON, COMMA(g_sys->DOEXIT_XT); UNSMUDGE(); g_sys->state = 0)

2
esp32/main.cpp
View File

@ -23,5 +23,5 @@ void setup() {
}
void loop() {
g_sys.rp = forth_run(g_sys.rp);
g_sys->rp = forth_run(g_sys->rp);
}

2
posix/main.c
View File

@ -41,6 +41,6 @@ int main(int argc, char *argv[]) {
(void *) 0x8000000, HEAP_SIZE,
PROT_EXEC | PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
forth_init(argc, argv, heap, HEAP_SIZE, boot, sizeof(boot));
for (;;) { g_sys.rp = forth_run(g_sys.rp); }
for (;;) { g_sys->rp = forth_run(g_sys->rp); }
return 1;
}

4
windows/interp.h
View File

@ -37,8 +37,8 @@ static cell_t *forth_run(cell_t *init_rp) {
};
if (!init_rp) {
g_sys.DOCREATE_OP = ADDROF(DOCREATE);
g_sys.builtins = builtins;
g_sys->DOCREATE_OP = ADDROF(DOCREATE);
g_sys->builtins = builtins;
return 0;
}
register cell_t *ip, *rp, *sp, tos, w;

2
windows/main.c
View File

@ -89,6 +89,6 @@ int WINAPI WinMain(HINSTANCE inst, HINSTANCE prev, LPSTR cmd, int show) {
(void *) 0x8000000, HEAP_SIZE,
MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE);
forth_init(0, 0, heap, HEAP_SIZE, boot, sizeof(boot));
for (;;) { g_sys.rp = forth_run(g_sys.rp); }
for (;;) { g_sys->rp = forth_run(g_sys->rp); }
}