From 169249ff92d9a563a343b2d862dfcba23eccc777 Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Tue, 10 Dec 2024 16:00:04 +0100 Subject: [PATCH 1/8] Added VM context `zf_ctx` to allow multiple instances of the forth interpreter to be exist at the same time. --- src/atmega8/main.c | 20 +- src/linux/main.c | 56 ++--- src/zforth/zforth.c | 557 +++++++++++++++++++++----------------------- src/zforth/zforth.h | 44 ++-- 4 files changed, 342 insertions(+), 335 deletions(-) diff --git a/src/atmega8/main.c b/src/atmega8/main.c index cb5d9a3..55811c1 100644 --- a/src/atmega8/main.c +++ b/src/atmega8/main.c @@ -31,12 +31,14 @@ int main(void) uart_init(UART_BAUD(9600)); stdout = stdin = &f; + zf_ctx _ctx; + zf_ctx *ctx = &_ctx; /* Initialize zforth */ - zf_init(1); - zf_bootstrap(); - zf_eval(": . 1 sys ;"); + zf_init(ctx, 1); + zf_bootstrap(ctx); + zf_eval(ctx, ": . 1 sys ;"); /* Main loop: read words and eval */ @@ -47,7 +49,7 @@ int main(void) int c = getchar(); putchar(c); if(c == 10 || c == 13 || c == 32) { - zf_result r = zf_eval(buf); + zf_result r = zf_eval(ctx, buf); if(r != ZF_OK) puts("A"); l = 0; } else if(l < sizeof(buf)-1) { @@ -60,19 +62,19 @@ int main(void) } -zf_input_state zf_host_sys(zf_syscall_id id, const char *input) +zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input) { char buf[16]; switch((int)id) { case ZF_SYSCALL_EMIT: - putchar((char)zf_pop()); + putchar((char)zf_pop(ctx)); fflush(stdout); break; case ZF_SYSCALL_PRINT: - itoa(zf_pop(), buf, 10); + itoa(zf_pop(ctx), buf, 10); puts(buf); break; } @@ -81,12 +83,12 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input) } -zf_cell zf_host_parse_num(const char *buf) +zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf) { char *end; zf_cell v = strtol(buf, &end, 0); if(*end != '\0') { - zf_abort(ZF_ABORT_NOT_A_WORD); + zf_abort(ctx, ZF_ABORT_NOT_A_WORD); } return v; } diff --git a/src/linux/main.c b/src/linux/main.c index dbb44c9..f4e43c7 100644 --- a/src/linux/main.c +++ b/src/linux/main.c @@ -20,11 +20,11 @@ * Evaluate buffer with code, check return value and report errors */ -zf_result do_eval(const char *src, int line, const char *buf) +zf_result do_eval(zf_ctx *ctx, const char *src, int line, const char *buf) { const char *msg = NULL; - zf_result rv = zf_eval(buf); + zf_result rv = zf_eval(ctx, buf); switch(rv) { @@ -56,7 +56,7 @@ zf_result do_eval(const char *src, int line, const char *buf) * Load given forth file */ -void include(const char *fname) +void include(zf_ctx *ctx, const char *fname) { char buf[256]; @@ -64,7 +64,7 @@ void include(const char *fname) int line = 1; if(f) { while(fgets(buf, sizeof(buf), f)) { - do_eval(fname, line++, buf); + do_eval(ctx, fname, line++, buf); } fclose(f); } else { @@ -77,10 +77,10 @@ void include(const char *fname) * Save dictionary */ -static void save(const char *fname) +static void save(zf_ctx *ctx, const char *fname) { size_t len; - void *p = zf_dump(&len); + void *p = zf_dump(ctx, &len); FILE *f = fopen(fname, "wb"); if(f) { fwrite(p, 1, len, f); @@ -93,10 +93,10 @@ static void save(const char *fname) * Load dictionary */ -static void load(const char *fname) +static void load(zf_ctx *ctx, const char *fname) { size_t len; - void *p = zf_dump(&len); + void *p = zf_dump(ctx, &len); FILE *f = fopen(fname, "rb"); if(f) { fread(p, 1, len, f); @@ -111,7 +111,7 @@ static void load(const char *fname) * Sys callback function */ -zf_input_state zf_host_sys(zf_syscall_id id, const char *input) +zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input) { switch((int)id) { @@ -119,21 +119,21 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input) /* The core system callbacks */ case ZF_SYSCALL_EMIT: - putchar((char)zf_pop()); + putchar((char)zf_pop(ctx)); fflush(stdout); break; case ZF_SYSCALL_PRINT: - printf(ZF_CELL_FMT " ", zf_pop()); + printf(ZF_CELL_FMT " ", zf_pop(ctx)); break; case ZF_SYSCALL_TELL: { - zf_cell len = zf_pop(); - zf_cell addr = zf_pop(); + zf_cell len = zf_pop(ctx); + zf_cell addr = zf_pop(ctx); if(addr >= ZF_DICT_SIZE - len) { - zf_abort(ZF_ABORT_OUTSIDE_MEM); + zf_abort(ctx, ZF_ABORT_OUTSIDE_MEM); } - void *buf = (uint8_t *)zf_dump(NULL) + (int)addr; + void *buf = (uint8_t *)zf_dump(ctx, NULL) + (int)addr; (void)fwrite(buf, 1, len, stdout); fflush(stdout); } break; @@ -147,18 +147,18 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input) break; case ZF_SYSCALL_USER + 1: - zf_push(sin(zf_pop())); + zf_push(ctx, sin(zf_pop(ctx))); break; case ZF_SYSCALL_USER + 2: if(input == NULL) { return ZF_INPUT_PASS_WORD; } - include(input); + include(ctx, input); break; case ZF_SYSCALL_USER + 3: - save("zforth.save"); + save(ctx, "zforth.save"); break; default: @@ -174,7 +174,7 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input) * Tracing output */ -void zf_host_trace(const char *fmt, va_list va) +void zf_host_trace(zf_ctx *ctx, const char *fmt, va_list va) { fprintf(stderr, "\033[1;30m"); vfprintf(stderr, fmt, va); @@ -186,13 +186,13 @@ void zf_host_trace(const char *fmt, va_list va) * Parse number */ -zf_cell zf_host_parse_num(const char *buf) +zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf) { zf_cell v; int n = 0; int r = sscanf(buf, ZF_SCAN_FMT"%n", &v, &n); if(r != 1 || buf[n] != '\0') { - zf_abort(ZF_ABORT_NOT_A_WORD); + zf_abort(ctx, ZF_ABORT_NOT_A_WORD); } return v; } @@ -247,31 +247,33 @@ int main(int argc, char **argv) argc -= optind; argv += optind; + zf_ctx *ctx = malloc(sizeof(zf_ctx)); + printf("%p\n", (void *)ctx); /* Initialize zforth */ - zf_init(trace); + zf_init(ctx, trace); /* Load dict from disk if requested, otherwise bootstrap fort * dictionary */ if(fname_load) { - load(fname_load); + load(ctx, fname_load); } else { - zf_bootstrap(); + zf_bootstrap(ctx); } /* Include files from command line */ for(i=0; i 0) { - do_eval("stdin", ++line, buf); + do_eval(ctx, "stdin", ++line, buf); printf("\n"); add_history(buf); diff --git a/src/zforth/zforth.c b/src/zforth/zforth.c index 32456d6..0bce1af 100644 --- a/src/zforth/zforth.c +++ b/src/zforth/zforth.c @@ -17,9 +17,9 @@ * is set to 0, the boundary check code will not be compiled in to reduce size */ #if ZF_ENABLE_BOUNDARY_CHECKS -#define CHECK(exp, abort) if(!(exp)) zf_abort(abort); +#define CHECK(ctx, exp, abort) if(!(exp)) zf_abort(ctx, abort); #else -#define CHECK(exp, abort) +#define CHECK(ctx, exp, abort) #endif typedef enum { @@ -61,46 +61,30 @@ static const char prim_names[] = _("##") _("&") _("|") _("^") _("<<") _(">>"); -/* Stacks and dictionary memory */ - -static zf_cell rstack[ZF_RSTACK_SIZE]; -static zf_cell dstack[ZF_DSTACK_SIZE]; -static uint8_t dict[ZF_DICT_SIZE]; - -/* State and stack and interpreter pointers */ - -static zf_input_state input_state; -static zf_addr ip; - -/* setjmp env for handling aborts */ - -static jmp_buf jmpbuf; - /* User variables are variables which are shared between forth and C. From * forth these can be accessed with @ and ! at pseudo-indices in low memory, in * C they are stored in an array of zf_addr with friendly reference names * through some macros */ -#define HERE uservar[ZF_USERVAR_HERE] /* compilation pointer in dictionary */ -#define LATEST uservar[ZF_USERVAR_LATEST] /* pointer to last compiled word */ -#define TRACE uservar[ZF_USERVAR_TRACE] /* trace enable flag */ -#define COMPILING uservar[ZF_USERVAR_COMPILING] /* compiling flag */ -#define POSTPONE uservar[ZF_USERVAR_POSTPONE] /* flag to indicate next imm word should be compiled */ -#define DSP uservar[ZF_USERVAR_DSP] /* data stack pointer */ -#define RSP uservar[ZF_USERVAR_RSP] /* return stack pointer */ +#define HERE(ctx) ctx->uservar[ZF_USERVAR_HERE] /* compilation pointer in dictionary */ +#define LATEST(ctx) ctx->uservar[ZF_USERVAR_LATEST] /* pointer to last compiled word */ +#define TRACE(ctx) ctx->uservar[ZF_USERVAR_TRACE] /* trace enable flag */ +#define COMPILING(ctx) ctx->uservar[ZF_USERVAR_COMPILING] /* compiling flag */ +#define POSTPONE(ctx) ctx->uservar[ZF_USERVAR_POSTPONE] /* flag to indicate next imm word should be compiled */ +#define DSP(ctx) ctx->uservar[ZF_USERVAR_DSP] /* data stack pointer */ +#define RSP(ctx) ctx->uservar[ZF_USERVAR_RSP] /* return stack pointer */ static const char uservar_names[] = _("h") _("latest") _("trace") _("compiling") _("_postpone") _("dsp") _("rsp"); -static zf_addr *uservar = (zf_addr *)dict; /* Prototypes */ -static void do_prim(zf_prim prim, const char *input); -static zf_addr dict_get_cell(zf_addr addr, zf_cell *v); -static void dict_get_bytes(zf_addr addr, void *buf, size_t len); +static void do_prim(zf_ctx *ctx, zf_prim prim, const char *input); +static zf_addr dict_get_cell(zf_ctx *ctx, zf_addr addr, zf_cell *v); +static void dict_get_bytes(zf_ctx *ctx, zf_addr addr, void *buf, size_t len); /* Tracing functions. If disabled, the trace() function is replaced by an empty @@ -109,37 +93,37 @@ static void dict_get_bytes(zf_addr addr, void *buf, size_t len); #if ZF_ENABLE_TRACE -static void do_trace(const char *fmt, ...) +static void do_trace(zf_ctx *ctx, const char *fmt, ...) { - if(TRACE) { + if(TRACE(ctx)) { va_list va; va_start(va, fmt); - zf_host_trace(fmt, va); + zf_host_trace(ctx, fmt, va); va_end(va); } } -#define trace(...) if(TRACE) do_trace(__VA_ARGS__) +#define trace(ctx, ...) if(TRACE(ctx)) do_trace(ctx, __VA_ARGS__) -static const char *op_name(zf_addr addr) +static const char *op_name(zf_ctx *ctx, zf_addr addr) { - zf_addr w = LATEST; + zf_addr w = LATEST(ctx); static char name[32]; - while(TRACE && w) { + while(TRACE(ctx) && w) { zf_addr xt, p = w; zf_cell d, link, op2; int lenflags; - p += dict_get_cell(p, &d); + p += dict_get_cell(ctx, p, &d); lenflags = d; - p += dict_get_cell(p, &link); + p += dict_get_cell(ctx, p, &link); xt = p + ZF_FLAG_LEN(lenflags); - dict_get_cell(xt, &op2); + dict_get_cell(ctx, xt, &op2); if(((lenflags & ZF_FLAG_PRIM) && addr == (zf_addr)op2) || addr == w || addr == xt) { int l = ZF_FLAG_LEN(lenflags); - dict_get_bytes(p, name, l); + dict_get_bytes(ctx, p, name, l); name[l] = '\0'; return name; } @@ -150,8 +134,8 @@ static const char *op_name(zf_addr addr) } #else -static void trace(const char *fmt, ...) { } -static const char *op_name(zf_addr addr) { return NULL; } +static void trace(zf_ctx *ctx, const char *fmt, ...) { } +static const char *op_name(zf_ctx *ctx, zf_addr addr) { return NULL; } #endif @@ -160,9 +144,9 @@ static const char *op_name(zf_addr addr) { return NULL; } * zf_eval() */ -void zf_abort(zf_result reason) +void zf_abort(zf_ctx *ctx, zf_result reason) { - longjmp(jmpbuf, reason); + longjmp(ctx->jmpbuf, reason); } @@ -171,52 +155,52 @@ void zf_abort(zf_result reason) * Stack operations. */ -void zf_push(zf_cell v) +void zf_push(zf_ctx *ctx, zf_cell v) { - CHECK(DSP < ZF_DSTACK_SIZE, ZF_ABORT_DSTACK_OVERRUN); - trace("»" ZF_CELL_FMT " ", v); - dstack[DSP++] = v; + CHECK(ctx, DSP(ctx) < ZF_DSTACK_SIZE, ZF_ABORT_DSTACK_OVERRUN); + trace(ctx, "»" ZF_CELL_FMT " ", v); + ctx->dstack[DSP(ctx)++] = v; } -zf_cell zf_pop(void) +zf_cell zf_pop(zf_ctx *ctx) { zf_cell v; - CHECK(DSP > 0, ZF_ABORT_DSTACK_UNDERRUN); - v = dstack[--DSP]; - trace("«" ZF_CELL_FMT " ", v); + CHECK(ctx, DSP(ctx) > 0, ZF_ABORT_DSTACK_UNDERRUN); + v = ctx->dstack[--DSP(ctx)]; + trace(ctx, "«" ZF_CELL_FMT " ", v); return v; } -zf_cell zf_pick(zf_addr n) +zf_cell zf_pick(zf_ctx *ctx, zf_addr n) { - CHECK(n < DSP, ZF_ABORT_DSTACK_UNDERRUN); - return dstack[DSP-n-1]; + CHECK(ctx, n < DSP(ctx), ZF_ABORT_DSTACK_UNDERRUN); + return ctx->dstack[DSP(ctx)-n-1]; } -static void zf_pushr(zf_cell v) +static void zf_pushr(zf_ctx *ctx, zf_cell v) { - CHECK(RSP < ZF_RSTACK_SIZE, ZF_ABORT_RSTACK_OVERRUN); - trace("r»" ZF_CELL_FMT " ", v); - rstack[RSP++] = v; + CHECK(ctx, RSP(ctx) < ZF_RSTACK_SIZE, ZF_ABORT_RSTACK_OVERRUN); + trace(ctx, "r»" ZF_CELL_FMT " ", v); + ctx->rstack[RSP(ctx)++] = v; } -static zf_cell zf_popr(void) +static zf_cell zf_popr(zf_ctx *ctx) { zf_cell v; - CHECK(RSP > 0, ZF_ABORT_RSTACK_UNDERRUN); - v = rstack[--RSP]; - trace("r«" ZF_CELL_FMT " ", v); + CHECK(ctx, RSP(ctx) > 0, ZF_ABORT_RSTACK_UNDERRUN); + v = ctx->rstack[--RSP(ctx)]; + trace(ctx, "r«" ZF_CELL_FMT " ", v); return v; } -zf_cell zf_pickr(zf_addr n) +zf_cell zf_pickr(zf_ctx *ctx, zf_addr n) { - CHECK(n < RSP, ZF_ABORT_RSTACK_UNDERRUN); - return rstack[RSP-n-1]; + CHECK(ctx, n < RSP(ctx), ZF_ABORT_RSTACK_UNDERRUN); + return ctx->rstack[RSP(ctx)-n-1]; } @@ -225,21 +209,21 @@ zf_cell zf_pickr(zf_addr n) * All access to dictionary memory is done through these functions. */ -static zf_addr dict_put_bytes(zf_addr addr, const void *buf, size_t len) +static zf_addr dict_put_bytes(zf_ctx *ctx, zf_addr addr, const void *buf, size_t len) { const uint8_t *p = (const uint8_t *)buf; size_t i = len; - CHECK(addr < ZF_DICT_SIZE-len, ZF_ABORT_OUTSIDE_MEM); - while(i--) dict[addr++] = *p++; + CHECK(ctx, addr < ZF_DICT_SIZE-len, ZF_ABORT_OUTSIDE_MEM); + while(i--) ctx->dict[addr++] = *p++; return len; } -static void dict_get_bytes(zf_addr addr, void *buf, size_t len) +static void dict_get_bytes(zf_ctx *ctx, zf_addr addr, void *buf, size_t len) { uint8_t *p = (uint8_t *)buf; - CHECK(addr < ZF_DICT_SIZE-len, ZF_ABORT_OUTSIDE_MEM); - while(len--) *p++ = dict[addr++]; + CHECK(ctx, addr < ZF_DICT_SIZE-len, ZF_ABORT_OUTSIDE_MEM); + while(len--) *p++ = ctx->dict[addr++]; } @@ -254,41 +238,41 @@ static void dict_get_bytes(zf_addr addr, void *buf, size_t len) */ #if ZF_ENABLE_TYPED_MEM_ACCESS -#define GET(s, t) if(size == s) { t v ## t; dict_get_bytes(addr, &v ## t, sizeof(t)); *v = v ## t; return sizeof(t); }; -#define PUT(s, t, val) if(size == s) { t v ## t = val; return dict_put_bytes(addr, &v ## t, sizeof(t)); } +#define GET(s, t) if(size == s) { t v ## t; dict_get_bytes(ctx, addr, &v ## t, sizeof(t)); *v = v ## t; return sizeof(t); }; +#define PUT(s, t, val) if(size == s) { t v ## t = val; return dict_put_bytes(ctx, addr, &v ## t, sizeof(t)); } #else #define GET(s, t) #define PUT(s, t, val) #endif -static zf_addr dict_put_cell_typed(zf_addr addr, zf_cell v, zf_mem_size size) +static zf_addr dict_put_cell_typed(zf_ctx *ctx, zf_addr addr, zf_cell v, zf_mem_size size) { unsigned int vi = v; uint8_t t[2]; - trace("\n+" ZF_ADDR_FMT " " ZF_ADDR_FMT, addr, (zf_addr)v); + trace(ctx, "\n+" ZF_ADDR_FMT " " ZF_ADDR_FMT, addr, (zf_addr)v); if(size == ZF_MEM_SIZE_VAR) { if((v - vi) == 0) { if(vi < 128) { - trace(" ¹"); + trace(ctx, " ¹"); t[0] = vi; - return dict_put_bytes(addr, t, 1); + return dict_put_bytes(ctx, addr, t, 1); } if(vi < 16384) { - trace(" ²"); + trace(ctx, " ²"); t[0] = (vi >> 8) | 0x80; t[1] = vi; - return dict_put_bytes(addr, t, sizeof(t)); + return dict_put_bytes(ctx, addr, t, sizeof(t)); } } } if(size == ZF_MEM_SIZE_VAR || size == ZF_MEM_SIZE_VAR_MAX) { - trace(" ⁵"); + trace(ctx, " ⁵"); t[0] = 0xff; - return dict_put_bytes(addr+0, t, 1) + - dict_put_bytes(addr+1, &v, sizeof(v)); + return dict_put_bytes(ctx, addr+0, t, 1) + + dict_put_bytes(ctx, addr+1, &v, sizeof(v)); } PUT(ZF_MEM_SIZE_CELL, zf_cell, v); @@ -299,20 +283,20 @@ static zf_addr dict_put_cell_typed(zf_addr addr, zf_cell v, zf_mem_size size) PUT(ZF_MEM_SIZE_S16, int16_t, vi); PUT(ZF_MEM_SIZE_S32, int32_t, vi); - zf_abort(ZF_ABORT_INVALID_SIZE); + zf_abort(ctx, ZF_ABORT_INVALID_SIZE); return 0; } -static zf_addr dict_get_cell_typed(zf_addr addr, zf_cell *v, zf_mem_size size) +static zf_addr dict_get_cell_typed(zf_ctx *ctx, zf_addr addr, zf_cell *v, zf_mem_size size) { uint8_t t[2]; - dict_get_bytes(addr, t, sizeof(t)); + dict_get_bytes(ctx, addr, t, sizeof(t)); if(size == ZF_MEM_SIZE_VAR) { if(t[0] & 0x80) { if(t[0] == 0xff) { - dict_get_bytes(addr+1, v, sizeof(*v)); + dict_get_bytes(ctx, addr+1, v, sizeof(*v)); return 1 + sizeof(*v); } else { *v = ((t[0] & 0x3f) << 8) + t[1]; @@ -332,7 +316,7 @@ static zf_addr dict_get_cell_typed(zf_addr addr, zf_cell *v, zf_mem_size size) GET(ZF_MEM_SIZE_S16, int16_t); GET(ZF_MEM_SIZE_S32, int32_t); - zf_abort(ZF_ABORT_INVALID_SIZE); + zf_abort(ctx, ZF_ABORT_INVALID_SIZE); return 0; } @@ -341,73 +325,73 @@ static zf_addr dict_get_cell_typed(zf_addr addr, zf_cell *v, zf_mem_size size) * Shortcut functions for cell access with variable cell size */ -static zf_addr dict_put_cell(zf_addr addr, zf_cell v) +static zf_addr dict_put_cell(zf_ctx *ctx, zf_addr addr, zf_cell v) { - return dict_put_cell_typed(addr, v, ZF_MEM_SIZE_VAR); + return dict_put_cell_typed(ctx, addr, v, ZF_MEM_SIZE_VAR); } -static zf_addr dict_get_cell(zf_addr addr, zf_cell *v) +static zf_addr dict_get_cell(zf_ctx *ctx, zf_addr addr, zf_cell *v) { - return dict_get_cell_typed(addr, v, ZF_MEM_SIZE_VAR); + return dict_get_cell_typed(ctx, addr, v, ZF_MEM_SIZE_VAR); } /* - * Generic dictionary adding, these functions all add at the HERE pointer and + * Generic dictionary adding, these functions all add at the HERE(ctx) pointer and * increase the pointer */ -static void dict_add_cell_typed(zf_cell v, zf_mem_size size) +static void dict_add_cell_typed(zf_ctx *ctx, zf_cell v, zf_mem_size size) { - HERE += dict_put_cell_typed(HERE, v, size); - trace(" "); + HERE(ctx) += dict_put_cell_typed(ctx, HERE(ctx), v, size); + trace(ctx, " "); } -static void dict_add_cell(zf_cell v) +static void dict_add_cell(zf_ctx *ctx, zf_cell v) { - dict_add_cell_typed(v, ZF_MEM_SIZE_VAR); + dict_add_cell_typed(ctx, v, ZF_MEM_SIZE_VAR); } -static void dict_add_op(zf_addr op) +static void dict_add_op(zf_ctx *ctx, zf_addr op) { - dict_add_cell(op); - trace("+%s ", op_name(op)); + dict_add_cell(ctx, op); + trace(ctx, "+%s ", op_name(ctx, op)); } -static void dict_add_lit(zf_cell v) +static void dict_add_lit(zf_ctx *ctx, zf_cell v) { - dict_add_op(PRIM_LIT); - dict_add_cell(v); + dict_add_op(ctx, PRIM_LIT); + dict_add_cell(ctx, v); } -static void dict_add_str(const char *s) +static void dict_add_str(zf_ctx *ctx, const char *s) { size_t l; - trace("\n+" ZF_ADDR_FMT " " ZF_ADDR_FMT " s '%s'", HERE, 0, s); + trace(ctx, "\n+" ZF_ADDR_FMT " " ZF_ADDR_FMT " s '%s'", HERE(ctx), 0, s); l = strlen(s); - HERE += dict_put_bytes(HERE, s, l); + HERE(ctx) += dict_put_bytes(ctx, HERE(ctx), s, l); } /* - * Create new word, adjusting HERE and LATEST accordingly + * Create new word, adjusting HERE(ctx) and LATEST(ctx) accordingly */ -static void create(const char *name, int flags) +static void create(zf_ctx *ctx, const char *name, int flags) { zf_addr here_prev; - trace("\n=== create '%s'", name); - here_prev = HERE; - dict_add_cell((strlen(name)) | flags); - dict_add_cell(LATEST); - dict_add_str(name); - LATEST = here_prev; - trace("\n==="); + trace(ctx, "\n=== create '%s'", name); + here_prev = HERE(ctx); + dict_add_cell(ctx, (strlen(name)) | flags); + dict_add_cell(ctx, LATEST(ctx)); + dict_add_str(ctx, name); + LATEST(ctx) = here_prev; + trace(ctx, "\n==="); } @@ -415,20 +399,20 @@ static void create(const char *name, int flags) * Find word in dictionary, returning address and execution token */ -static int find_word(const char *name, zf_addr *word, zf_addr *code) +static int find_word(zf_ctx *ctx, const char *name, zf_addr *word, zf_addr *code) { - zf_addr w = LATEST; + zf_addr w = LATEST(ctx); size_t namelen = strlen(name); while(w) { zf_cell link, d; zf_addr p = w; size_t len; - p += dict_get_cell(p, &d); - p += dict_get_cell(p, &link); + p += dict_get_cell(ctx, p, &d); + p += dict_get_cell(ctx, p, &link); len = ZF_FLAG_LEN((int)d); if(len == namelen) { - const char *name2 = (const char *)&dict[p]; + const char *name2 = (const char *)&ctx->dict[p]; if(memcmp(name, name2, len) == 0) { *word = w; *code = p + len; @@ -446,11 +430,11 @@ static int find_word(const char *name, zf_addr *word, zf_addr *code) * Set 'immediate' flag in last compiled word */ -static void make_immediate(void) +static void make_immediate(zf_ctx *ctx) { zf_cell lenflags; - dict_get_cell(LATEST, &lenflags); - dict_put_cell(LATEST, (int)lenflags | ZF_FLAG_IMMEDIATE); + dict_get_cell(ctx, LATEST(ctx), &lenflags); + dict_put_cell(ctx, LATEST(ctx), (int)lenflags | ZF_FLAG_IMMEDIATE); } @@ -458,34 +442,34 @@ static void make_immediate(void) * Inner interpreter */ -static void run(const char *input) +static void run(zf_ctx *ctx, const char *input) { - while(ip != 0) { + while(ctx->ip != 0) { zf_cell d; - zf_addr i, ip_org = ip; - zf_addr l = dict_get_cell(ip, &d); + zf_addr i, ip_org = ctx->ip; + zf_addr l = dict_get_cell(ctx, ctx->ip, &d); zf_addr code = d; - trace("\n "ZF_ADDR_FMT " " ZF_ADDR_FMT " ", ip, code); - for(i=0; iip, code); + for(i=0; iip += l; if(code <= PRIM_COUNT) { - do_prim((zf_prim)code, input); + do_prim(ctx, (zf_prim)code, input); /* If the prim requests input, restore IP so that the * next time around we call the same prim again */ - if(input_state != ZF_INPUT_INTERPRET) { - ip = ip_org; + if(ctx->input_state != ZF_INPUT_INTERPRET) { + ctx->ip = ip_org; break; } } else { - trace("%s/" ZF_ADDR_FMT " ", op_name(code), code); - zf_pushr(ip); - ip = code; + trace(ctx, "%s/" ZF_ADDR_FMT " ", op_name(ctx, code), code); + zf_pushr(ctx, ctx->ip); + ctx->ip = code; } input = NULL; @@ -497,25 +481,25 @@ static void run(const char *input) * Execute bytecode from given address */ -static void execute(zf_addr addr) +static void execute(zf_ctx *ctx, zf_addr addr) { - ip = addr; - RSP = 0; - zf_pushr(0); + ctx->ip = addr; + RSP(ctx) = 0; + zf_pushr(ctx, 0); - trace("\n[%s/" ZF_ADDR_FMT "] ", op_name(ip), ip); - run(NULL); + trace(ctx, "\n[%s/" ZF_ADDR_FMT "] ", op_name(ctx, ctx->ip), ctx->ip); + run(ctx, NULL); } -static zf_addr peek(zf_addr addr, zf_cell *val, int len) +static zf_addr peek(zf_ctx *ctx, zf_addr addr, zf_cell *val, int len) { if(addr < ZF_USERVAR_COUNT) { - *val = uservar[addr]; + *val = ctx->uservar[addr]; return 1; } else { - return dict_get_cell_typed(addr, val, (zf_mem_size)len); + return dict_get_cell_typed(ctx, addr, val, (zf_mem_size)len); } } @@ -525,231 +509,231 @@ static zf_addr peek(zf_addr addr, zf_cell *val, int len) * Run primitive opcode */ -static void do_prim(zf_prim op, const char *input) +static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) { zf_cell d1, d2, d3; zf_addr addr, len; - trace("(%s) ", op_name(op)); + trace(ctx, "(%s) ", op_name(ctx, op)); switch(op) { case PRIM_COL: if(input == NULL) { - input_state = ZF_INPUT_PASS_WORD; + ctx->input_state = ZF_INPUT_PASS_WORD; } else { - create(input, 0); - COMPILING = 1; + create(ctx, input, 0); + COMPILING(ctx) = 1; } break; case PRIM_LTZ: - zf_push(zf_pop() < 0); + zf_push(ctx, zf_pop(ctx) < 0); break; case PRIM_SEMICOL: - dict_add_op(PRIM_EXIT); - trace("\n==="); - COMPILING = 0; + dict_add_op(ctx, PRIM_EXIT); + trace(ctx, "\n==="); + COMPILING(ctx) = 0; break; case PRIM_LIT: - ip += dict_get_cell(ip, &d1); - zf_push(d1); + ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); + zf_push(ctx, d1); break; case PRIM_EXIT: - ip = zf_popr(); + ctx->ip = zf_popr(ctx); break; case PRIM_LEN: - len = zf_pop(); - addr = zf_pop(); - zf_push(peek(addr, &d1, len)); + len = zf_pop(ctx); + addr = zf_pop(ctx); + zf_push(ctx, peek(ctx, addr, &d1, len)); break; case PRIM_PEEK: - len = zf_pop(); - addr = zf_pop(); - peek(addr, &d1, len); - zf_push(d1); + len = zf_pop(ctx); + addr = zf_pop(ctx); + peek(ctx, addr, &d1, len); + zf_push(ctx, d1); break; case PRIM_POKE: - d2 = zf_pop(); - addr = zf_pop(); - d1 = zf_pop(); + d2 = zf_pop(ctx); + addr = zf_pop(ctx); + d1 = zf_pop(ctx); if(addr < ZF_USERVAR_COUNT) { - uservar[addr] = d1; + ctx->uservar[addr] = d1; break; } - dict_put_cell_typed(addr, d1, (zf_mem_size)d2); + dict_put_cell_typed(ctx, addr, d1, (zf_mem_size)d2); break; case PRIM_SWAP: - d1 = zf_pop(); d2 = zf_pop(); - zf_push(d1); zf_push(d2); + d1 = zf_pop(ctx); d2 = zf_pop(ctx); + zf_push(ctx, d1); zf_push(ctx, d2); break; case PRIM_ROT: - d1 = zf_pop(); d2 = zf_pop(); d3 = zf_pop(); - zf_push(d2); zf_push(d1); zf_push(d3); + d1 = zf_pop(ctx); d2 = zf_pop(ctx); d3 = zf_pop(ctx); + zf_push(ctx, d2); zf_push(ctx, d1); zf_push(ctx, d3); break; case PRIM_DROP: - zf_pop(); + zf_pop(ctx); break; case PRIM_DUP: - d1 = zf_pop(); - zf_push(d1); zf_push(d1); + d1 = zf_pop(ctx); + zf_push(ctx, d1); zf_push(ctx, d1); break; case PRIM_ADD: - d1 = zf_pop(); d2 = zf_pop(); - zf_push(d1 + d2); + d1 = zf_pop(ctx); d2 = zf_pop(ctx); + zf_push(ctx, d1 + d2); break; case PRIM_SYS: - d1 = zf_pop(); - input_state = zf_host_sys((zf_syscall_id)d1, input); - if(input_state != ZF_INPUT_INTERPRET) { - zf_push(d1); /* re-push id to resume */ + d1 = zf_pop(ctx); + ctx->input_state = zf_host_sys(ctx, (zf_syscall_id)d1, input); + if(ctx->input_state != ZF_INPUT_INTERPRET) { + zf_push(ctx, d1); /* re-push id to resume */ } break; case PRIM_PICK: - addr = zf_pop(); - zf_push(zf_pick(addr)); + addr = zf_pop(ctx); + zf_push(ctx, zf_pick(ctx, addr)); break; case PRIM_PICKR: - addr = zf_pop(); - zf_push(zf_pickr(addr)); + addr = zf_pop(ctx); + zf_push(ctx, zf_pickr(ctx, addr)); break; case PRIM_SUB: - d1 = zf_pop(); d2 = zf_pop(); - zf_push(d2 - d1); + d1 = zf_pop(ctx); d2 = zf_pop(ctx); + zf_push(ctx, d2 - d1); break; case PRIM_MUL: - zf_push(zf_pop() * zf_pop()); + zf_push(ctx, zf_pop(ctx) * zf_pop(ctx)); break; case PRIM_DIV: - if((d2 = zf_pop()) == 0) { - zf_abort(ZF_ABORT_DIVISION_BY_ZERO); + if((d2 = zf_pop(ctx)) == 0) { + zf_abort(ctx, ZF_ABORT_DIVISION_BY_ZERO); } - d1 = zf_pop(); - zf_push(d1 / d2); + d1 = zf_pop(ctx); + zf_push(ctx, d1 / d2); break; case PRIM_MOD: - if((int)(d2 = zf_pop()) == 0) { - zf_abort(ZF_ABORT_DIVISION_BY_ZERO); + if((int)(d2 = zf_pop(ctx)) == 0) { + zf_abort(ctx, ZF_ABORT_DIVISION_BY_ZERO); } - d1 = zf_pop(); - zf_push((int)d1 % (int)d2); + d1 = zf_pop(ctx); + zf_push(ctx, (int)d1 % (int)d2); break; case PRIM_IMMEDIATE: - make_immediate(); + make_immediate(ctx); break; case PRIM_JMP: - ip += dict_get_cell(ip, &d1); - trace("ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ip, (zf_addr)d1); - ip = d1; + ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); + trace(ctx, "ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ctx->ip, (zf_addr)d1); + ctx->ip = d1; break; case PRIM_JMP0: - ip += dict_get_cell(ip, &d1); - if(zf_pop() == 0) { - trace("ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ip, (zf_addr)d1); - ip = d1; + ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); + if(zf_pop(ctx) == 0) { + trace(ctx, "ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ctx->ip, (zf_addr)d1); + ctx->ip = d1; } break; case PRIM_TICK: - if (COMPILING) { - ip += dict_get_cell(ip, &d1); - trace("%s/", op_name(d1)); - zf_push(d1); + if (COMPILING(ctx)) { + ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); + trace(ctx, "%s/", op_name(ctx, d1)); + zf_push(ctx, d1); } else { if (input) { - if (find_word(input,&addr,&len)) zf_push(len); - else zf_abort(ZF_ABORT_INTERNAL_ERROR); + if (find_word(ctx, input,&addr,&len)) zf_push(ctx, len); + else zf_abort(ctx, ZF_ABORT_INTERNAL_ERROR); } - else input_state = ZF_INPUT_PASS_WORD; + else ctx->input_state = ZF_INPUT_PASS_WORD; } break; case PRIM_COMMA: - d2 = zf_pop(); - d1 = zf_pop(); - dict_add_cell_typed(d1, (zf_mem_size)d2); + d2 = zf_pop(ctx); + d1 = zf_pop(ctx); + dict_add_cell_typed(ctx, d1, (zf_mem_size)d2); break; case PRIM_COMMENT: if(!input || input[0] != ')') { - input_state = ZF_INPUT_PASS_CHAR; + ctx->input_state = ZF_INPUT_PASS_CHAR; } break; case PRIM_PUSHR: - zf_pushr(zf_pop()); + zf_pushr(ctx, zf_pop(ctx)); break; case PRIM_POPR: - zf_push(zf_popr()); + zf_push(ctx, zf_popr(ctx)); break; case PRIM_EQUAL: - zf_push(zf_pop() == zf_pop()); + zf_push(ctx, zf_pop(ctx) == zf_pop(ctx)); break; case PRIM_KEY: if(input == NULL) { - input_state = ZF_INPUT_PASS_CHAR; + ctx->input_state = ZF_INPUT_PASS_CHAR; } else { - zf_push(input[0]); + zf_push(ctx, input[0]); } break; case PRIM_LITS: - ip += dict_get_cell(ip, &d1); - zf_push(ip); - zf_push(d1); - ip += d1; + ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); + zf_push(ctx, ctx->ip); + zf_push(ctx, d1); + ctx->ip += d1; break; case PRIM_AND: - zf_push((zf_int)zf_pop() & (zf_int)zf_pop()); + zf_push(ctx, (zf_int)zf_pop(ctx) & (zf_int)zf_pop(ctx)); break; case PRIM_OR: - zf_push((zf_int)zf_pop() | (zf_int)zf_pop()); + zf_push(ctx, (zf_int)zf_pop(ctx) | (zf_int)zf_pop(ctx)); break; case PRIM_XOR: - zf_push((zf_int)zf_pop() ^ (zf_int)zf_pop()); + zf_push(ctx, (zf_int)zf_pop(ctx) ^ (zf_int)zf_pop(ctx)); break; case PRIM_SHL: - d1 = zf_pop(); - zf_push((zf_int)zf_pop() << (zf_int)d1); + d1 = zf_pop(ctx); + zf_push(ctx, (zf_int)zf_pop(ctx) << (zf_int)d1); break; case PRIM_SHR: - d1 = zf_pop(); - zf_push((zf_int)zf_pop() >> (zf_int)d1); + d1 = zf_pop(ctx); + zf_push(ctx, (zf_int)zf_pop(ctx) >> (zf_int)d1); break; default: - zf_abort(ZF_ABORT_INTERNAL_ERROR); + zf_abort(ctx, ZF_ABORT_INTERNAL_ERROR); break; } } @@ -760,7 +744,7 @@ static void do_prim(zf_prim op, const char *input) * deferred primitive if it requested a word from the input stream. */ -static void handle_word(const char *buf) +static void handle_word(zf_ctx *ctx, const char *buf) { zf_addr w, c = 0; int found; @@ -768,15 +752,15 @@ static void handle_word(const char *buf) /* If a word was requested by an earlier operation, resume with the new * word */ - if(input_state == ZF_INPUT_PASS_WORD) { - input_state = ZF_INPUT_INTERPRET; - run(buf); + if(ctx->input_state == ZF_INPUT_PASS_WORD) { + ctx->input_state = ZF_INPUT_INTERPRET; + run(ctx, buf); return; } /* Look up the word in the dictionary */ - found = find_word(buf, &w, &c); + found = find_word(ctx, buf, &w, &c); if(found) { @@ -784,31 +768,31 @@ static void handle_word(const char *buf) zf_cell d; int flags; - dict_get_cell(w, &d); + dict_get_cell(ctx, w, &d); flags = d; - if(COMPILING && (POSTPONE || !(flags & ZF_FLAG_IMMEDIATE))) { + if(COMPILING(ctx) && (POSTPONE(ctx) || !(flags & ZF_FLAG_IMMEDIATE))) { if(flags & ZF_FLAG_PRIM) { - dict_get_cell(c, &d); - dict_add_op(d); + dict_get_cell(ctx, c, &d); + dict_add_op(ctx, d); } else { - dict_add_op(c); + dict_add_op(ctx, c); } - POSTPONE = 0; + POSTPONE(ctx) = 0; } else { - execute(c); + execute(ctx, c); } } else { /* Word not found: try to convert to a number and compile or push, depending * on state */ - zf_cell v = zf_host_parse_num(buf); + zf_cell v = zf_host_parse_num(ctx, buf); - if(COMPILING) { - dict_add_lit(v); + if(COMPILING(ctx)) { + dict_add_lit(ctx, v); } else { - zf_push(v); + zf_push(ctx, v); } } } @@ -819,15 +803,15 @@ static void handle_word(const char *buf) * char to a deferred prim if it requested a character from the input stream */ -static void handle_char(char c) +static void handle_char(zf_ctx *ctx, char c) { static char buf[32]; static size_t len = 0; - if(input_state == ZF_INPUT_PASS_CHAR) { + if(ctx->input_state == ZF_INPUT_PASS_CHAR) { - input_state = ZF_INPUT_INTERPRET; - run(&c); + ctx->input_state = ZF_INPUT_INTERPRET; + run(ctx, &c); } else if(c != '\0' && !isspace(c)) { @@ -840,7 +824,7 @@ static void handle_char(char c) if(len > 0) { len = 0; - handle_word(buf); + handle_word(ctx, buf); } } } @@ -850,14 +834,15 @@ static void handle_char(char c) * Initialisation */ -void zf_init(int enable_trace) +void zf_init(zf_ctx *ctx, int enable_trace) { - HERE = ZF_USERVAR_COUNT * sizeof(zf_addr); - TRACE = enable_trace; - LATEST = 0; - DSP = 0; - RSP = 0; - COMPILING = 0; + ctx->uservar = (zf_addr *)ctx->dict; + HERE(ctx) = ZF_USERVAR_COUNT * sizeof(zf_addr); + TRACE(ctx) = enable_trace; + LATEST(ctx) = 0; + DSP(ctx) = 0; + RSP(ctx) = 0; + COMPILING(ctx) = 0; } @@ -868,7 +853,7 @@ void zf_init(int enable_trace) * user variables. */ -static void add_prim(const char *name, zf_prim op) +static void add_prim(zf_ctx *ctx, const char *name, zf_prim op) { int imm = 0; @@ -877,21 +862,21 @@ static void add_prim(const char *name, zf_prim op) imm = 1; } - create(name, ZF_FLAG_PRIM); - dict_add_op(op); - dict_add_op(PRIM_EXIT); - if(imm) make_immediate(); + create(ctx, name, ZF_FLAG_PRIM); + dict_add_op(ctx, op); + dict_add_op(ctx, PRIM_EXIT); + if(imm) make_immediate(ctx); } -static void add_uservar(const char *name, zf_addr addr) +static void add_uservar(zf_ctx *ctx, const char *name, zf_addr addr) { - create(name, 0); - dict_add_lit(addr); - dict_add_op(PRIM_EXIT); + create(ctx, name, 0); + dict_add_lit(ctx, addr); + dict_add_op(ctx, PRIM_EXIT); } -void zf_bootstrap(void) +void zf_bootstrap(zf_ctx *ctx) { /* Add primitives and user variables to dictionary */ @@ -899,12 +884,12 @@ void zf_bootstrap(void) zf_addr i = 0; const char *p; for(p=prim_names; *p; p+=strlen(p)+1) { - add_prim(p, (zf_prim)i++); + add_prim(ctx, p, (zf_prim)i++); } i = 0; for(p=uservar_names; *p; p+=strlen(p)+1) { - add_uservar(p, i++); + add_uservar(ctx, p, i++); } } @@ -917,52 +902,52 @@ void zf_bootstrap(void) {} * Eval forth string */ -zf_result zf_eval(const char *buf) +zf_result zf_eval(zf_ctx *ctx, const char *buf) { - zf_result r = (zf_result)setjmp(jmpbuf); + zf_result r = (zf_result)setjmp(ctx->jmpbuf); if(r == ZF_OK) { for(;;) { - handle_char(*buf); + handle_char(ctx, *buf); if(*buf == '\0') { return ZF_OK; } buf ++; } } else { - COMPILING = 0; - RSP = 0; - DSP = 0; + COMPILING(ctx) = 0; + RSP(ctx) = 0; + DSP(ctx) = 0; return r; } } -void *zf_dump(size_t *len) +void *zf_dump(zf_ctx *ctx, size_t *len) { - if(len) *len = sizeof(dict); - return dict; + if(len) *len = sizeof(ctx->dict); + return ctx->dict; } -zf_result zf_uservar_set(zf_uservar_id uv, zf_cell v) +zf_result zf_uservar_set(zf_ctx *ctx, zf_uservar_id uv, zf_cell v) { zf_result result = ZF_ABORT_INVALID_USERVAR; if (uv < ZF_USERVAR_COUNT) { - uservar[uv] = v; + ctx->uservar[uv] = v; result = ZF_OK; } return result; } -zf_result zf_uservar_get(zf_uservar_id uv, zf_cell *v) +zf_result zf_uservar_get(zf_ctx *ctx, zf_uservar_id uv, zf_cell *v) { zf_result result = ZF_ABORT_INVALID_USERVAR; if (uv < ZF_USERVAR_COUNT) { if (v != NULL) { - *v = uservar[uv]; + *v = ctx->uservar[uv]; } result = ZF_OK; } diff --git a/src/zforth/zforth.h b/src/zforth/zforth.h index 8b02e95..af8eb21 100644 --- a/src/zforth/zforth.h +++ b/src/zforth/zforth.h @@ -9,6 +9,7 @@ extern "C" #include #include #include +#include #include "zfconf.h" @@ -56,27 +57,44 @@ typedef enum { } zf_uservar_id; +typedef struct { + /* Stacks and dictionary memory */ + zf_cell rstack[ZF_RSTACK_SIZE]; + zf_cell dstack[ZF_DSTACK_SIZE]; + uint8_t dict[ZF_DICT_SIZE]; + + /* State and stack and interpreter pointers */ + zf_input_state input_state; + zf_addr ip; + + /* setjmp env for handling aborts */ + jmp_buf jmpbuf; + + zf_addr *uservar; +} zf_ctx; + + /* ZForth API functions */ -void zf_init(int trace); -void zf_bootstrap(void); -void *zf_dump(size_t *len); -zf_result zf_eval(const char *buf); -void zf_abort(zf_result reason); +void zf_init(zf_ctx *ctx, int trace); +void zf_bootstrap(zf_ctx *ctx); +void *zf_dump(zf_ctx *ctx, size_t *len); +zf_result zf_eval(zf_ctx *ctx, const char *buf); +void zf_abort(zf_ctx *ctx, zf_result reason); -void zf_push(zf_cell v); -zf_cell zf_pop(void); -zf_cell zf_pick(zf_addr n); +void zf_push(zf_ctx *ctx, zf_cell v); +zf_cell zf_pop(zf_ctx *ctx); +zf_cell zf_pick(zf_ctx *ctx, zf_addr n); -zf_result zf_uservar_set(zf_uservar_id uv, zf_cell v); -zf_result zf_uservar_get(zf_uservar_id uv, zf_cell *v); +zf_result zf_uservar_set(zf_ctx *ctx, zf_uservar_id uv, zf_cell v); +zf_result zf_uservar_get(zf_ctx *ctx, zf_uservar_id uv, zf_cell *v); /* Host provides these functions */ -zf_input_state zf_host_sys(zf_syscall_id id, const char *last_word); -void zf_host_trace(const char *fmt, va_list va); -zf_cell zf_host_parse_num(const char *buf); +zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *last_word); +void zf_host_trace(zf_ctx *ctx, const char *fmt, va_list va); +zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf); #ifdef __cplusplus } From bd7796b94a684b8216601689f942aa7eb52b6aa7 Mon Sep 17 00:00:00 2001 From: Smooth Operator Date: Mon, 16 Dec 2024 11:50:55 -0500 Subject: [PATCH 2/8] comments, clarify size encoding, ZF_TRUE|FALSE --- src/atmega8/zfconf.h | 6 +++- src/linux/zfconf.h | 6 +++- src/zforth/zforth.c | 79 +++++++++++++++++++++++++++++++++++--------- 3 files changed, 74 insertions(+), 17 deletions(-) diff --git a/src/atmega8/zfconf.h b/src/atmega8/zfconf.h index 33e105d..e11d013 100644 --- a/src/atmega8/zfconf.h +++ b/src/atmega8/zfconf.h @@ -44,7 +44,11 @@ typedef int32_t zf_cell; it will cause sign fill, so we need manual specify it */ typedef int zf_int; -/* The type to use for pointers and adresses. 'unsigned int' is usually a good +/* True is defined as the bitwise complement of false. */ +#define ZF_FALSE ((zf_cell)0) +#define ZF_TRUE ((zf_cell)~(zf_int)ZF_FALSE) + +/* The type to use for pointers and addresses. 'unsigned int' is usually a good * choice for best performance and smallest code size */ typedef unsigned int zf_addr; diff --git a/src/linux/zfconf.h b/src/linux/zfconf.h index 6b7f1ea..f7d294b 100644 --- a/src/linux/zfconf.h +++ b/src/linux/zfconf.h @@ -44,7 +44,11 @@ typedef float zf_cell; it will cause sign fill, so we need manual specify it */ typedef int zf_int; -/* The type to use for pointers and adresses. 'unsigned int' is usually a good +/* True is defined as the bitwise complement of false. */ +#define ZF_FALSE ((zf_cell)0) +#define ZF_TRUE ((zf_cell)~(zf_int)ZF_FALSE) + +/* The type to use for pointers and addresses. 'unsigned int' is usually a good * choice for best performance and smallest code size */ typedef unsigned int zf_addr; diff --git a/src/zforth/zforth.c b/src/zforth/zforth.c index 0bce1af..107bdb2 100644 --- a/src/zforth/zforth.c +++ b/src/zforth/zforth.c @@ -288,6 +288,10 @@ static zf_addr dict_put_cell_typed(zf_ctx *ctx, zf_addr addr, zf_cell v, zf_mem_ } +/* + * Get cell from dictionary memory, with specified cell size encoding; + * returns the number of bytes read + */ static zf_addr dict_get_cell_typed(zf_ctx *ctx, zf_addr addr, zf_cell *v, zf_mem_size size) { uint8_t t[2]; @@ -493,13 +497,19 @@ static void execute(zf_ctx *ctx, zf_addr addr) } -static zf_addr peek(zf_ctx *ctx, zf_addr addr, zf_cell *val, int len) +/* + * Peek at memory, either user variables or dictionary memory, + * returns number of bytes read + */ +static zf_addr peek(zf_ctx *ctx, zf_addr addr, zf_cell *val, zf_mem_size size) { if(addr < ZF_USERVAR_COUNT) { + /* Special case for user variables */ *val = ctx->uservar[addr]; return 1; } else { - return dict_get_cell_typed(ctx, addr, val, (zf_mem_size)len); + /* General case for dictionary memory */ + return dict_get_cell_typed(ctx, addr, val, size); } } @@ -512,13 +522,15 @@ static zf_addr peek(zf_ctx *ctx, zf_addr addr, zf_cell *val, int len) static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) { zf_cell d1, d2, d3; - zf_addr addr, len; + zf_addr addr, code; + zf_mem_size size; trace(ctx, "(%s) ", op_name(ctx, op)); switch(op) { case PRIM_COL: + /* Start of word definition */ if(input == NULL) { ctx->input_state = ZF_INPUT_PASS_WORD; } else { @@ -528,73 +540,87 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_LTZ: - zf_push(ctx, zf_pop(ctx) < 0); + /* Push true if less than zero, else false */ + if(zf_pop(ctx) < 0) zf_push(ctx, ZF_TRUE); + else zf_push(ctx, ZF_FALSE); break; case PRIM_SEMICOL: + /* End of word definition */ dict_add_op(ctx, PRIM_EXIT); trace(ctx, "\n==="); COMPILING(ctx) = 0; break; case PRIM_LIT: + /* At run time, push next value from dictionary on stack */ ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); zf_push(ctx, d1); break; case PRIM_EXIT: + /* Return from word */ ctx->ip = zf_popr(ctx); break; case PRIM_LEN: - len = zf_pop(ctx); + /* Get length of cell; consumes size encoding and address */ + size = zf_pop(ctx); addr = zf_pop(ctx); - zf_push(ctx, peek(ctx, addr, &d1, len)); + zf_push(ctx, peek(ctx, addr, &d1, size)); break; case PRIM_PEEK: - len = zf_pop(ctx); + /* Peek at memory; consumes size encoding and address */ + size = zf_pop(ctx); addr = zf_pop(ctx); - peek(ctx, addr, &d1, len); + peek(ctx, addr, &d1, size); zf_push(ctx, d1); break; case PRIM_POKE: - d2 = zf_pop(ctx); + /* Poke memory; consumes size encoding, address, and value */ + size = zf_pop(ctx); addr = zf_pop(ctx); d1 = zf_pop(ctx); if(addr < ZF_USERVAR_COUNT) { ctx->uservar[addr] = d1; - break; + } else { + dict_put_cell_typed(ctx, addr, d1, size); } - dict_put_cell_typed(ctx, addr, d1, (zf_mem_size)d2); break; case PRIM_SWAP: + /* Swap top two elements on stack */ d1 = zf_pop(ctx); d2 = zf_pop(ctx); zf_push(ctx, d1); zf_push(ctx, d2); break; case PRIM_ROT: + /* Rotate top three elements on stack */ d1 = zf_pop(ctx); d2 = zf_pop(ctx); d3 = zf_pop(ctx); zf_push(ctx, d2); zf_push(ctx, d1); zf_push(ctx, d3); break; case PRIM_DROP: + /* Drop top element from stack */ zf_pop(ctx); break; case PRIM_DUP: + /* Duplicate top element on stack */ d1 = zf_pop(ctx); zf_push(ctx, d1); zf_push(ctx, d1); break; case PRIM_ADD: + /* Pop and add top two elements on stack */ d1 = zf_pop(ctx); d2 = zf_pop(ctx); zf_push(ctx, d1 + d2); break; case PRIM_SYS: + /* Perform host system call */ d1 = zf_pop(ctx); ctx->input_state = zf_host_sys(ctx, (zf_syscall_id)d1, input); if(ctx->input_state != ZF_INPUT_INTERPRET) { @@ -603,25 +629,30 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_PICK: + /* Pick n-th element from stack */ addr = zf_pop(ctx); zf_push(ctx, zf_pick(ctx, addr)); break; case PRIM_PICKR: + /* Pick n-th element from return stack */ addr = zf_pop(ctx); zf_push(ctx, zf_pickr(ctx, addr)); break; case PRIM_SUB: + /* Subtract top element on stack from next element */ d1 = zf_pop(ctx); d2 = zf_pop(ctx); zf_push(ctx, d2 - d1); break; case PRIM_MUL: + /* Multiply top two elements on stack */ zf_push(ctx, zf_pop(ctx) * zf_pop(ctx)); break; case PRIM_DIV: + /* Divide next element on stack by top element */ if((d2 = zf_pop(ctx)) == 0) { zf_abort(ctx, ZF_ABORT_DIVISION_BY_ZERO); } @@ -630,6 +661,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_MOD: + /* Modulo next element on stack by top element */ if((int)(d2 = zf_pop(ctx)) == 0) { zf_abort(ctx, ZF_ABORT_DIVISION_BY_ZERO); } @@ -638,16 +670,19 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_IMMEDIATE: + /* Set immediate flag in next word */ make_immediate(ctx); break; case PRIM_JMP: + /* Jump to address */ ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); trace(ctx, "ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ctx->ip, (zf_addr)d1); ctx->ip = d1; break; case PRIM_JMP0: + /* Jump to address if top of stack is zero */ ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); if(zf_pop(ctx) == 0) { trace(ctx, "ip " ZF_ADDR_FMT "=>" ZF_ADDR_FMT, ctx->ip, (zf_addr)d1); @@ -656,6 +691,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_TICK: + /* Compile next word */ if (COMPILING(ctx)) { ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); trace(ctx, "%s/", op_name(ctx, d1)); @@ -663,7 +699,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) } else { if (input) { - if (find_word(ctx, input,&addr,&len)) zf_push(ctx, len); + if (find_word(ctx, input,&addr,&code)) zf_push(ctx, code); else zf_abort(ctx, ZF_ABORT_INTERNAL_ERROR); } else ctx->input_state = ZF_INPUT_PASS_WORD; @@ -672,30 +708,37 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_COMMA: - d2 = zf_pop(ctx); + /* Compile literal value; consumes size encoding, value */ + size = zf_pop(ctx); d1 = zf_pop(ctx); - dict_add_cell_typed(ctx, d1, (zf_mem_size)d2); + dict_add_cell_typed(ctx, d1, size); break; case PRIM_COMMENT: + /* Skip to matching ')' */ if(!input || input[0] != ')') { ctx->input_state = ZF_INPUT_PASS_CHAR; } break; case PRIM_PUSHR: + /* Push top of data stack to return stack */ zf_pushr(ctx, zf_pop(ctx)); break; case PRIM_POPR: + /* Pop top of return stack to data stack */ zf_push(ctx, zf_popr(ctx)); break; case PRIM_EQUAL: - zf_push(ctx, zf_pop(ctx) == zf_pop(ctx)); + /* Push true if top two elements on stack are equal, else false */ + if(zf_pop(ctx) == zf_pop(ctx)) zf_push(ctx, ZF_TRUE); + else zf_push(ctx, ZF_FALSE); break; case PRIM_KEY: + /* Get next character from input stream */ if(input == NULL) { ctx->input_state = ZF_INPUT_PASS_CHAR; } else { @@ -704,6 +747,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_LITS: + /* Literal string */ ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); zf_push(ctx, ctx->ip); zf_push(ctx, d1); @@ -711,23 +755,28 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) break; case PRIM_AND: + /* Bitwise AND of top two elements on stack */ zf_push(ctx, (zf_int)zf_pop(ctx) & (zf_int)zf_pop(ctx)); break; case PRIM_OR: + /* Bitwise OR of top two elements on stack */ zf_push(ctx, (zf_int)zf_pop(ctx) | (zf_int)zf_pop(ctx)); break; case PRIM_XOR: + /* Bitwise XOR of top two elements on stack */ zf_push(ctx, (zf_int)zf_pop(ctx) ^ (zf_int)zf_pop(ctx)); break; case PRIM_SHL: + /* Shift left of next element by top element */ d1 = zf_pop(ctx); zf_push(ctx, (zf_int)zf_pop(ctx) << (zf_int)d1); break; case PRIM_SHR: + /* Shift right of next element by top element */ d1 = zf_pop(ctx); zf_push(ctx, (zf_int)zf_pop(ctx) >> (zf_int)d1); break; From e01d6c51790cf65400cb65796bbae4c13a951345 Mon Sep 17 00:00:00 2001 From: Smooth Operator Date: Mon, 16 Dec 2024 11:52:10 -0500 Subject: [PATCH 3/8] fix off-by-one --- src/zforth/zforth.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/zforth/zforth.c b/src/zforth/zforth.c index 107bdb2..5fa99eb 100644 --- a/src/zforth/zforth.c +++ b/src/zforth/zforth.c @@ -459,7 +459,7 @@ static void run(zf_ctx *ctx, const char *input) ctx->ip += l; - if(code <= PRIM_COUNT) { + if(code < PRIM_COUNT) { do_prim(ctx, (zf_prim)code, input); /* If the prim requests input, restore IP so that the From 8f787f3ff9776298558877071e678613e7f07efa Mon Sep 17 00:00:00 2001 From: Smooth Operator Date: Mon, 16 Dec 2024 11:52:28 -0500 Subject: [PATCH 4/8] wip `literal` per ANS forth --- forth/core.zf | 2 ++ src/zforth/zforth.c | 12 +++++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/forth/core.zf b/forth/core.zf index f81bf03..96e1cd2 100644 --- a/forth/core.zf +++ b/forth/core.zf @@ -58,6 +58,8 @@ : allot h +! ; : var : ' lit , here 5 allot here swap ! 5 allot postpone ; ; : const : ' lit , , postpone ; ; +: constant >r : r> postpone literal postpone ; ; +: variable >r here r> postpone , constant ; ( 'begin' gets the current address, a jump or conditional jump back is generated by 'again', 'until' ) diff --git a/src/zforth/zforth.c b/src/zforth/zforth.c index 5fa99eb..4fbd5ad 100644 --- a/src/zforth/zforth.c +++ b/src/zforth/zforth.c @@ -49,6 +49,7 @@ typedef enum { PRIM_JMP, PRIM_JMP0, PRIM_TICK, PRIM_COMMENT, PRIM_PUSHR, PRIM_POPR, PRIM_EQUAL, PRIM_SYS, PRIM_PICK, PRIM_COMMA, PRIM_KEY, PRIM_LITS, PRIM_LEN, PRIM_AND, PRIM_OR, PRIM_XOR, PRIM_SHL, PRIM_SHR, + PRIM_LITERAL, PRIM_COUNT } zf_prim; @@ -58,7 +59,8 @@ static const char prim_names[] = _("pickr") _("_immediate") _("@@") _("!!") _("swap") _("rot") _("jmp") _("jmp0") _("'") _("_(") _(">r") _("r>") _("=") _("sys") _("pick") _(",,") _("key") _("lits") - _("##") _("&") _("|") _("^") _("<<") _(">>"); + _("##") _("&") _("|") _("^") _("<<") _(">>") + _("_literal"); /* User variables are variables which are shared between forth and C. From @@ -552,6 +554,14 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) COMPILING(ctx) = 0; break; + case PRIM_LITERAL: + /* At compile time, compiles a value from the stack into the + * definition as a literal. At run time, the value will be pushed + * on the stack. */ + if(COMPILING(ctx)) dict_add_lit(ctx, zf_pop(ctx)); + /* FIXME: else abort "!compiling"? */ + break; + case PRIM_LIT: /* At run time, push next value from dictionary on stack */ ctx->ip += dict_get_cell(ctx, ctx->ip, &d1); From 75dfb5156e7f4ef2bb123d9e5367d74d98a3283f Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Mon, 16 Dec 2024 19:24:37 +0100 Subject: [PATCH 5/8] Updated README --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index 7c78183..6f3a877 100644 --- a/README.md +++ b/README.md @@ -45,6 +45,9 @@ Some of zForth's highlights: - **Small footprint**: the kernel C code compiles to about 3 or 4 kB of machine code, depending on the architecture and chosen cell data types. +-- **Support for multiple instances**: The compiler and VM state is stored in a + struct, allowing multiple instances of zForth to run in parallel. + - **Tracing**: zForth is able to show a nice trace of what it is doing under the hood, see below for an example. From 2736e29c5f61ebc621571513b3f1057ca7ab69c8 Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Mon, 16 Dec 2024 19:28:18 +0100 Subject: [PATCH 6/8] refactoring --- src/zforth/zforth.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/zforth/zforth.c b/src/zforth/zforth.c index 4fbd5ad..b22c5f0 100644 --- a/src/zforth/zforth.c +++ b/src/zforth/zforth.c @@ -543,8 +543,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) case PRIM_LTZ: /* Push true if less than zero, else false */ - if(zf_pop(ctx) < 0) zf_push(ctx, ZF_TRUE); - else zf_push(ctx, ZF_FALSE); + zf_push(ctx, zf_pop(ctx) < 0 ? ZF_TRUE : ZF_FALSE); break; case PRIM_SEMICOL: @@ -743,8 +742,7 @@ static void do_prim(zf_ctx *ctx, zf_prim op, const char *input) case PRIM_EQUAL: /* Push true if top two elements on stack are equal, else false */ - if(zf_pop(ctx) == zf_pop(ctx)) zf_push(ctx, ZF_TRUE); - else zf_push(ctx, ZF_FALSE); + zf_push(ctx, zf_pop(ctx) == zf_pop(ctx) ? ZF_TRUE : ZF_FALSE); break; case PRIM_KEY: From 6399bc749ff172290c35eeb54a0817163b93500c Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Mon, 16 Dec 2024 19:31:39 +0100 Subject: [PATCH 7/8] Moved ZF_TRUE/ZF_FALSe to zforth.h --- src/atmega8/zfconf.h | 4 ---- src/linux/zfconf.h | 4 ---- src/zforth/zforth.h | 6 +++++- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/atmega8/zfconf.h b/src/atmega8/zfconf.h index e11d013..9303b7d 100644 --- a/src/atmega8/zfconf.h +++ b/src/atmega8/zfconf.h @@ -44,10 +44,6 @@ typedef int32_t zf_cell; it will cause sign fill, so we need manual specify it */ typedef int zf_int; -/* True is defined as the bitwise complement of false. */ -#define ZF_FALSE ((zf_cell)0) -#define ZF_TRUE ((zf_cell)~(zf_int)ZF_FALSE) - /* The type to use for pointers and addresses. 'unsigned int' is usually a good * choice for best performance and smallest code size */ diff --git a/src/linux/zfconf.h b/src/linux/zfconf.h index f7d294b..25aaca2 100644 --- a/src/linux/zfconf.h +++ b/src/linux/zfconf.h @@ -44,10 +44,6 @@ typedef float zf_cell; it will cause sign fill, so we need manual specify it */ typedef int zf_int; -/* True is defined as the bitwise complement of false. */ -#define ZF_FALSE ((zf_cell)0) -#define ZF_TRUE ((zf_cell)~(zf_int)ZF_FALSE) - /* The type to use for pointers and addresses. 'unsigned int' is usually a good * choice for best performance and smallest code size */ diff --git a/src/zforth/zforth.h b/src/zforth/zforth.h index af8eb21..edecafc 100644 --- a/src/zforth/zforth.h +++ b/src/zforth/zforth.h @@ -74,8 +74,12 @@ typedef struct { } zf_ctx; -/* ZForth API functions */ +/* True is defined as the bitwise complement of false. */ + +#define ZF_FALSE ((zf_cell)0) +#define ZF_TRUE ((zf_cell)~(zf_int)ZF_FALSE) +/* ZForth API functions */ void zf_init(zf_ctx *ctx, int trace); void zf_bootstrap(zf_ctx *ctx); From 2cf678142ac845ca68365d1cb2f5d5d775af0c8e Mon Sep 17 00:00:00 2001 From: Ico Doornekamp Date: Wed, 18 Dec 2024 19:34:08 +0100 Subject: [PATCH 8/8] Fixed NOREADLINE compilation --- src/linux/main.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/linux/main.c b/src/linux/main.c index f4e43c7..d091433 100644 --- a/src/linux/main.c +++ b/src/linux/main.c @@ -305,7 +305,7 @@ int main(int argc, char **argv) for(;;) { char buf[4096]; if(fgets(buf, sizeof(buf), stdin)) { - do_eval("stdin", ++line, buf); + do_eval(ctx, "stdin", ++line, buf); printf("\n"); } else { break;