admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(v4.0.0): shorter chains of calls in the compiler capsule

Browse Source 
Measured, compiling a DO loop left one return entry spare under
INTERPRET and a defining word called from inside another word
overflowed the nine-entry return stack (D-2); the prompt loop will take
one more.

C@ and C! shift without a loop.  The code generator shifts each opcode
into the word being built, so nothing is placed by a counted shift, and
the address masks come from a table.  The dictionary search, the
in-liner, the end of a loop and the making of a data word are each one
word reached by a jump.

Every kind of line now leaves at least three return entries spare while
it compiles; a word run from the interpreter has six; and CREATE ...
DOES> works from the prompt, from a word, and from a word that calls
that.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 11:17:58 -04:00
co-authored by Claude Opus 5.5
parent dac7ffac92
commit 806f876ee0
9 changed files with 165 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/host_map.h
+2 -2
View File
@@ -33,8 +33,8 @@
/* each capsule file's scratch cells */
#define PVARS (TOP - 24) /* (P): input.v4, 8 cells */
#define DVARS (TOP - 32) /* (D): dict.v4, 5 cells */
#define CGVARS (TOP - 48) /* (CG): codegen.v4, 13 cells */
#define CVARS (TOP - 58) /* (C): compile.v4, 8 cells */
#define CGVARS (TOP - 48) /* (CG): codegen.v4, 14 cells */
#define CVARS (TOP - 62) /* (C): compile.v4, 10 cells */
/* buffers (word addresses; a byte address is four times this) */
#define CFS_W (TOP - 96) /* the control-flow stack, 32 cells */
v4/tests/test_host_codegen.c
+2 -7
View File
@@ -187,14 +187,9 @@ int main(void)
printf(" code: %ld words\n", (long)v4_text_here(&tx) - 16);
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
/* ---- the arithmetic it rests on ---- */
for (i = 0; i <= 31; i++)
CHECK(get("(LSHIFT)", 2, 1, (v4_cell)i) == (v4_cell)((v4_ucell)1 << i) && get("(LSHIFT)", 2, 5, (v4_cell)i) == (v4_cell)((v4_ucell)5 << i),
"(LSHIFT) by %u", i);
for (i = 0; i < 6; i++) {
CHECK(get("(LOWBIT)", 1, (v4_cell)i, 0) == (v4_cell)V4_SLOT_LOW_BIT(i), "slot %u's lowest bit is %u", i, V4_SLOT_LOW_BIT(i));
/* ---- the address masks ---- */
for (i = 0; i < 4; i++)
CHECK(get("(MASK)", 1, (v4_cell)i, 0) == (v4_cell)v4_iword_slot_mask(i), "slot %u's address mask", i);
}
/* ---- one thing at a time ---- */
nprog = 0;
v4/tests/test_host_compile.c
+29 -13
View File
@@ -270,6 +270,15 @@ int main(void)
CHECK(ok("CREATE CA 5 , 6 , CREATE CB 7 ,") && interpret("CA @ CA 1+ @ CB @") && !err() && pop() == 7 && pop() == 6 && pop() == 5 && clean(),
"CREATE and , build a table");
/* ---- defining words used inside other words ---- */
new_session();
CHECK(ok(": D CREATE , DOES> @ ; : DD D ; : DDD DD ;"), "a defining word, and words that call it");
CHECK(ok("7 D SEVEN 8 DD EIGHT 9 DDD NINE") && interpret("SEVEN EIGHT NINE") && !err() && pop() == 9 && pop() == 8 && pop() == 7 && clean(),
"a defining word works from the prompt, from a word, and from a word that calls that");
CHECK(ok(": MKV VARIABLE ; : MKC CONSTANT ; MKV VV 5 MKC CC 3 VV !") && interpret("VV @ CC") && !err() && pop() == 5 && pop() == 3 && clean(),
"VARIABLE and CONSTANT inside words");
CHECK(ok(": MK: : ; MK: PLUS3 3 + ;") && one("4 PLUS3") == 7, ": inside a word");
/* ---- numbers in other bases ---- */
new_session();
CHECK(one("2 BASE ! 101") == 5, "a number in base 2");
@@ -314,6 +323,11 @@ int main(void)
&& abandoned(": X6 +LOOP ;") && abandoned(": X7 AGAIN ;") && abandoned(": X8 WHILE ;") && n.mem[CFP] == CFS_W,
"a closing word with nothing open abandons the definition, and the control-flow stack is not disturbed");
CHECK(abandoned(":") && abandoned("CREATE") && abandoned("VARIABLE") && interpret("5 CONSTANT") && err(), "a defining word with no name is an error");
{
v4_cell dp = n.mem[DP];
CHECK(interpret("5 CONSTANT") && err() && n.mem[DP] == dp, "CONSTANT with no name stores nothing");
CHECK(interpret("VARIABLE") && err() && n.mem[DP] == dp, "nor does VARIABLE");
}
CHECK(one("3 4 +") == 7, "after all that the interpreter still works");
n.mem[DP] = (DICT_END_W - 2) * 4;
CHECK(interpret(": FULL 1 2 3 4 5 6 7 8 9 ;") && err(), "a definition that does not fit sets NODE-ERROR");
@@ -358,22 +372,24 @@ int main(void)
CHECK(abandoned(": TOODEEP IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF ;"), "more open structures than the control-flow stack holds abandons the line");
CHECK(one("3 4 +") == 7, "and the interpreter still works afterwards");
/* ---- how deep words may call each other from the interpreter ---- */
/* ---- how deep words may call each other from the interpreter ----
* Measured by how many marked return entries survive under INTERPRET
* while a word that calls nothing runs: each of them is a level of
* nesting some other word could have used. */
{
char line[64];
unsigned depth = 0;
unsigned r, k;
new_session();
CHECK(ok(": N0 1+ ;"), "N0");
for (i = 1; i <= 8; i++) {
snprintf(line, sizeof line, ": N%u N%u 1+ ;", i, i - 1);
CHECK(ok(line), "N%u compiles", i);
CHECK(ok(": N0 1+ ;") && ok(": N1 N0 1+ ;") && ok(": N2 N1 1+ ;") && ok(": N3 N2 1+ ;") && ok(": N4 N3 1+ ;"), "five words, each calling the one before");
CHECK(one("0 N4") == 5, "five levels of calls work from the interpreter");
for (r = 0; r < V4_RET_DEPTH; r++) {
unsigned good = 1;
if (!interpret_with("0 N0", 0, r + 1u) || err()) break;
if (pop() != 1 || pop() != CANARY) break;
for (k = r + 1u; k-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + k)) good = 0;
if (!good) break;
}
for (i = 0; i <= 8; i++) {
snprintf(line, sizeof line, "0 N%u", i);
if (one(line) == (v4_cell)(i + 1)) depth = i + 1; else break;
}
printf(" words called from the interpreter may nest %u deep\n", depth);
CHECK(depth >= 5, "a few levels of calls work from the interpreter");
printf(" a word run from the interpreter has %u return entries to itself\n", r + 1u);
CHECK(r + 1u >= 6, "the interpreter leaves most of the return stack to the user");
}
/* and how much of the data stack a line may use */
{
v4/tests/test_host_input.c
+10
View File
@@ -246,6 +246,16 @@ int main(void)
CHECK(run("C@", 1, SBUF + (v4_cell)i, 0, 0) && pop() == (v4_cell)('a' + i) && clean(), "C@ [%u]", i);
}
CHECK(run("CMOVE", 3, SBUF, SBUF + 20, 8) && clean() && bytes_are(SBUF + 20, "abcdefgh", 8), "CMOVE");
/* C! writes one byte and nothing else, whatever is above the low byte of what it is given */
for (i = 0; i < 8; i++) {
v4_ucell pat = (v4_ucell)0xA5C3F00Fu, want;
unsigned sh = 8u * (i % 4u);
n.mem[SBUF_W + 8] = (v4_cell)pat; n.mem[SBUF_W + 9] = (v4_cell)pat; n.mem[SBUF_W + 10] = (v4_cell)pat; n.mem[SBUF_W + 7] = (v4_cell)pat;
want = (pat & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)0x5Eu << sh);
CHECK(run("C!", 2, (v4_cell)-162 /* ...FF5E */, (SBUF_W + 8) * 4 + (v4_cell)i, 0) && clean(), "C! of a wide value [%u]", i);
CHECK((v4_ucell)n.mem[SBUF_W + 8 + (v4_cell)(i / 4u)] == want && (v4_ucell)n.mem[SBUF_W + 9 - (v4_cell)(i / 4u)] == pat
&& (v4_ucell)n.mem[SBUF_W + 7] == pat && (v4_ucell)n.mem[SBUF_W + 10] == pat, "C! changes that byte only [%u]", i);
}
for (i = 0; i < 6; i++) {
static const v4_cell b[] = { 10, 16, 2, 36, 1, 37 };
n.mem[BASE] = b[i];