From c53307380b4b2d7e824cc08c7ecaf1b5f8192214 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Sat, 6 Feb 2021 14:40:53 -0800 Subject: [PATCH] Separate last into current and context to progress towards vocabularies. --- ueforth/common/boot.fs | 7 ++++--- ueforth/common/core.h | 14 ++++++++------ ueforth/common/opcodes.h | 4 ++-- ueforth/common/testing.fs | 2 +- ueforth/posix/posix_desktop.fs | 4 ++-- ueforth/site/index.html | 3 ++- ueforth/web/web.template.js | 25 +++++++++++++------------ 7 files changed, 32 insertions(+), 27 deletions(-) diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs index ea6f02d..24932d6 100644 --- a/ueforth/common/boot.fs +++ b/ueforth/common/boot.fs @@ -37,8 +37,9 @@ : state ( -- a ) 'sys 3 cells + ; : base ( -- a ) 'sys 4 cells + ; : 'heap ( -- a ) 'sys 5 cells + ; -: last ( -- a ) 'sys 6 cells + ; -: 'notfound ( -- a ) 'sys 7 cells + ; +: current ( -- a ) 'sys 6 cells + ; +: context ( -- a ) 'sys 7 cells + ; +: 'notfound ( -- a ) 'sys 8 cells + ; ( Dictionary ) : here ( -- a ) 'heap @ ; @@ -194,7 +195,7 @@ variable hld 75 value line-width : onlines ( n xt -- n xt ) swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ; -: words 0 last @ begin onlines dup see. >link dup 0= until 2drop cr ; +: words 0 context @ @ begin onlines dup see. >link dup 0= until 2drop cr ; ( Examine Memory ) : dump ( a n -- ) diff --git a/ueforth/common/core.h b/ueforth/common/core.h index b398be3..c435aaf 100644 --- a/ueforth/common/core.h +++ b/ueforth/common/core.h @@ -11,7 +11,7 @@ static struct { const char *tib; cell_t ntib, tin, state, base; - cell_t *heap, *last, notfound; + cell_t *heap, **current, **context, notfound; int argc; char **argv; cell_t *rp; // spot to park main thread @@ -45,7 +45,7 @@ static cell_t same(const char *a, const char *b, cell_t len) { } static cell_t find(const char *name, cell_t len) { - cell_t *pos = g_sys.last; + cell_t *pos = *g_sys.context; cell_t clen = CELL_LEN(len); while (pos) { if (len == pos[-3] && @@ -62,9 +62,9 @@ static void create(const char *name, cell_t length, cell_t flags, void *op) { for (cell_t n = length; n; --n) { *pos++ = *name++; } // name g_sys.heap += CELL_LEN(length); *g_sys.heap++ = length; // length - *g_sys.heap++ = (cell_t) g_sys.last; // link + *g_sys.heap++ = (cell_t) *g_sys.current; // link *g_sys.heap++ = flags; // flags - g_sys.last = g_sys.heap; + *g_sys.current = g_sys.heap; *g_sys.heap++ = (cell_t) op; // code } @@ -125,10 +125,12 @@ static cell_t *ueforth_run(cell_t *initrp); static void ueforth_init(int argc, char *argv[], void *heap, const char *src, cell_t src_len) { g_sys.heap = (cell_t *) heap + 4; // Leave a little room. - ueforth_run(0); cell_t *sp = g_sys.heap + 1; g_sys.heap += STACK_SIZE; cell_t *rp = g_sys.heap + 1; g_sys.heap += STACK_SIZE; - g_sys.last[-1] = 1; // Make ; IMMEDIATE + g_sys.current = (cell_t **) g_sys.heap; + g_sys.context = (cell_t **) g_sys.heap; ++g_sys.heap; + ueforth_run(0); + (*g_sys.current)[-1] = 1; // Make last word ; IMMEDIATE g_sys.DOLIT_XT = FIND("DOLIT"); g_sys.DOEXIT_XT = FIND("EXIT"); g_sys.YIELD_XT = FIND("YIELD"); diff --git a/ueforth/common/opcodes.h b/ueforth/common/opcodes.h index 5efa69b..ee543a1 100644 --- a/ueforth/common/opcodes.h +++ b/ueforth/common/opcodes.h @@ -9,8 +9,8 @@ typedef uintptr_t ucell_t; #define DUP *++sp = tos #define DROP tos = *sp-- #define COMMA(n) *g_sys.heap++ = (n) -#define IMMEDIATE() g_sys.last[-1] |= 1 -#define DOES(ip) *g_sys.last = (cell_t) ADDR_DODOES; g_sys.last[1] = (cell_t) ip +#define IMMEDIATE() (*g_sys.current)[-1] |= 1 +#define DOES(ip) **g_sys.current = (cell_t) ADDR_DODOES; (*g_sys.current)[1] = (cell_t) ip #define PARK DUP; *++rp = (cell_t) sp; *++rp = (cell_t) ip #ifndef SSMOD_FUNC diff --git a/ueforth/common/testing.fs b/ueforth/common/testing.fs index bbc972a..47774f3 100644 --- a/ueforth/common/testing.fs +++ b/ueforth/common/testing.fs @@ -39,7 +39,7 @@ variable confirm-old-type variable tests-found variable tests-run variable tests-passed : test? ( xt -- f ) >name s" test-" startswith? ; : for-tests ( xt -- ) - last @ begin dup while dup test? if 2dup >r >r swap execute r> r> then >link repeat 2drop ; + context @ @ begin dup while dup test? if 2dup >r >r swap execute r> r> then >link repeat 2drop ; : reset-test-counters 0 tests-found ! 0 tests-run ! 0 tests-passed ! ; : count-test ( xt -- ) drop 1 tests-found +! ; : check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then ; diff --git a/ueforth/posix/posix_desktop.fs b/ueforth/posix/posix_desktop.fs index 16127f6..6e8e2c1 100644 --- a/ueforth/posix/posix_desktop.fs +++ b/ueforth/posix/posix_desktop.fs @@ -1,6 +1,6 @@ ( Arguments ) -: 'argc ( -- a ) 'sys 8 cells + ; -: 'argv ( -- a ) 'sys 9 cells + ; +: 'argc ( -- a ) 'sys 9 cells + ; +: 'argv ( -- a ) 'sys 10 cells + ; : argc ( -- n ) 'argc @ ; : argv ( n -- a n ) cells 'argv @ + @ z>s ; diff --git a/ueforth/site/index.html b/ueforth/site/index.html index 55be485..cb4159c 100644 --- a/ueforth/site/index.html +++ b/ueforth/site/index.html @@ -519,7 +519,8 @@ C and Forth (by way of a memory region accessed via 'SYS): BASE --- Numeric base for printing and parsing STATE --- State of compiling, -1 for compiling, 0 for interpreting -LAST --- Execution token of last word defined +CURRENT --- Pointer to pointer to last word of current vocabulary +CONTEXT --- Pointer to pointer to last word of context vocabulary 'NOTFOUND --- Execution token of a handler to call on word not found diff --git a/ueforth/web/web.template.js b/ueforth/web/web.template.js index f75f8b2..2b069e7 100644 --- a/ueforth/web/web.template.js +++ b/ueforth/web/web.template.js @@ -20,13 +20,14 @@ var g_tin = g_sys + 2 * 4; var g_state = g_sys + 3 * 4; var g_base = g_sys + 4 * 4; var g_heap = g_sys + 5 * 4; -var g_last = g_sys + 6 * 4; -var g_notfound = g_sys + 7 * 4; -var g_argc = g_sys + 8 * 4; -var g_argv = g_sys + 9 * 4; -var g_ip = g_sys + 10 * 4; -var g_sp = g_sys + 11 * 4; -var g_rp = g_sys + 12 * 4; +var g_current = g_sys + 6 * 4; +var g_context = g_sys + 7 * 4; +var g_notfound = g_sys + 8 * 4; +var g_argc = g_sys + 9 * 4; +var g_argv = g_sys + 10 * 4; +var g_ip = g_sys + 11 * 4; +var g_sp = g_sys + 12 * 4; +var g_rp = g_sys + 13 * 4; function SetEval(sp) { var index = i32[sp--]; @@ -72,7 +73,7 @@ function GetName(xt) { } function Find(name) { - var pos = i32[g_last>>2]; + var pos = i32[i32[g_context>>2]>>2]; while (pos) { if (Same(GetName(pos), name)) { return pos; @@ -89,15 +90,15 @@ function create(name, opcode) { i32[i32[g_heap>>2]>>2] = name.length; // length i32[g_heap>>2] += 4; - i32[i32[g_heap>>2]>>2] = i32[g_last>>2]; // link + i32[i32[g_heap>>2]>>2] = i32[i32[g_current]>>2]>>2]; // link i32[g_heap>>2] += 4; i32[i32[g_heap>>2]>>2] = 0; // flags i32[g_heap>>2] += 4; - i32[g_last>>2] = i32[g_heap>>2]; + i32[i32[g_current>>2]>>2] = i32[g_heap>>2]; - i32[i32[g_last>>2]>>2] = opcode; // code + i32[i32[i32[g_current>>2]>>2]>>2] = opcode; // code i32[g_heap>>2] += 4; } @@ -116,7 +117,7 @@ function Init() { i32[g_heap>>2] += STACK_SIZE; i32[g_rp>>2] = i32[g_heap>>2] + 1; i32[g_heap>>2] += STACK_SIZE; - i32[(g_last - 4)>>2] = 1; // Make ; IMMMEDIATE + i32[((i32[g_current]>>2) - 4)>>2] = 1; // Make ; IMMMEDIATE // Do not need DOLIT_XT, DOEXIT_XT, YIELD_XT (do by convention) i32[g_notfound>>2] = Find('DROP'); i32[g_ip>>2] = i32[g_heap>>2];