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

Separate last into current and context to progress towards vocabularies.

Browse Source
This commit is contained in:
Brad Nelson
2021-02-06 14:40:53 -08:00
parent a23e9560b0
commit c53307380b
7 changed files with 32 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
ueforth/common/boot.fs
View File

@ -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 -- )

14
ueforth/common/core.h
View File

@ -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");

4
ueforth/common/opcodes.h
View File

@ -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

2
ueforth/common/testing.fs
View File

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

4
ueforth/posix/posix_desktop.fs
View File

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

3
ueforth/site/index.html
View File

@ -519,7 +519,8 @@ C and Forth (by way of a memory region accessed via <code>'SYS</code>):
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
</pre>

25
ueforth/web/web.template.js
View File

@ -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];