feat(v4): every word but the ten is called, so it can be checked
Plan 2026-10-20 (ENGINE step 4), Task A2, for #189. Captain Bob, 2026-11-13: "The ten"; "Accept it". - compile.f18 (COMPILE,): a word is copied in line only when it is flagged in-line and compile-only (24) -- the ten that work on the return stack, >R R> R@ I J LEAVE and the later UNLOOP 2>R 2R> 2R@. Every other word, in-line ones too, is a call the hook at `call` sees. - EXECUTE calls the xt: `call xt` (opcode 3, slot 0) and a ; in (EXEC), run. INTERPRET runs a word by (GO): `call xt` and `jump (IL)` in (RUNX), entered by a jump, at the old return-stack depth. - host_map.h: (EXEC) BUF0_W-22, (RUNX) BUF0_W-115, from what was free. - Its cost, accepted: one return entry at the bottom of a chain (30 deep from the prompt, not 31) and one per explicit EXECUTE while its word runs; the hosted boot +2.4% (2.917 s to 2.987 s), instructions +0.4%. - Tests first (logs/20261113-045122/a2): inline_words_are_called, residue_stays_inline, execute_passes_the_hook, rstack_kept_across_call, abandoned_definition_not_called -- 3 of 1096 failed before. The depth checks moved to the new figures; SEE shows the calls; two layout checks use in-line test words; 2>R 2R@ 2R> checked in test_host_quit. - DECOMPOSITION.md EXECUTE, the plan's A2 and rulings, FABRIC-3 XLVIII.22. Suite: test, test-32 99 programs 0 failures; v4-checks 79 under the sanitizers 0 failures, the hosted builds alike; hosted POST 539/539. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_017RzZgrf7V7Zk2iczBXDRbm
This commit is contained in:
Claude
+5
-1
@@ -122,7 +122,9 @@
|
||||
/* THE IMAGE RECORD: where the system's source says, with `store`, the addresses a host needs (v4/image.h): where the
|
||||
* node waits for a message, its fault table, and KEY's code. */
|
||||
#define ROM_IMG (BUF0_W - 119) /* idle, fault table, KEY, the word after KEY: 4 cells */
|
||||
/* FREE, plain memory: BUF0_W - 22 .. - 21; - 115 .. - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after
|
||||
#define EXEC_W (BUF0_W - 22) /* (EXEC): EXECUTE's `call xt`, and the ; after it (compile.f18; #189) */
|
||||
#define RUNX_W (BUF0_W - 115) /* (RUNX): INTERPRET's `call xt`, and the jump back (compile.f18; #189) */
|
||||
/* FREE, plain memory: BUF0_W - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after
|
||||
* a full output buffer); and OUT_W - 144 .. OUT_W - 65. They and
|
||||
* the cells above held the messages waiting, the refusals owed and what went with them (MESH.md 7a, 7b), which a
|
||||
* node no longer keeps. */
|
||||
@@ -368,6 +370,8 @@ static unsigned host_branch_slots(void)
|
||||
X("DSTACK-DEPTH", DSTACK_REG) \
|
||||
X("RSTACK-DEPTH", RSTACK_REG) \
|
||||
X("HEAT-OP", HEAT_REG) \
|
||||
X("(EXEC)", EXEC_W) \
|
||||
X("(RUNX)", RUNX_W) \
|
||||
X("ANTICLOCK", HEAT_REG + 32) \
|
||||
X("CFBASE", CFS_W) \
|
||||
X("CFEND", CFS_W + CFS_CELLS)
|
||||
|
||||
@@ -67,6 +67,37 @@ static void new_session(void)
|
||||
* starts with the canary alone; `depth` extra marked cells go under it and
|
||||
* `rdepth` under the return address, for the headroom tests. True when
|
||||
* INTERPRET returns. */
|
||||
/* The hook at `call` (plan 2026-10-20, Task A2; #189): while `watching`, every call's target is
|
||||
* recorded, as the kernel will see it. */
|
||||
static int watching;
|
||||
static v4_cell called[4096];
|
||||
static unsigned ncalled;
|
||||
static void record_call(void *ctx, v4_node *nd, v4_cell target)
|
||||
{
|
||||
(void)ctx; (void)nd;
|
||||
if (ncalled < sizeof called / sizeof called[0]) called[ncalled] = target;
|
||||
ncalled++;
|
||||
}
|
||||
static unsigned times_called(v4_cell xt)
|
||||
{
|
||||
unsigned k, c = 0;
|
||||
for (k = 0; k < ncalled && k < sizeof called / sizeof called[0]; k++) if (called[k] == xt) c++;
|
||||
return c;
|
||||
}
|
||||
static int called_in_order(const char *const *names, unsigned count) /* names, in this order, among the calls */
|
||||
{
|
||||
unsigned k, i = 0;
|
||||
for (k = 0; k < ncalled && k < sizeof called / sizeof called[0] && i < count; k++)
|
||||
if (called[k] == v4_text_word(&tx, names[i])) i++;
|
||||
return i == count;
|
||||
}
|
||||
static unsigned calls_from(v4_cell lo) /* how many calls went to an address at or above lo */
|
||||
{
|
||||
unsigned k, c = 0;
|
||||
for (k = 0; k < ncalled && k < sizeof called / sizeof called[0]; k++) if (called[k] >= lo) c++;
|
||||
return c;
|
||||
}
|
||||
|
||||
static int interpret_with(const char *line, unsigned depth, unsigned rdepth)
|
||||
{
|
||||
unsigned len = (unsigned)strlen(line), i;
|
||||
@@ -77,6 +108,7 @@ static int interpret_with(const char *line, unsigned depth, unsigned rdepth)
|
||||
v4_dstack_reset(&n.ds);
|
||||
v4_rstack_reset(&n.rs);
|
||||
v4_exec_reset(&es);
|
||||
if (watching) { es.on_call = record_call; es.on_call_ctx = 0; ncalled = 0; }
|
||||
v4_heat_reset(&h);
|
||||
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
@@ -203,8 +235,12 @@ int main(void)
|
||||
}
|
||||
/* two in-line words of the test's own, to exercise the in-liner: one with
|
||||
* two literals in one instruction word, one with a nop in it */
|
||||
CHECK(v4_text_assemble(&tx, "header TWOLIT inline : TWOLIT 3 + 100 + ;\n"
|
||||
"header HASNOP inline : HASNOP dup nop drop 7 ;\n"), "the test's in-line words: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_assemble(&tx, "header TWOLIT inline compile-only : TWOLIT 3 + 100 + ;\n"
|
||||
"header HASNOP inline compile-only : HASNOP dup nop drop 7 ;\n"
|
||||
/* and two that stay in line (A2), so the control structures' code can be
|
||||
* compared word for word without calls in it */
|
||||
"header 1-I inline compile-only : 1-I -1 + ;\n"
|
||||
"header DUPI inline compile-only : DUPI dup ;\n"), "the test's in-line words: %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(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
|
||||
@@ -237,16 +273,48 @@ int main(void)
|
||||
}
|
||||
|
||||
/* ---- what was compiled, word for word ---- */
|
||||
/* ---- A2 (plan 2026-10-20; #189; Captain Bob, 2026-11-13: "The ten"): every word is called, so
|
||||
* the hook at `call` sees it -- but the ten that work on the return stack (in line and
|
||||
* compile-only: >R R> R@ I J LEAVE UNLOOP 2>R 2R> 2R@), which a call would bury ---- */
|
||||
new_session();
|
||||
CHECK(ok(": T DUP OVER + SWAP DROP 5 + ;") && same_code(": T dup over + over push push drop pop pop drop 5 + ;"), "in-line words are copied in line");
|
||||
CHECK(ok(": T DUP OVER + SWAP DROP 5 + ;"), "a definition of in-line words");
|
||||
watching = 1;
|
||||
{
|
||||
static const char *const order[] = { "DUP", "OVER", "PLUS", "SWAP'", "DROP", "PLUS" };
|
||||
CHECK(one("3 T") == 11 && called_in_order(order, 6) && times_called(v4_text_word(&tx, "DUP")) == 1
|
||||
&& times_called(v4_text_word(&tx, "PLUS")) == 2,
|
||||
"inline_words_are_called: the hook sees DUP OVER + SWAP DROP + called, in order (DUP %u, + %u times)",
|
||||
times_called(v4_text_word(&tx, "DUP")), times_called(v4_text_word(&tx, "PLUS")));
|
||||
}
|
||||
watching = 0;
|
||||
new_session();
|
||||
CHECK(ok(": T 1 >R R> ;") && same_code(": T 1 push pop ;"), "residue_stays_inline: >R R> are copied in line");
|
||||
new_session();
|
||||
CHECK(ok(": T 4 0 DO I LOOP + + + ;") && one("T") == 6, "residue_stays_inline: I in a loop, still in line");
|
||||
new_session();
|
||||
CHECK(ok(": T 3 0 DO I 1 = IF UNLOOP 7 EXIT THEN LOOP 9 ;") && one("T") == 7, "residue_stays_inline: UNLOOP then EXIT leaves the word");
|
||||
new_session();
|
||||
watching = 1;
|
||||
CHECK(ok(": T 5 ' DUP EXECUTE + 1+ ;") && one("T") == 11 && times_called(v4_text_word(&tx, "DUP")) == 1,
|
||||
"execute_passes_the_hook: ' DUP EXECUTE inside a definition is seen once (%u), and the definition goes on after",
|
||||
times_called(v4_text_word(&tx, "DUP")));
|
||||
CHECK(one("6 ' DUP EXECUTE +") == 12 && times_called(v4_text_word(&tx, "DUP")) >= 1, "and at the prompt");
|
||||
watching = 0;
|
||||
new_session();
|
||||
CHECK(ok(": T 7 >R 1 DUP + R> + ;") && one("T") == 9, "rstack_kept_across_call: a call does not disturb what >R put there");
|
||||
new_session();
|
||||
watching = 1;
|
||||
CHECK(abandoned(": T 1 DUP NOSUCH") && calls_from(DICT_W) == 0,
|
||||
"abandoned_definition_not_called: the hook sees no call into a definition that was abandoned (%u)", calls_from(DICT_W));
|
||||
watching = 0;
|
||||
new_session();
|
||||
CHECK(ok(": T IF 1 THEN ;") && same_code(": T if L1 drop 1 jump L2 L1: drop L2: ;"), "IF THEN, as section 2 gives it");
|
||||
new_session();
|
||||
CHECK(ok(": T IF 1 ELSE 2 THEN ;") && same_code(": T if L1 drop 1 jump L2 L1: drop 2 L2: ;"), "IF ELSE THEN, as section 2 gives it");
|
||||
new_session();
|
||||
CHECK(ok(": T BEGIN 1- DUP UNTIL ;") && same_code(": T jump L0 LD: drop L0: -1 + dup if LD drop ;"), "BEGIN UNTIL");
|
||||
CHECK(ok(": T BEGIN 1-I DUPI UNTIL ;") && same_code(": T jump L0 LD: drop L0: -1 + dup if LD drop ;"), "BEGIN UNTIL");
|
||||
new_session();
|
||||
CHECK(ok(": T BEGIN DUP WHILE 1- REPEAT ;") && same_code(": T jump L0 LD: drop L0: dup if LX drop -1 + jump L0 LX: drop ;"), "BEGIN WHILE REPEAT");
|
||||
CHECK(ok(": T BEGIN DUPI WHILE 1-I REPEAT ;") && same_code(": T jump L0 LD: drop L0: dup if LX drop -1 + jump L0 LX: drop ;"), "BEGIN WHILE REPEAT");
|
||||
new_session();
|
||||
CHECK(ok(": T DO I LOOP ;")
|
||||
&& same_code(": T over push push drop BODY: pop dup push"
|
||||
|
||||
+22
-14
@@ -972,6 +972,10 @@ int main(void)
|
||||
CHECK(is(say(": T3 24 HEAT-OP@ 56 HEAT-OP@ = IF 89 EMIT THEN ; T3\n"), "Y ok\nok> "),
|
||||
"an opcode number is taken mod 32: 56 reads dup's count (opcode 24), with no dup between");
|
||||
|
||||
/* ---- A2 (#189): 2>R 2R@ 2R>, in words.f18, stay in line -- a call would bury their values ---- */
|
||||
boot();
|
||||
CHECK(is(say(": T4 1 2 2>R 2R@ 2R> + + + 48 + EMIT ; T4\n"), "6 ok\nok> "), "2>R 2R@ 2R> keep their values in a definition");
|
||||
|
||||
/* ---- a definition over several lines, and an error in the middle of one ---- */
|
||||
boot();
|
||||
CHECK(is(say(": LONG\n"), " ok\nok> ") && n.mem[STATE] != 0, "a line that leaves a definition open still says ok");
|
||||
@@ -1095,8 +1099,10 @@ int main(void)
|
||||
CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "ABORT has emptied the data stack");
|
||||
|
||||
/* ---- how deep words may call each other from the prompt ----
|
||||
* The prompt's call of INTERPRET is one return entry, so a chain of words
|
||||
* one shorter than the return stack runs, and the next is a fault. */
|
||||
* The prompt's call of INTERPRET is one return entry; and N0's 1+ is a call
|
||||
* since A2 (#189; Captain Bob, 2026-11-13: "Accept it"), one more at the
|
||||
* bottom. So a chain two shorter than the return stack runs, and the next
|
||||
* is a fault. */
|
||||
{
|
||||
unsigned deepest = 0;
|
||||
char line[64], want[16];
|
||||
@@ -1113,16 +1119,17 @@ int main(void)
|
||||
deepest = i + 1;
|
||||
}
|
||||
printf(" from the prompt, words may call each other %u deep\n", deepest);
|
||||
CHECK(deepest == V4_RET_DEPTH - 1u, "a word run from the prompt has all the return stack but the prompt's one entry");
|
||||
CHECK(deepest == V4_RET_DEPTH - 2u, "a word run from the prompt has all the return stack but the prompt's one entry and the call of the in-line 1+ at the bottom (%u)", deepest);
|
||||
CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and one more is reported");
|
||||
}
|
||||
|
||||
/* ---- the exits, taken with the return stack full ----
|
||||
* RR runs itself through EXECUTE; each level holds one return entry, and
|
||||
* EXECUTE one more while it starts the next. With C at its largest and
|
||||
* one >R besides, there is room for exactly the action's own call. An
|
||||
* exit that did not empty the return stack before it printed would
|
||||
* overflow it. */
|
||||
* RR runs itself through EXECUTE. EXECUTE calls the word since A2 (#189),
|
||||
* so each level below the first holds two return entries -- RR's own, and
|
||||
* the ; EXECUTE's call returns to -- and the first one: 2 + 2(C-1) with the
|
||||
* prompt's. With C at its largest, (D-2)/2, and one >R besides, there is
|
||||
* room for the action's own call. An exit that did not empty the return
|
||||
* stack before it printed would overflow it. */
|
||||
{
|
||||
static const struct { const char *action, *want; } e[] = {
|
||||
{ "1 ABORT\" x\"", "x\n ok\nok> " },
|
||||
@@ -1139,12 +1146,12 @@ int main(void)
|
||||
CHECK(is(say("VARIABLE V VARIABLE C\n"), " ok\nok> "), "two variables");
|
||||
snprintf(line, sizeof line, ": RR C @ 1- DUP C ! IF V @ EXECUTE EXIT THEN 1 >R %s ;\n", e[i].action);
|
||||
CHECK(is(say(line), " ok\nok> "), "a word that runs itself C times and then: %s", e[i].action);
|
||||
snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)(V4_RET_DEPTH - 3u));
|
||||
snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)((V4_RET_DEPTH - 2u) / 2u));
|
||||
CHECK(is(say(line), e[i].want), "%s with the return stack full", e[i].action);
|
||||
CHECK(n.faults == 0, "%s: and it was not a fault", e[i].action);
|
||||
CHECK(is(say("65 EMIT\n"), "A ok\nok> "), "and the next line runs");
|
||||
/* one level more and the action's own call does not fit */
|
||||
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 2u));
|
||||
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)((V4_RET_DEPTH - 2u) / 2u + 1u));
|
||||
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "%s one level deeper is a return stack overflow", e[i].action);
|
||||
}
|
||||
}
|
||||
@@ -1565,25 +1572,26 @@ int main(void)
|
||||
/* ---- SEE: FORTH source too ---- */
|
||||
boot_bare();
|
||||
CHECK(load_source("tools.fth"), "tools.fth compiles, every line of it");
|
||||
CHECK(is(say(": SQ DUP * ; SEE SQ\n"), ": SQ\n dup call * \n ; \n ok\nok> "), "a definition: an in-line word, a call by name, the return");
|
||||
CHECK(is(say(": SQ DUP * ; SEE SQ\n"), ": SQ\n call DUP \n call * \n ; \n ok\nok> "),
|
||||
"a definition: an in-line word called since A2 (#189), a call by name, the return");
|
||||
CHECK(is(say("SEE DUP\n"), ": DUP\n dup ; \n ok\nok> ") && is(say("SEE EMIT\n"), out) && strncmp(out, ": EMIT\n @p 255 and ", 20) == 0 && strstr(out, " pop a! ; \n"),
|
||||
"the capsule's own words; a literal's value follows its @p");
|
||||
CHECK(is(say("VARIABLE V 7 V ! SEE V\n"), ": V\n data: 7 \n ok\nok> ") && is(say("5 CONSTANT K SEE K\n"), ": K\n data: 5 \n ok\nok> "), "a variable and a constant show what they hold");
|
||||
CHECK(is(say(": IM 1 ; IMMEDIATE SEE IM\n"), ": IM\n @p 1 ; \nIMMEDIATE\n ok\nok> "), "an immediate word says so");
|
||||
CHECK(is(say(": ST .\" hi\" 300 + ; SEE ST\n"), ": ST\n call (.\") \"hi\" \n @p 300 + ; \n ok\nok> "), "text in a definition is shown as text, and the code after it as code");
|
||||
CHECK(is(say(": ST .\" hi\" 300 + ; SEE ST\n"), ": ST\n call (.\") \"hi\" \n @p 300 call + \n ; \n ok\nok> "), "text in a definition is shown as text, and the code after it as code");
|
||||
CHECK(is(say(": S3 S\" abcdefg\" 0 ABORT\" x\" ; SEE S3\n"), ": S3\n call (S\") \"abcdefg\" \n @p 0 call (ABORT\") \"x\" \n ; \n ok\nok> "), "S\" and ABORT\" the same");
|
||||
{
|
||||
/* branches: the addresses are this node's, so they are read back rather than written here */
|
||||
const char *o = say(": AB DUP 0< IF NEGATE THEN ; SEE AB\n");
|
||||
long a1, a2;
|
||||
CHECK(sscanf(o, ": AB\n dup call 0< \n if %ld \n drop inv @p 1 + \n jump %ld \n drop \n ; \n ok", &a1, &a2) == 2 && a2 == a1 + 1
|
||||
CHECK(sscanf(o, ": AB\n call DUP \n call 0< \n if %ld \n drop call NEGATE \n jump %ld \n drop \n ; \n ok", &a1, &a2) == 2 && a2 == a1 + 1
|
||||
&& a1 > (long)DICT_W && a1 < (long)DICT_END_W, "IF and THEN: the if goes to the drop, the jump to the word after it");
|
||||
CHECK(is(say("7 AB -7 AB + .\n"), "14 ok\nok> "), "(and the word works)");
|
||||
o = say(": LP 10 0 DO I . LOOP ; SEE LP\n");
|
||||
CHECK(strstr(o, ": LP\n @p 10 @p 0 over push push drop \n pop dup push \n call . \n") == o && strstr(o, "\n drop drop drop ; \n ok\nok> "),
|
||||
"a loop runs to its last return, past the returns inside it");
|
||||
o = say("SEE SEE\n");
|
||||
CHECK(strstr(o, ": SEE\n call FIND \n dup call 0= \n call (ABORT\") \"SEE: not found\" \n call (.\") \": \" \n") == o
|
||||
CHECK(strstr(o, ": SEE\n call FIND \n call DUP \n call 0= \n call (ABORT\") \"SEE: not found\" \n call (.\") \": \" \n") == o
|
||||
&& strstr(o, "call (SEE-CODE) ") && strstr(o, "\"IMMEDIATE\" \n call CR \n") && strlen(o) < 700, "SEE shows itself");
|
||||
}
|
||||
CHECK(is(say(": S4 .\" abcd\" 65 EMIT ; SEE S4\n"), ": S4\n call (.\") \"abcd\" \n @p 65 call EMIT \n ; \n ok\nok> "), "text that fills its last cell but for the count");
|
||||
|
||||
Reference in New Issue
Block a user