feat(v4.0.0): the dictionary: its space, its entries, and FIND
The second layer of the compiler capsule, v4/capsule/dict.v4: HERE ALIGN ALLOT , C, 2, PAD LATEST; an entry layout reached entirely from the xt, with >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY TRAVERSE SMUDGE HIDDEN on it; and FIND and ' . FIND is FORTH-79's and v3's. ' is FORTH-79's: the parameter field address, which for a code word is what FIND gives. ALLOT counts cells (D-1). 31 characters of a name are significant. Executed at both cell widths against a list of 300 entries kept in C. WORD no longer holds its length on the return stack. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
01b5bbb23f
commit
c10d3a9cca
@@ -674,14 +674,33 @@ The storage service belongs to the Artemis role, now a device node.
|
||||
|
||||
| Word | Fate | Notes |
|
||||
| --- | --- | --- |
|
||||
| `HERE` `ALIGN` `ALLOT` `,` `C,` `2,` `PAD` `LATEST` | CC | The dictionary lives on the host node. |
|
||||
| `HERE` `ALIGN` `ALLOT` `,` `C,` `2,` `PAD` `LATEST` | CC | The dictionary lives on the host node; source in `v4/capsule/dict.v4`. The dictionary pointer `DP` is a byte address, so `C,` packs four characters to a cell; `HERE` is the next whole cell (a word address); `,` and `ALLOT` align first. An address unit is a cell (D-1), so `ALLOT` counts cells where v3's counted bytes; a negative count gives space back. `2,` stores the low cell first, as v3. Going outside the dictionary space stores nothing, moves nothing and sets `NODE-ERROR`. `PAD` is a fixed scratch area, as in v3, given as a byte address. `LATEST` is the xt of the newest entry, 0 if there is none (v3's pushes `HERE`, which looks like a bug; reported, not changed). Executed on the golden model's host node (2026-10-04). `,` and `ALLOT` leave their caller 6 data cells and 5 return entries. |
|
||||
| `SP@` `SP!` | RET | No visible stack pointer (D-2). |
|
||||
|
||||
### 5.13 Dictionary manipulation
|
||||
|
||||
| Word | Fate |
|
||||
| --- | --- |
|
||||
| `'` `FIND` `SMUDGE` `HIDDEN` `>BODY` `>NAME` `NAME>` `>LINK` `LINK>` `CFA` `LFA` `NFA` `PFA` `TRAVERSE` `INTERPRET` | CC |
|
||||
| `FIND` | CC | `( -- xt \| 0 )`, FORTH-79 and v3 alike: the compilation address of the next word in the input stream, or 0 if it is not in the dictionary. `32 WORD` then a search from the newest entry back, skipping hidden ones; names are case sensitive, as v3, and 31 characters are significant (FORTH-79). Executed on the golden model's host node (2026-10-04) against a list kept in C, 300 entries. Leaves its caller 4 data cells and 2 return entries. |
|
||||
| `'` | CC | `( -- addr )`, FORTH-79: the parameter field address of the next word in the input stream; not found is an error (0, and `NODE-ERROR` set). v3's `'` returned what `FIND` returns. For a word that is code the two are the same address; for a data word the parameter field is the cell after its code, which is what FORTH-79's `n ' NAME !` needs. Its compiling behaviour comes with the compiler words. Executed on the golden model's host node (2026-10-04). |
|
||||
| `>LINK` `LFA` `LINK>` `>NAME` `NFA` `NAME>` `CFA` `PFA` `>BODY` `TRAVERSE` | CC | The fields of an entry, all reached from its xt, as in v3 where the xt was the entry: `>LINK`/`LFA` the link's address, `LINK>` the older entry's xt, `>NAME`/`NFA` the byte address of the counted name, `NAME>` back to the xt, `CFA` the xt itself, `PFA`/`>BODY` the parameter field, `TRAVERSE` from a name's count byte to past its last character (for `n > 0`; otherwise unchanged, as v3). Executed on the golden model's host node (2026-10-04). |
|
||||
| `SMUDGE` `HIDDEN` | CC | `SMUDGE` toggles the hidden flag of the newest entry; `HIDDEN` sets it. v3 refuses both outside compilation; that check comes with the compiler words. Executed on the golden model's host node (2026-10-04). |
|
||||
| `INTERPRET` | CC | |
|
||||
|
||||
An entry, as `v4/capsule/dict.v4` builds it. A word's execution address (xt) is the address of its
|
||||
code, and everything else is found from it:
|
||||
|
||||
```
|
||||
name the count byte, then the characters, four bytes to a cell, zero-padded to a whole cell
|
||||
xt - 3 flags: 1 immediate, 2 hidden, 4 data
|
||||
xt - 2 the word address of the name
|
||||
xt - 1 the link: the xt of the entry before this one, 0 for the first
|
||||
xt the code
|
||||
```
|
||||
|
||||
A name holds at most 31 characters. A *data* word (one made by `CREATE`, `VARIABLE` or `CONSTANT`) is
|
||||
one whose code is a single call to its run-time routine, with its parameter field in the cell after
|
||||
it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
|
||||
### 5.14 Vocabularies
|
||||
|
||||
|
||||
@@ -0,0 +1,139 @@
|
||||
\ dict.v4 -- the dictionary: its space, its entries, and looking a name up.
|
||||
\
|
||||
\ DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND ' ,
|
||||
\ and the entry-field words >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY
|
||||
\ TRAVERSE SMUDGE HIDDEN. Part of the compiler capsule: it runs on the host
|
||||
\ node. Rests on core.v4 and input.v4.
|
||||
\
|
||||
\ AN ENTRY. A word's execution address (xt) is the address of its code, and
|
||||
\ everything else is found from it:
|
||||
\
|
||||
\ name the count byte, then the characters, four bytes to a cell,
|
||||
\ padded with zeros to a whole cell
|
||||
\ xt - 3 flags: 1 immediate, 2 hidden, 4 data
|
||||
\ xt - 2 the word address of the name
|
||||
\ xt - 1 the link: the xt of the entry before this one, 0 for the first
|
||||
\ xt the code
|
||||
\
|
||||
\ A name holds at most 31 characters; longer ones are cut to 31 both when
|
||||
\ defined and when looked up, so 31 characters are significant (FORTH-79).
|
||||
\ A "data" word is one whose code is a single call to its run-time routine,
|
||||
\ with its parameter field in the cell after it: xt + 1. For any other word
|
||||
\ the parameter field is the code itself.
|
||||
\
|
||||
\ THE SPACE. DP is a byte address, so that C, can pack characters; HERE is
|
||||
\ the next whole cell. An address unit is a cell (D-1): ALLOT counts cells.
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ DP word address of the variable: the next free byte
|
||||
\ (LATEST) word address of the variable: the xt of the newest entry, or 0
|
||||
\ DBASE DLIMIT byte addresses of the start and end of dictionary space
|
||||
\ PAD byte address of the scratch area for strings, 84 bytes or more
|
||||
\ (D) word address of two cells of scratch for this file
|
||||
\ PAD is in line.
|
||||
|
||||
macro 4* 2* 2* endmacro
|
||||
macro 4/ 2/ 2/ endmacro
|
||||
macro OR over inv and xor endmacro
|
||||
|
||||
\ ---- the space (5.12) ------------------------------------------------------
|
||||
|
||||
: (DERR) ( -- 0 ) NODE-ERROR b! -1 !b 0 ;
|
||||
|
||||
\ ( n -- flag ) move DP by n bytes if it stays inside the dictionary space
|
||||
\ and say -1; otherwise leave it, set NODE-ERROR and say 0.
|
||||
: (DP+)
|
||||
DP a! @ +
|
||||
dup DBASE - -if LOW drop drop jump (DERR)
|
||||
LOW: drop DLIMIT over - -if HIGH drop drop jump (DERR)
|
||||
HIGH: drop DP a! ! -1 ;
|
||||
|
||||
: HERE ( -- addr ) DP a! @ 3 + 4/ ;
|
||||
: ALIGN ( -- ) DP a! @ 3 + -4 and DP a! ! ;
|
||||
: ALLOT ( n -- ) ALIGN 4* (DP+) drop ;
|
||||
|
||||
: , ( x -- )
|
||||
ALIGN HERE push 4 (DP+) if FULL drop pop a! ! ;
|
||||
FULL: drop pop drop drop ;
|
||||
: C, ( c -- )
|
||||
DP a! @ push 1 (DP+) if FULL drop pop C! ;
|
||||
FULL: drop pop drop drop ;
|
||||
: 2, ( lo hi -- ) SWAP , , ; \ the low cell first, as v3
|
||||
|
||||
: LATEST ( -- xt ) (LATEST) a! @ ;
|
||||
|
||||
\ ---- the fields of an entry (5.13) -----------------------------------------
|
||||
|
||||
: (FLAGS) ( xt -- addr ) -3 + ;
|
||||
: >LINK ( xt -- addr ) -1 + ;
|
||||
: LFA ( xt -- addr ) jump >LINK
|
||||
: LINK> ( addr -- xt ) a! @ ;
|
||||
: >NAME ( xt -- baddr ) -2 + a! @ 4* ;
|
||||
: NFA ( xt -- baddr ) jump >NAME
|
||||
: NAME> ( baddr -- xt ) dup C@ 31 and 4 + 4/ push 4/ pop + 3 + ;
|
||||
: CFA ( xt -- xt ) ;
|
||||
: PFA ( xt -- addr ) dup (FLAGS) a! @ 4 and if CODE drop 1 + ; CODE: drop ;
|
||||
: >BODY ( xt -- addr ) jump PFA
|
||||
|
||||
\ ( baddr n -- baddr' ) as v3: for n > 0, from a name's count byte to the
|
||||
\ byte after its last character; otherwise the address unchanged.
|
||||
: TRAVERSE
|
||||
-if NN drop ;
|
||||
NN: if ZERO drop dup C@ 31 and + 1 + ;
|
||||
ZERO: drop ;
|
||||
|
||||
: SMUDGE ( -- ) LATEST if NONE (FLAGS) a! @ 2 xor ! ; NONE: drop ;
|
||||
: HIDDEN ( -- ) LATEST if NONE (FLAGS) a! @ 2 OR ! ; NONE: drop ;
|
||||
|
||||
\ ---- making an entry -------------------------------------------------------
|
||||
|
||||
\ ( baddr -- baddr ) cut the counted string to 31 characters, in place
|
||||
: (CLIP) dup C@ -32 + -if LONG drop ; LONG: drop 31 over C! ;
|
||||
|
||||
\ ( baddr -- ) an entry for the counted string at baddr; its code starts at
|
||||
\ HERE afterwards. An empty name, or no room, makes nothing and sets
|
||||
\ NODE-ERROR.
|
||||
: (HEADER)
|
||||
(CLIP) dup C@ if EMPTY \ baddr len
|
||||
ALIGN
|
||||
dup 4 + -4 and 12 + \ baddr len need bytes: name cells and three more
|
||||
dup (DP+) if FULL drop NEGATE (DP+) drop \ there is room; DP back where it was
|
||||
HERE (D) a! ! \ where the name starts
|
||||
dup C, \ baddr len
|
||||
L: if DONE SWAP 1 + dup C@ C, SWAP -1 + jump L \ nothing on R across C,
|
||||
DONE: drop drop
|
||||
P: DP a! @ 3 and if ALIGNED drop 0 C, jump P
|
||||
ALIGNED: drop
|
||||
0 , (D) a! @ , LATEST ,
|
||||
HERE (LATEST) a! ! ;
|
||||
FULL: drop drop
|
||||
EMPTY: drop drop NODE-ERROR b! -1 !b ;
|
||||
|
||||
\ ---- looking a name up -----------------------------------------------------
|
||||
|
||||
\ ( baddr1 baddr2 -- flag ) two counted strings are the same
|
||||
: (NAME=)
|
||||
over C@ 1 + \ b1 b2 n the count byte and the characters
|
||||
L: if SAME push
|
||||
over C@ over C@ xor if EQ drop drop drop pop drop 0 ;
|
||||
EQ: drop 1 + push 1 + pop pop -1 + jump L
|
||||
SAME: drop drop drop -1 ;
|
||||
|
||||
\ ( baddr -- xt | 0 ) the newest visible entry named by the counted string
|
||||
: (LOOKUP)
|
||||
(CLIP) (D) 1 + a! !
|
||||
LATEST
|
||||
L: if END
|
||||
dup (FLAGS) a! @ 2 and if VISIBLE jump OLDER
|
||||
VISIBLE: drop dup >NAME (D) 1 + a! @ (NAME=) if OLDER drop ;
|
||||
OLDER: drop >LINK a! @ jump L
|
||||
END: ;
|
||||
|
||||
\ ( -- xt | 0 ) FORTH-79: the compilation address of the next word in the
|
||||
\ input stream, or 0 if it is not in the dictionary.
|
||||
: FIND 32 WORD jump (LOOKUP)
|
||||
|
||||
\ ( -- addr ) FORTH-79: the parameter field address of the next word in the
|
||||
\ input stream. Not found is an error: 0, and NODE-ERROR is set.
|
||||
: ' 32 WORD (LOOKUP) if MISSING jump PFA
|
||||
MISSING: drop jump (DERR)
|
||||
+6
-4
@@ -42,7 +42,8 @@ macro BL 32 endmacro
|
||||
: QUERY TIB 80 EXPECT 0 >IN a! ! ;
|
||||
|
||||
\ ---- WORD ------------------------------------------------------------------
|
||||
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB.
|
||||
\ (P)+0 the delimiter, (P)+1 the length of the text in TIB, (P)+2 the length
|
||||
\ of the word (CONVERT uses (P)+2 too; the two never run inside each other).
|
||||
macro (WDELIM) (P) endmacro
|
||||
macro (WLEN) (P) 1 + endmacro
|
||||
|
||||
@@ -70,11 +71,12 @@ macro (WLEN) (P) 1 + endmacro
|
||||
pop over over - \ end start len
|
||||
dup -256 + -if CAP drop jump FITS CAP: drop drop 255 FITS:
|
||||
dup WBUF C!
|
||||
dup push push TIB + WBUF 1 + pop CMOVE \ end R: len
|
||||
dup (P) 2 + a! ! \ the length waits in (P)+2, not on a stack
|
||||
push TIB + WBUF 1 + pop CMOVE \ end
|
||||
(LEFT) -if RANOUT
|
||||
drop (WDELIM) a! @ pop WBUF + 1 + C! \ the delimiter after the text
|
||||
drop (WDELIM) a! @ (P) 2 + a! @ WBUF + 1 + C! \ the delimiter after the text
|
||||
1 + >IN a! ! WBUF ;
|
||||
RANOUT: drop 0 pop WBUF + 1 + C!
|
||||
RANOUT: drop 0 (P) 2 + a! @ WBUF + 1 + C!
|
||||
>IN a! ! WBUF ;
|
||||
|
||||
\ ---- ENCLOSE ---------------------------------------------------------------
|
||||
|
||||
@@ -0,0 +1,444 @@
|
||||
/* test_host_dict.c -- the dictionary, executed on the host node.
|
||||
*
|
||||
* DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND
|
||||
* and ', and the entry-field words. The definitions are text,
|
||||
* capsule/dict.v4, on top of core.v4 and input.v4.
|
||||
*
|
||||
* v4's dictionary is new: v3's was a C structure and its words handed out
|
||||
* host pointers. What carries over is what the words mean:
|
||||
* HERE the next free address , C, 2, append a cell, a byte, a double
|
||||
* ALLOT reserve space ALIGN round the pointer up to a cell
|
||||
* FIND ( -- xt | 0 ) the word named next in the input, 0 if there is none
|
||||
* (v3 and FORTH-79 agree, and so does v4)
|
||||
* ' FORTH-79: its parameter field address; not found is an error.
|
||||
* v3's ' returned what FIND returns. For a word that is code the
|
||||
* two are the same address; for a data word (one made by CREATE,
|
||||
* VARIABLE or CONSTANT) the parameter field is the cell after its
|
||||
* code, which is what FORTH-79's n ' NAME ! idiom needs.
|
||||
* xt as in v3, the one handle the field words take: >LINK LFA LINK>
|
||||
* >NAME NFA NAME> CFA PFA >BODY
|
||||
* An address unit is a cell (D-1), so ALLOT counts cells where v3's counted
|
||||
* bytes, and HERE moves by 1 for a cell where v3's moved by 8.
|
||||
*
|
||||
* v3's LATEST pushes HERE, not the latest word (reported, not fixed); here
|
||||
* it is the newest entry's xt.
|
||||
*/
|
||||
#include "v4/text.h"
|
||||
#include "v4/testcode.h"
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
static int failures = 0, checks = 0;
|
||||
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
|
||||
|
||||
#define CANARY ((v4_cell)0x0C0FFEE5)
|
||||
|
||||
/* The memory map is open (D-4); the test chooses it. */
|
||||
#define TOP ((v4_cell)V4_NODE_WORDS)
|
||||
#define NODE_ERROR (TOP - 2)
|
||||
#define CONSOLE_TX (TOP - 4)
|
||||
#define CONSOLE_RX (TOP - 6)
|
||||
#define CONSOLE_ST (TOP - 7)
|
||||
#define BASE (TOP - 8)
|
||||
#define TO_IN (TOP - 9)
|
||||
#define SPAN (TOP - 10)
|
||||
#define PVARS (TOP - 16)
|
||||
#define DP (TOP - 17)
|
||||
#define LATEST (TOP - 18)
|
||||
#define DVARS (TOP - 20) /* two cells */
|
||||
#define WBUF_W (TOP - 90)
|
||||
#define TIB_W (TOP - 360)
|
||||
#define SBUF_W (TOP - 440)
|
||||
#define PAD_W (TOP - 470)
|
||||
#define WBUF (WBUF_W * 4)
|
||||
#define TIB (TIB_W * 4)
|
||||
#define SBUF (SBUF_W * 4)
|
||||
#define PAD (PAD_W * 4)
|
||||
#define DICT_W ((v4_cell)4096) /* dictionary space: words 4096 .. 8191 */
|
||||
#define DICT_END_W ((v4_cell)8192)
|
||||
#define GUARD ((v4_cell)0x5EED5EED)
|
||||
|
||||
static v4_node n;
|
||||
static v4_exec_state es;
|
||||
static v4_heat h;
|
||||
static v4_text tx;
|
||||
|
||||
static unsigned char byte_at(v4_cell baddr)
|
||||
{
|
||||
return (unsigned char)(((v4_ucell)n.mem[baddr >> 2] >> (8u * (unsigned)(baddr & 3))) & 0xFFu);
|
||||
}
|
||||
static void put_bytes(v4_cell baddr, const void *src, unsigned len)
|
||||
{
|
||||
const unsigned char *s = (const unsigned char *)src;
|
||||
for (unsigned i = 0; i < len; i++) {
|
||||
v4_cell ba = baddr + (v4_cell)i;
|
||||
unsigned sh = 8u * (unsigned)(ba & 3);
|
||||
v4_ucell w = (v4_ucell)n.mem[ba >> 2];
|
||||
n.mem[ba >> 2] = (v4_cell)((w & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)s[i] << sh));
|
||||
}
|
||||
}
|
||||
static void set_line(const char *s)
|
||||
{
|
||||
unsigned len = (unsigned)strlen(s);
|
||||
put_bytes(TIB, s, len + 1u);
|
||||
n.mem[SPAN] = (v4_cell)len;
|
||||
n.mem[TO_IN] = 0;
|
||||
}
|
||||
static v4_cell W(const char *name)
|
||||
{
|
||||
v4_cell w = v4_text_word(&tx, name);
|
||||
if (w < 0) { failures++; printf("FAIL: no word %s\n", name); }
|
||||
return w;
|
||||
}
|
||||
static void fresh(void)
|
||||
{
|
||||
v4_dstack_reset(&n.ds);
|
||||
v4_rstack_reset(&n.rs);
|
||||
v4_exec_reset(&es);
|
||||
v4_heat_reset(&h);
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
}
|
||||
static int go(const char *name) { return v4_test_call(&n, &es, &h, W(name), 4000000) > 0; }
|
||||
static int run(const char *name, unsigned argc, v4_cell a, v4_cell b)
|
||||
{
|
||||
fresh();
|
||||
if (argc > 0) v4_dstack_push(&n.ds, a);
|
||||
if (argc > 1) v4_dstack_push(&n.ds, b);
|
||||
return go(name);
|
||||
}
|
||||
static v4_cell pop(void) { return v4_dstack_pop(&n.ds); }
|
||||
static int clean(void) { return pop() == CANARY; }
|
||||
static int err(void) { return n.mem[NODE_ERROR] != 0; }
|
||||
/* word ( -- x ) or ( a -- x ): its one result, or a value no test expects */
|
||||
static v4_cell get(const char *name, unsigned argc, v4_cell a)
|
||||
{
|
||||
v4_cell r;
|
||||
if (!run(name, argc, a, 0)) return (v4_cell)0x0BADBAD;
|
||||
r = pop();
|
||||
return clean() ? r : (v4_cell)0x0BADBAD;
|
||||
}
|
||||
|
||||
static void empty_dictionary(void)
|
||||
{
|
||||
for (v4_cell i = DICT_W - 1; i <= DICT_END_W; i++) n.mem[i] = GUARD;
|
||||
n.mem[DP] = DICT_W * 4;
|
||||
n.mem[LATEST] = 0;
|
||||
}
|
||||
|
||||
/* Make an entry named `name` through WORD and (HEADER); its xt, or 0 if
|
||||
* none was made. */
|
||||
static v4_cell define(const char *name)
|
||||
{
|
||||
v4_cell was = n.mem[LATEST];
|
||||
set_line(name);
|
||||
if (!run("MAKE", 0, 0, 0) || !clean()) return 0;
|
||||
return n.mem[LATEST] != was ? n.mem[LATEST] : 0;
|
||||
}
|
||||
/* FIND on the text `name`. */
|
||||
static v4_cell find(const char *name)
|
||||
{
|
||||
set_line(name);
|
||||
return get("FIND", 0, 0);
|
||||
}
|
||||
/* The counted name of entry xt is `want` (cut to 31), zero-padded to a cell,
|
||||
* and its fields are in place. */
|
||||
static int entry_is(v4_cell xt, const char *want, v4_cell link, v4_cell flags)
|
||||
{
|
||||
unsigned len = (unsigned)strlen(want), cells, i;
|
||||
v4_cell nfa;
|
||||
if (len > 31) len = 31;
|
||||
cells = (len + 4) / 4;
|
||||
nfa = xt - 3 - (v4_cell)cells;
|
||||
if (n.mem[xt - 1] != link || n.mem[xt - 2] != nfa || n.mem[xt - 3] != flags) return 0;
|
||||
if (byte_at(nfa * 4) != len) return 0;
|
||||
for (i = 0; i < len; i++) if (byte_at(nfa * 4 + 1 + (v4_cell)i) != (unsigned char)want[i]) return 0;
|
||||
for (i = len + 1; i < cells * 4; i++) if (byte_at(nfa * 4 + (v4_cell)i) != 0) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static uint32_t rng = 0x1234ABCDu;
|
||||
static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; }
|
||||
|
||||
/* Stack headroom, as in test_foundation.c. */
|
||||
typedef void (*setup_fn)(void);
|
||||
static int fits(const char *name, setup_fn setup, unsigned argc, v4_cell a, unsigned nres, const v4_cell *want,
|
||||
unsigned dfill, unsigned rfill)
|
||||
{
|
||||
unsigned i;
|
||||
setup();
|
||||
v4_dstack_reset(&n.ds);
|
||||
v4_rstack_reset(&n.rs);
|
||||
v4_exec_reset(&es);
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
for (i = 0; i < dfill; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
if (argc > 0) v4_dstack_push(&n.ds, a);
|
||||
for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
|
||||
if (!go(name)) return 0;
|
||||
for (i = nres; i-- > 0; ) if (pop() != want[i]) return 0;
|
||||
if (pop() != CANARY) return 0;
|
||||
for (i = dfill; i-- > 0; ) if (pop() != (v4_cell)(0x5A000000 + i)) return 0;
|
||||
for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0;
|
||||
return !err();
|
||||
}
|
||||
static void headroom(const char *name, setup_fn setup, unsigned argc, v4_cell a, unsigned nres, int min_d, int min_r)
|
||||
{
|
||||
v4_cell want[2];
|
||||
unsigned i;
|
||||
int dh, rh;
|
||||
setup();
|
||||
CHECK(run(name, argc, a, 0), "%s runs", name);
|
||||
for (i = nres; i-- > 0; ) want[i] = pop();
|
||||
for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(name, setup, argc, a, nres, want, (unsigned)dh + 1u, 0)) break;
|
||||
for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(name, setup, argc, a, nres, want, 0, (unsigned)rh + 1u)) break;
|
||||
printf(" %-8s headroom: data %d below canary, return %d below its return address\n", name, dh, rh);
|
||||
CHECK(dh >= min_d && rh >= min_r, "%s leaves room", name);
|
||||
}
|
||||
static void setup_three(void)
|
||||
{
|
||||
empty_dictionary();
|
||||
(void)define("ALPHA"); (void)define("BETA"); (void)define("GAMMA");
|
||||
set_line("ALPHA rest");
|
||||
}
|
||||
static void setup_new(void) { empty_dictionary(); set_line("NEWWORD rest"); }
|
||||
|
||||
int main(void)
|
||||
{
|
||||
unsigned i, t;
|
||||
v4_cell a, b, c;
|
||||
|
||||
printf("v4 host dictionary tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
v4_node_reset(&n);
|
||||
v4_text_begin(&tx, &n, 16);
|
||||
v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
|
||||
v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
|
||||
v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
|
||||
v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
|
||||
v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
|
||||
v4_text_constant(&tx, "BASE", BASE);
|
||||
v4_text_constant(&tx, "TIB", TIB);
|
||||
v4_text_constant(&tx, ">IN", TO_IN);
|
||||
v4_text_constant(&tx, "SPAN", SPAN);
|
||||
v4_text_constant(&tx, "WBUF", WBUF);
|
||||
v4_text_constant(&tx, "(P)", PVARS);
|
||||
v4_text_constant(&tx, "DP", DP);
|
||||
v4_text_constant(&tx, "(LATEST)", LATEST);
|
||||
v4_text_constant(&tx, "DBASE", DICT_W * 4);
|
||||
v4_text_constant(&tx, "DLIMIT", DICT_END_W * 4);
|
||||
v4_text_constant(&tx, "PAD", PAD);
|
||||
v4_text_constant(&tx, "(D)", DVARS);
|
||||
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/dict.v4"), "dict.v4 assembles: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_assemble(&tx,
|
||||
": MAKE ( -- ) 32 WORD jump (HEADER)\n"
|
||||
": 'PAD PAD ;\n"
|
||||
": DATA! ( -- ) LATEST (FLAGS) a! @ 4 OR ! ;\n" /* what CREATE will do */
|
||||
": IMM! ( -- ) LATEST (FLAGS) a! @ 1 OR ! ;\n"), /* what IMMEDIATE will do */
|
||||
"wrappers: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
|
||||
printf(" code: %ld words\n", (long)v4_text_here(&tx) - 16);
|
||||
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
|
||||
n.mem[BASE] = 10;
|
||||
|
||||
/* ---- the space: HERE , C, 2, ALIGN ALLOT ---- */
|
||||
empty_dictionary();
|
||||
CHECK(get("HERE", 0, 0) == DICT_W, "HERE starts at the dictionary's first cell");
|
||||
CHECK(run(",", 1, 111, 0) && clean() && !err() && n.mem[DICT_W] == 111 && get("HERE", 0, 0) == DICT_W + 1, ", stores a cell and HERE moves by 1");
|
||||
CHECK(run(",", 1, -222, 0) && clean() && n.mem[DICT_W + 1] == -222 && get("HERE", 0, 0) == DICT_W + 2, "the next cell");
|
||||
|
||||
/* C, packs four to a cell; HERE is the next whole cell; , aligns first */
|
||||
n.mem[DICT_W + 2] = 0;
|
||||
for (i = 0; i < 4; i++) {
|
||||
CHECK(run("C,", 1, (v4_cell)(0x100 + 'a' + i), 0) && clean() && !err(), "C, [%u]", i);
|
||||
CHECK(byte_at((DICT_W + 2) * 4 + (v4_cell)i) == 'a' + i, "C, stores the low byte at the next byte [%u]", i);
|
||||
CHECK(get("HERE", 0, 0) == DICT_W + 3, "HERE is the next whole cell after %u bytes", i + 1);
|
||||
}
|
||||
CHECK(run("C,", 1, 'e', 0) && clean() && get("HERE", 0, 0) == DICT_W + 4 && n.mem[DP] == (DICT_W + 3) * 4 + 1, "a fifth byte starts another cell");
|
||||
CHECK(run(",", 1, 333, 0) && clean() && n.mem[DICT_W + 4] == 333 && n.mem[DP] == (DICT_W + 5) * 4, ", after C, goes in the next whole cell");
|
||||
CHECK(byte_at((DICT_W + 3) * 4) == 'e', "and leaves the byte alone");
|
||||
CHECK(run("C,", 1, 'f', 0) && clean() && run("ALIGN", 0, 0, 0) && clean() && n.mem[DP] == (DICT_W + 6) * 4, "ALIGN rounds up to a cell");
|
||||
CHECK(run("ALIGN", 0, 0, 0) && clean() && n.mem[DP] == (DICT_W + 6) * 4, "ALIGN when aligned does nothing");
|
||||
|
||||
/* 2, : the low cell first, as v3 (HERE 1 2 2, : the first cell holds 1) */
|
||||
CHECK(run("2,", 2, 1, 2) && clean() && n.mem[DICT_W + 6] == 1 && n.mem[DICT_W + 7] == 2 && get("HERE", 0, 0) == DICT_W + 8, "v3: 2, stores the low cell first");
|
||||
|
||||
/* ALLOT counts cells */
|
||||
CHECK(run("ALLOT", 1, 5, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_W + 13, "5 ALLOT reserves five cells");
|
||||
CHECK(run("ALLOT", 1, 0, 0) && clean() && get("HERE", 0, 0) == DICT_W + 13, "0 ALLOT reserves none");
|
||||
CHECK(run("ALLOT", 1, -3, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_W + 10, "-3 ALLOT gives three back");
|
||||
CHECK(run("C,", 1, 'x', 0) && run("ALLOT", 1, 2, 0) && clean() && get("HERE", 0, 0) == DICT_W + 13
|
||||
&& n.mem[DP] == (DICT_W + 13) * 4, "ALLOT aligns first");
|
||||
CHECK(n.mem[DICT_W - 1] == GUARD, "nothing below the dictionary space written");
|
||||
|
||||
/* the ends of the space */
|
||||
empty_dictionary();
|
||||
CHECK(run("ALLOT", 1, -1, 0) && clean() && err() && get("HERE", 0, 0) == DICT_W, "ALLOT below the start is refused and sets NODE-ERROR");
|
||||
CHECK(run("ALLOT", 1, DICT_END_W - DICT_W, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_END_W, "the whole space can be allotted");
|
||||
CHECK(run(",", 1, 99, 0) && clean() && err() && n.mem[DICT_END_W] == GUARD && get("HERE", 0, 0) == DICT_END_W, ", into a full dictionary stores nothing and sets NODE-ERROR");
|
||||
CHECK(run("C,", 1, 99, 0) && clean() && err() && n.mem[DICT_END_W] == GUARD, "so does C,");
|
||||
CHECK(run("ALLOT", 1, 1, 0) && clean() && err() && get("HERE", 0, 0) == DICT_END_W, "and ALLOT");
|
||||
CHECK(run("ALLOT", 1, -1, 0) && clean() && !err() && run(",", 1, 77, 0) && clean() && !err() && n.mem[DICT_END_W - 1] == 77, "the last cell can be used");
|
||||
CHECK(get("'PAD", 0, 0) == PAD, "PAD is its buffer's byte address");
|
||||
|
||||
/* ---- entries ---- */
|
||||
empty_dictionary();
|
||||
CHECK(get("LATEST", 0, 0) == 0, "LATEST is 0 in an empty dictionary");
|
||||
a = define("ALPHA");
|
||||
CHECK(a == DICT_W + 2 + 3 && !err(), "an entry's xt follows its name and three cells: %ld", (long)a);
|
||||
CHECK(entry_is(a, "ALPHA", 0, 0), "the first entry: name, no flags, link 0");
|
||||
CHECK(get("LATEST", 0, 0) == a && get("HERE", 0, 0) == a, "LATEST is its xt, and its code starts at HERE");
|
||||
CHECK(run(",", 1, 1001, 0) && clean(), "some code");
|
||||
b = define("B");
|
||||
CHECK(b == a + 1 + 1 + 3 && entry_is(b, "B", a, 0), "the second entry links to the first");
|
||||
(void)run(",", 1, 1002, 0);
|
||||
c = define("GAMMA-DELTA");
|
||||
CHECK(c == b + 1 + 3 + 3 && entry_is(c, "GAMMA-DELTA", b, 0), "an eleven-character name takes three cells");
|
||||
CHECK(get("LATEST", 0, 0) == c, "LATEST is the newest");
|
||||
|
||||
/* the field words, all from the xt */
|
||||
CHECK(get(">LINK", 1, c) == c - 1 && get("LFA", 1, c) == c - 1, ">LINK and LFA are the link's address");
|
||||
CHECK(get("LINK>", 1, c - 1) == b && get("LINK>", 1, b - 1) == a && get("LINK>", 1, a - 1) == 0, "LINK> follows it, to 0 at the end");
|
||||
CHECK(get(">NAME", 1, c) == (c - 6) * 4 && get("NFA", 1, c) == (c - 6) * 4, ">NAME and NFA are the name's byte address");
|
||||
CHECK(byte_at(get(">NAME", 1, b)) == 1 && byte_at(get(">NAME", 1, b) + 1) == 'B', "which is its count byte, then its characters");
|
||||
CHECK(get("NAME>", 1, get(">NAME", 1, a)) == a && get("NAME>", 1, get(">NAME", 1, b)) == b && get("NAME>", 1, get(">NAME", 1, c)) == c, "NAME> goes back to the xt");
|
||||
CHECK(get("CFA", 1, c) == c, "CFA is the xt itself, as v3");
|
||||
CHECK(get("PFA", 1, c) == c && get(">BODY", 1, c) == c, "the parameter field of a code word is its code");
|
||||
CHECK(run("DATA!", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "(marking the newest a data word)");
|
||||
CHECK(get("PFA", 1, c) == c + 1 && get(">BODY", 1, c) == c + 1, "the parameter field of a data word is the cell after its code");
|
||||
CHECK(get("PFA", 1, b) == b, "and the others are unchanged");
|
||||
{
|
||||
v4_cell nfa = get(">NAME", 1, c);
|
||||
CHECK(run("TRAVERSE", 2, nfa, 1) && pop() == nfa + 12 && clean(), "TRAVERSE forward goes past the name's last character");
|
||||
CHECK(run("TRAVERSE", 2, nfa, 5) && pop() == nfa + 12 && clean(), "for any positive n");
|
||||
CHECK(run("TRAVERSE", 2, nfa, -1) && pop() == nfa && clean(), "TRAVERSE backward leaves the address, as v3");
|
||||
CHECK(run("TRAVERSE", 2, nfa, 0) && pop() == nfa && clean(), "and so does 0");
|
||||
}
|
||||
|
||||
/* SMUDGE toggles the newest entry's hidden bit; HIDDEN sets it */
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 6, "SMUDGE hides the newest entry, keeping its other flags");
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "SMUDGE again shows it");
|
||||
CHECK(run("HIDDEN", 0, 0, 0) && clean() && n.mem[c - 3] == 6 && run("HIDDEN", 0, 0, 0) && clean() && n.mem[c - 3] == 6, "HIDDEN hides it, once or twice");
|
||||
CHECK(n.mem[b - 3] == 0 && n.mem[a - 3] == 0, "the others are untouched");
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "shown again");
|
||||
empty_dictionary();
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && clean() && run("HIDDEN", 0, 0, 0) && clean() && n.mem[DICT_W] == GUARD && n.mem[DICT_W - 1] == GUARD,
|
||||
"SMUDGE and HIDDEN do nothing in an empty dictionary");
|
||||
|
||||
/* names: empty, long, and the edge of the space */
|
||||
empty_dictionary();
|
||||
CHECK(define("") == 0 && err() && get("HERE", 0, 0) == DICT_W && n.mem[LATEST] == 0, "an empty name makes nothing and sets NODE-ERROR");
|
||||
{
|
||||
char long31[40], long40[48];
|
||||
memset(long31, 'q', 31); long31[31] = 0;
|
||||
memset(long40, 'q', 40); long40[40] = 0;
|
||||
a = define(long31);
|
||||
CHECK(a == DICT_W + 8 + 3 && entry_is(a, long31, 0, 0), "a 31-character name is kept whole");
|
||||
b = define(long40);
|
||||
CHECK(b != 0 && entry_is(b, long31, a, 0) && b - a == 8 + 3, "a 40-character name is cut to 31");
|
||||
}
|
||||
empty_dictionary();
|
||||
n.mem[DP] = (DICT_END_W - 4) * 4;
|
||||
CHECK(define("ABCD") == 0 && err() && n.mem[LATEST] == 0 && n.mem[DP] == (DICT_END_W - 4) * 4 && n.mem[DICT_END_W - 4] == GUARD,
|
||||
"an entry that does not fit makes nothing, moves nothing, and sets NODE-ERROR");
|
||||
n.mem[DP] = (DICT_END_W - 5) * 4;
|
||||
CHECK(define("ABCD") == DICT_END_W && !err() && n.mem[DICT_END_W] == GUARD, "one that just fits is made");
|
||||
|
||||
/* ---- FIND ---- */
|
||||
empty_dictionary();
|
||||
CHECK(find("ANYTHING") == 0 && !err(), "FIND in an empty dictionary is 0, and no error");
|
||||
a = define("ALPHA"); (void)run(",", 1, 1, 0);
|
||||
b = define("BETA"); (void)run(",", 1, 2, 0);
|
||||
c = define("GAMMA"); (void)run(",", 1, 3, 0);
|
||||
CHECK(find("ALPHA") == a && find("BETA") == b && find("GAMMA") == c && !err(), "FIND finds each word");
|
||||
CHECK(find("DELTA") == 0 && find("ALPH") == 0 && find("ALPHAS") == 0 && find("LPHA") == 0 && !err(), "and not what is not there, nor a part of a name");
|
||||
CHECK(find("alpha") == 0 && find("Alpha") == 0, "names are case sensitive, as v3");
|
||||
CHECK(find(" BETA and more") == b && n.mem[TO_IN] == 8, "FIND takes the next word of the input stream and leaves >IN after it");
|
||||
CHECK(find("") == 0 && find(" ") == 0 && !err(), "at the end of the input it is 0");
|
||||
{
|
||||
v4_cell a2 = define("ALPHA");
|
||||
CHECK(a2 != 0 && a2 != a && find("ALPHA") == a2, "a later word of the same name is the one found");
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && find("ALPHA") == a, "hidden, the earlier one is found again");
|
||||
CHECK(run("SMUDGE", 0, 0, 0) && find("ALPHA") == a2, "shown, the later");
|
||||
CHECK(run("HIDDEN", 0, 0, 0) && find("ALPHA") == a && find("BETA") == b, "HIDDEN hides only the newest");
|
||||
}
|
||||
/* 31 characters are significant */
|
||||
{
|
||||
char n31[40], n32a[40], n32b[40], n30[40];
|
||||
empty_dictionary();
|
||||
memset(n31, 'k', 31); n31[31] = 0;
|
||||
memcpy(n32a, n31, 31); n32a[31] = 'X'; n32a[32] = 0;
|
||||
memcpy(n32b, n31, 31); n32b[31] = 'Y'; n32b[32] = 0;
|
||||
memset(n30, 'k', 30); n30[30] = 0;
|
||||
a = define(n32a);
|
||||
CHECK(find(n32a) == a && find(n32b) == a && find(n31) == a, "names that agree in their first 31 characters are the same name");
|
||||
CHECK(find(n30) == 0, "one that is shorter is not");
|
||||
n31[30] = 'j';
|
||||
CHECK(find(n31) == 0, "nor one that differs in the 31st");
|
||||
}
|
||||
|
||||
/* ---- ' ---- */
|
||||
empty_dictionary();
|
||||
a = define("CODEWORD"); (void)run(",", 1, 1, 0);
|
||||
b = define("DATAWORD"); (void)run("DATA!", 0, 0, 0); (void)run(",", 1, 2, 0); (void)run(",", 1, 55, 0);
|
||||
set_line("CODEWORD x");
|
||||
CHECK(get("'", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
|
||||
set_line("DATAWORD");
|
||||
CHECK(get("'", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
|
||||
set_line("NOSUCHWORD");
|
||||
CHECK(get("'", 0, 0) == 0 && err(), "' of a word that is not there is an error");
|
||||
|
||||
/* ---- many words, against a list kept in C ---- */
|
||||
{
|
||||
static char names[300][36];
|
||||
static v4_cell xts[300];
|
||||
unsigned count = 0;
|
||||
empty_dictionary();
|
||||
for (t = 0; t < 300; t++) {
|
||||
unsigned len = 1 + rnd() % (t % 7 == 0 ? 34 : 9), dup = 0;
|
||||
char *nm = names[count];
|
||||
for (i = 0; i < len; i++) nm[i] = (char)("ABCDEFGHab01-+*/!@"[rnd() % 18]);
|
||||
nm[len] = 0;
|
||||
xts[count] = define(nm);
|
||||
CHECK(xts[count] != 0 && !err(), "defining \"%s\"", nm);
|
||||
(void)run(",", 1, (v4_cell)t, 0);
|
||||
if (len > 31) nm[31] = 0;
|
||||
for (i = 0; i < count; i++) if (strcmp(names[i], nm) == 0) dup = 1;
|
||||
(void)dup;
|
||||
count++;
|
||||
}
|
||||
for (t = 0; t < count; t++) {
|
||||
v4_cell want = 0;
|
||||
for (i = 0; i < count; i++) if (strcmp(names[i], names[t]) == 0) want = xts[i]; /* the newest of that name */
|
||||
CHECK(find(names[t]) == want, "FIND \"%s\"", names[t]);
|
||||
}
|
||||
/* walk the links from LATEST: every entry, newest first, then 0 */
|
||||
{
|
||||
v4_cell xt = get("LATEST", 0, 0);
|
||||
for (t = count; t-- > 0; ) {
|
||||
if (xt != xts[t]) break;
|
||||
if (get("NAME>", 1, get(">NAME", 1, xt)) != xt) break;
|
||||
xt = get("LINK>", 1, get(">LINK", 1, xt));
|
||||
}
|
||||
CHECK(t == (unsigned)-1 && xt == 0, "the links run through all %u entries, newest first", count);
|
||||
}
|
||||
printf(" %u entries in %ld cells\n", count, (long)(get("HERE", 0, 0) - DICT_W));
|
||||
CHECK(n.mem[DICT_W - 1] == GUARD && n.mem[DICT_END_W] == GUARD, "nothing outside the dictionary space written");
|
||||
}
|
||||
|
||||
/* What they leave their caller (D-2). */
|
||||
headroom("FIND", setup_three, 0, 0, 1, 3, 2);
|
||||
headroom("'", setup_three, 0, 0, 1, 3, 2);
|
||||
headroom("MAKE", setup_new, 0, 0, 0, 3, 2);
|
||||
headroom(",", setup_new, 1, 42, 0, 5, 5);
|
||||
headroom("ALLOT", setup_new, 1, 3, 0, 5, 5);
|
||||
|
||||
CHECK(v4_node_guards_intact(&n), "guards intact");
|
||||
|
||||
printf(" %d checks, %d failures\n", checks, failures);
|
||||
return failures ? 1 : 0;
|
||||
}
|
||||
Reference in New Issue
Block a user