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

feat(v4.0.0): the stacks are guarded (D-16); DEPTH, PICK and ROLL

Browse Source 
Ruled 2026-10-04, revising D-2: stack overflow and underflow are errors
that are shown and return to the prompt, not silent wrap-around.

- Each stack counts what it holds.  Before every opcode the executor
  checks that the stacks hold what it takes and have room for what it
  leaves; otherwise the opcode does nothing and the node faults, as for a
  bad address, to that kind's handler.  Every fault empties both stacks.
- The fault handler is now a table of five jumps: address, data overflow,
  data underflow, return overflow, return underflow.  The host node says
  "Stack overflow", "Stack underflow", "Return stack overflow",
  "Return stack underflow", then ERROR and the prompt.
- Two registers, DSTACK-DEPTH and RSTACK-DEPTH: a fetch reads the depth,
  a store empties the stack.  QUIT, ABORT and the error exits empty the
  return stack before they call anything; ABORT empties the data stack.
- capsule/forth.v4: DEPTH, PICK and ROLL, to FORTH-79 (counting from
  one).  PICK and ROLL set the values above the one wanted aside in
  memory, and work with the stack full.
- Division by zero now takes its operands off the stack, as v3 does.
- A colon with no room for its entry abandons the line.
- tests: every opcode at every depth of both stacks; the faults, the
  registers and the three words from the prompt.

The sizes are unchanged: ten values, nine return entries.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 17:31:18 -04:00
co-authored by Claude Opus 5.5
parent 361dcd1148
commit 0da7e32a0b
16 changed files with 542 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/host_map.h
+8 -1
View File
@@ -29,13 +29,16 @@
#define LATEST (TOP - 12)
#define STATE (TOP - 13)
#define CFP (TOP - 14) /* the control-flow stack's pointer */
#define DSTACK_REG (TOP - 15) /* DSTACK-DEPTH (D-16) */
#define RSTACK_REG (TOP - 16) /* RSTACK-DEPTH */
/* 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, 14 cells */
#define CVARS (TOP - 62) /* (C): compile.v4, 10 cells */
#define FVARS (TOP - 27) /* (F): forth.v4, 3 cells */
#define FVARS (TOP - 105) /* (F): forth.v4, 7 cells */
#define SVARS (TOP - 180) /* (S): where PICK and ROLL set stack values aside, 10 cells */
#define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */
/* buffers (word addresses; a byte address is four times this) */
@@ -103,6 +106,10 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(CFP)", CFP);
v4_text_constant(tx, "(Q)", QVARS);
v4_text_constant(tx, "(F)", FVARS);
v4_text_constant(tx, "(S)", SVARS);
v4_text_constant(tx, "DSTACK-DEPTH", DSTACK_REG);
v4_text_constant(tx, "RSTACK-DEPTH", RSTACK_REG);
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
v4_text_constant(tx, "CFBASE", CFS_W);
v4_text_constant(tx, "CFEND", CFS_W + CFS_CELLS);
for (i = 0; i < count; i++) {
v4/tests/test_exec.c
+117 -11
View File
@@ -265,7 +265,12 @@ static void test_unext(void)
static void test_retirement(void)
{
fresh();
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++) v4_exec_op(&n, &es, &h, op, 0, 0);
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++) {
/* each opcode finds what it takes on the stacks, and room (D-16) */
v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs);
dpush(1); dpush(2); rpush(5);
v4_exec_op(&n, &es, &h, op, 0, 0);
}
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++)
CHECK(h.op[op] == 1, "opcode %u retires once", op);
CHECK(es.anticlock == V4_OPCODE_COUNT, "one anticlock tick per opcode");
@@ -312,14 +317,113 @@ static void test_soak(void)
if ((seed >> 60) == 0) dpush((v4_cell)(seed >> 7));
v4_exec_op(&n, &es, &h, safe[(seed >> 33) % (sizeof safe / sizeof safe[0])], 0, 0);
}
CHECK(es.anticlock == count, "soak retired every opcode");
CHECK(es.anticlock + n.faults == count && n.faults > 0 && es.anticlock > 0,
"soak: every opcode retired or faulted (%u faults)", n.faults);
CHECK(v4_node_guards_intact(&n), "soak left the guards intact");
}
#define HANDLER ((v4_cell)40)
/* D-16: the stacks are guarded. An opcode that would pop an empty stack,
* read a T or S that is not there, or push onto a full stack is a fault: it
* does nothing, both stacks are emptied, and P is that kind's word of the
* handler table. */
static void test_stack_faults(void)
{
/* what each opcode needs on the data and return stacks, and which it adds one to */
static const struct { unsigned op, dneed, rneed, dgrow, rgrow; const char *name; } m[] = {
{ V4_OP_SEMI, 0, 1, 0, 0, ";" }, { V4_OP_EX, 0, 1, 0, 0, "ex" }, { V4_OP_JUMP, 0, 0, 0, 0, "jump" },
{ V4_OP_CALL, 0, 0, 0, 1, "call" }, { V4_OP_UNEXT, 0, 1, 0, 0, "unext" }, { V4_OP_NEXT, 0, 1, 0, 0, "next" },
{ V4_OP_IF, 1, 0, 0, 0, "if" }, { V4_OP_MINUS_IF, 1, 0, 0, 0, "-if" },
{ V4_OP_FETCH_P, 0, 0, 1, 0, "@p" }, { V4_OP_FETCH_INC, 0, 0, 1, 0, "@+" }, { V4_OP_FETCH_B, 0, 0, 1, 0, "@b" },
{ V4_OP_FETCH_A, 0, 0, 1, 0, "@" }, { V4_OP_STORE_P, 1, 0, 0, 0, "!p" }, { V4_OP_STORE_INC, 1, 0, 0, 0, "!+" },
{ V4_OP_STORE_B, 1, 0, 0, 0, "!b" }, { V4_OP_STORE_A, 1, 0, 0, 0, "!" }, { V4_OP_MUL_STEP, 2, 0, 0, 0, "+*" },
{ V4_OP_TWO_STAR, 1, 0, 0, 0, "2*" }, { V4_OP_TWO_SLASH, 1, 0, 0, 0, "2/" }, { V4_OP_INV, 1, 0, 0, 0, "inv" },
{ V4_OP_ADD, 2, 0, 0, 0, "+" }, { V4_OP_AND, 2, 0, 0, 0, "and" }, { V4_OP_XOR, 2, 0, 0, 0, "xor" },
{ V4_OP_DROP, 1, 0, 0, 0, "drop" }, { V4_OP_DUP, 1, 0, 1, 0, "dup" }, { V4_OP_RPOP, 0, 1, 1, 0, "pop" },
{ V4_OP_OVER, 2, 0, 1, 0, "over" }, { V4_OP_PUSH_A, 0, 0, 1, 0, "a" }, { V4_OP_NOP, 0, 0, 0, 0, "nop" },
{ V4_OP_PUSH, 1, 0, 0, 1, "push" }, { V4_OP_BANG_B, 1, 0, 0, 0, "b!" }, { V4_OP_BANG_A, 1, 0, 0, 0, "a!" },
};
unsigned k, i;
CHECK(sizeof m / sizeof m[0] == V4_OPCODE_COUNT, "every opcode is in the table");
for (k = 0; k < sizeof m / sizeof m[0]; k++) {
unsigned dd, rd;
/* every depth of both stacks: the opcode faults exactly when the table says */
for (dd = 0; dd <= V4_DATA_DEPTH; dd++)
for (rd = 0; rd <= V4_RET_DEPTH; rd += (rd == 2 ? V4_RET_DEPTH - 3u : 1u)) {
unsigned want = 99, before;
fresh();
v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < dd; i++) dpush((v4_cell)(100 + i));
for (i = 0; i < rd; i++) rpush((v4_cell)(200 + i));
n.a = 7; n.b = 8; n.p = 3;
if (dd < m[k].dneed) want = V4_FAULT_DATA_UNDER;
else if (rd < m[k].rneed) want = V4_FAULT_RET_UNDER;
else if (m[k].dgrow && dd == V4_DATA_DEPTH) want = V4_FAULT_DATA_OVER;
else if (m[k].rgrow && rd == V4_RET_DEPTH) want = V4_FAULT_RET_OVER;
before = h.op[m[k].op];
v4_exec_op(&n, &es, &h, m[k].op, 0, 0);
if (want == 99) {
CHECK(n.faults == 0 && h.op[m[k].op] == before + 1, "%s with %u and %u on the stacks runs", m[k].name, dd, rd);
continue;
}
CHECK(n.faults == 1 && n.fault_kind == want, "%s with %u and %u on the stacks: fault %u (got %u)", m[k].name, dd, rd, want, n.fault_kind);
CHECK(n.p == HANDLER + (v4_cell)want && !n.stopped, "%s: P is that kind's handler", m[k].name);
CHECK(h.op[m[k].op] == before, "%s: it did not retire", m[k].name);
CHECK(n.rs.depth == 0 && n.ds.depth == 0, "%s: both stacks are emptied", m[k].name);
CHECK(n.a == 7 && n.b == 8, "%s: A and B untouched", m[k].name);
}
}
/* the rest of the word does not run, and the handler does */
fresh(); v4_node_fault_attach(&n, HANDLER);
n.mem[HANDLER + V4_FAULT_DATA_UNDER] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP);
n.a = 21; dpush(5);
n.mem[0] = word6(V4_OP_DROP, V4_OP_DROP, V4_OP_PUSH_A, V4_OP_PUSH_A, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 1 && n.ds.depth == 0 && n.p == HANDLER + (v4_cell)V4_FAULT_DATA_UNDER, "a second drop faults; nothing after it runs");
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 42 && n.ds.depth == 1, "the handler runs on the emptied stack");
/* ten pushes fit, the eleventh faults; nine calls fit, the tenth faults */
fresh(); v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < V4_DATA_DEPTH; i++) { n.a = (v4_cell)i; v4_exec_op(&n, &es, &h, V4_OP_PUSH_A, 0, 0); }
CHECK(n.faults == 0 && n.ds.depth == V4_DATA_DEPTH && n.ds.t == (v4_cell)(V4_DATA_DEPTH - 1u), "the data stack holds %u", (unsigned)V4_DATA_DEPTH);
v4_exec_op(&n, &es, &h, V4_OP_PUSH_A, 0, 0);
CHECK(n.faults == 1 && n.fault_kind == V4_FAULT_DATA_OVER, "one more is a fault");
fresh(); v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < V4_RET_DEPTH; i++) v4_exec_op(&n, &es, &h, V4_OP_CALL, 0, 0);
CHECK(n.faults == 0 && n.rs.depth == V4_RET_DEPTH, "the return stack holds %u", (unsigned)V4_RET_DEPTH);
v4_exec_op(&n, &es, &h, V4_OP_CALL, 0, 0);
CHECK(n.faults == 1 && n.fault_kind == V4_FAULT_RET_OVER && n.rs.depth == 0, "one more call is a fault");
/* with no handler the node stops */
fresh();
CHECK(run1(V4_OP_DROP) == 0 && n.stopped && n.fault_kind == V4_FAULT_DATA_UNDER, "with no handler a stack fault stops the node");
/* the stack registers */
fresh(); v4_node_fault_attach(&n, HANDLER);
v4_node_stack_regs_attach(&n, 900, 901);
n.mem[900] = 55; n.mem[901] = 66;
dpush(1); dpush(2); dpush(3); rpush(7); rpush(8);
n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 3 && n.ds.depth == 4, "DSTACK-DEPTH reads the depth, its own push not counted");
n.b = 901; v4_exec_op(&n, &es, &h, V4_OP_FETCH_B, 0, 0);
CHECK(n.ds.t == 2 && n.ds.depth == 5, "RSTACK-DEPTH reads the return stack's");
v4_exec_op(&n, &es, &h, V4_OP_STORE_B, 0, 0);
CHECK(n.rs.depth == 0 && n.ds.depth == 4 && n.mem[901] == 66, "a store to RSTACK-DEPTH empties the return stack and writes no memory");
v4_exec_op(&n, &es, &h, V4_OP_STORE_A, 0, 0);
CHECK(n.ds.depth == 0 && n.mem[900] == 55, "a store to DSTACK-DEPTH empties the data stack");
n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 0 && n.ds.depth == 1 && n.faults == 0, "and it then reads 0");
v4_node_reset(&n);
CHECK(n.dstack_reg == -1 && n.rstack_reg == -1, "reset detaches the stack registers");
n.mem[900] = 55; n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 55, "detached, the address is memory");
}
/* D-14: an address outside node memory is a fault. The opcode does nothing,
* the rest of its word is not executed, and P becomes the handler; with no
* handler the node stops. */
#define HANDLER ((v4_cell)40)
static void test_address_faults(void)
{
static const v4_cell bad[] = { -1, (v4_cell)V4_NODE_WORDS, (v4_cell)V4_NODE_WORDS + 1, MINC, MAXC, (v4_cell)(V4_NODE_WORDS * 4u) };
@@ -343,7 +447,7 @@ static void test_address_faults(void)
CHECK(n.faults == 1 && n.fault_addr == bad[i] && !n.stopped, "%s at %lld is a fault", m[k].name, (long long)bad[i]);
CHECK(n.p == HANDLER, "%s: P is the handler", m[k].name);
CHECK(retired == 1, "%s: only the dup before it retired (%u)", m[k].name, retired);
CHECK(n.ds.t == 22 && n.ds.s == 22, "%s: it neither pushed nor popped, and the drops after it did not run", m[k].name);
CHECK(n.ds.depth == 0 && n.rs.depth == 0, "%s: both stacks are emptied", m[k].name);
CHECK(n.a == (m[k].reg == 'a' ? bad[i] : 7) && n.b == (m[k].reg == 'b' ? bad[i] : 7), "%s: A and B untouched", m[k].name);
CHECK(v4_node_guards_intact(&n), "%s: guards intact", m[k].name);
}
@@ -387,11 +491,11 @@ static void test_address_faults(void)
/* the handler runs, and faults are counted */
fresh(); v4_node_fault_attach(&n, HANDLER);
n.mem[HANDLER] = word6(V4_OP_DUP, V4_OP_ADD, NOP, NOP, NOP, NOP);
n.mem[HANDLER] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP);
dpush(21); n.a = -1; run1(V4_OP_FETCH_A);
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 42, "the handler's code runs next");
n.a = -1; run1(V4_OP_FETCH_A); n.a = -1; run1(V4_OP_STORE_A);
CHECK(n.faults == 3, "each fault is counted");
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == -2 && n.ds.depth == 1, "the handler's code runs next, on empty stacks");
n.a = -1; run1(V4_OP_FETCH_A); dpush(1); n.a = -1; run1(V4_OP_STORE_A);
CHECK(n.faults == 3 && n.fault_kind == V4_FAULT_ADDRESS, "each fault is counted");
v4_node_fault_attach(&n, HANDLER);
CHECK(n.faults == 0 && n.fault_vector == HANDLER, "attaching clears the count");
@@ -399,9 +503,10 @@ static void test_address_faults(void)
fresh();
CHECK(n.fault_vector == -1 && n.faults == 0 && !n.stopped, "a fresh node has no handler and has not stopped");
dpush(9); n.a = -1;
CHECK(run1(V4_OP_FETCH_A) == 0 && n.stopped && n.faults == 1 && n.ds.t == 9, "with no handler a fault stops the node");
n.mem[0] = word6(V4_OP_DUP, V4_OP_ADD, NOP, NOP, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 0 && n.p == 0 && n.ds.t == 9, "a stopped node executes nothing");
CHECK(run1(V4_OP_FETCH_A) == 0 && n.stopped && n.faults == 1 && n.ds.depth == 0, "with no handler a fault stops the node");
n.a = 9;
n.mem[0] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 0 && n.p == 0 && n.ds.depth == 0, "a stopped node executes nothing");
v4_node_fault_attach(&n, HANDLER);
CHECK(!n.stopped && v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 18, "attaching a handler lets it run again");
v4_node_fault_attach(&n, (v4_cell)V4_NODE_WORDS);
@@ -436,6 +541,7 @@ int main(void)
#if V4_CELL_BITS == 64
test_iword_in_wide_cell();
#endif
test_stack_faults();
test_address_faults();
test_soak();
v4/tests/test_host_quit.c
+71 -14
View File
@@ -22,6 +22,13 @@
* - QUERY takes 80 characters (FORTH-79); v3's line is 255.
* - an address outside memory says so (D-14); v3 gives ERROR alone.
* - M/MOD by zero says so (D-15); v3 gives ERROR alone.
* - the stacks hold ten values and nine return entries, and one more is
* an error (D-16); v3's are far deeper. A stack fault names the stack,
* not the word: "Stack underflow" where v3 says "DROP: Stack underflow".
* - any fault empties the data stack; v3 keeps what the failing word had
* not taken.
* - PICK and ROLL count from one, as FORTH-79 has them: 1 PICK is DUP and
* 3 ROLL is ROT. v3's count from zero.
*/
#include "v4/text.h"
#include "v4/testcode.h"
@@ -84,6 +91,12 @@ static void boot_with(unsigned depth)
(void)run_until_waiting(100000);
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
static void boot_bare(void)
{
boot();
v4_dstack_reset(&n.ds);
}
/* While the node waits for a character, EXPECT's own cells are on top of the
* data stack. Pop them: true if the canary is under no more than four. */
@@ -106,12 +119,6 @@ static const char *say(const char *input)
out[n.console_len] = 0;
return out;
}
/* A whole session from switch-on. */
static const char *session(const char *input)
{
boot();
return say(input);
}
static void show(const char *label, const char *s)
{
printf(" %s\"", label);
@@ -154,7 +161,45 @@ static const transcript script[] = {
{ "1 1 0 */MOD\n", "*/MOD: Division by zero\n ERROR\nok> ", 1 },
{ ": T 1 0 / 65 EMIT ; T 66 EMIT\n67 EMIT\n", "/: Division by zero\n ERROR\nok> C ok\nok> ", 1 },
{ "0 0 /\n7 2 / 48 + EMIT\n", "/: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "DEPTH 48 + EMIT 5 6 DEPTH 48 + EMIT\n", "02 ok\nok> ", 1 },
{ "1 2 3 NOSUCH\nDEPTH 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 0 MOD\nDEPTH 48 + EMIT\n", "MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 1 0 */MOD\nDEPTH 48 + EMIT\n", "*/MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "1 2 3 ABORT\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 1 },
/* v4's own */
{ "1 2 3 QUIT\nDEPTH 48 + EMIT\n", "\nok> 3 ok\nok> ", 0 },
{ "65 EMIT DROP 66 EMIT\n67 EMIT\n", "AStack underflow\n ERROR\nok> C ok\nok> ", 0 },
{ "+\n1 +\nDUP\nOVER\n1 OVER\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> "
"Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
{ "1 2 3 4 5 6 7 8 9 10 11\nDEPTH 48 + EMIT\n", "Stack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": OV 1 2 3 4 5 6 7 8 65 EMIT 9 10 11 66 EMIT ; OV\nDEPTH 48 + EMIT\n", "AStack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "1 2 3 -1 @\nDEPTH 48 + EMIT\n", "Address out of range\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": RU R> DROP R> DROP ; 65 EMIT RU 66 EMIT\n67 EMIT\n", "AReturn stack underflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": N0 65 EMIT ; : N1 N0 ; : N2 N1 ; : N3 N2 ; : N4 N3 ; : N5 N4 ; : N6 N5 ;\n: N7 N6 ; N6 N7 66 EMIT\n67 EMIT\n",
" ok\nok> AReturn stack overflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": DEEP 1 >R 2 >R 3 >R 4 >R 5 >R 6 >R 65 EMIT 7 >R 8 >R 66 EMIT ; DEEP\n", "AReturn stack overflow\n ERROR\nok> ", 0 },
{ "65 66 67 1 PICK EMIT EMIT EMIT EMIT\n", "CCBA ok\nok> ", 0 },
{ "65 66 67 2 PICK EMIT EMIT EMIT EMIT\n", "BCBA ok\nok> ", 0 },
{ "65 66 67 3 PICK EMIT EMIT EMIT EMIT\n", "ACBA ok\nok> ", 0 },
{ "65 66 67 1 ROLL EMIT EMIT EMIT\n", "CBA ok\nok> ", 0 },
{ "65 66 67 2 ROLL EMIT EMIT EMIT\n", "BCA ok\nok> ", 0 },
{ "65 66 67 3 ROLL EMIT EMIT EMIT\nDEPTH 48 + EMIT\n", "ACB ok\nok> 0 ok\nok> ", 0 },
{ "65 66 0 PICK\nDEPTH 48 + EMIT\n", "PICK: Invalid index\n ERROR\nok> 2 ok\nok> ", 0 },
{ "65 66 -3 ROLL\n65 66 0 ROLL\n", "ROLL: Invalid index\n ERROR\nok> ROLL: Invalid index\n ERROR\nok> ", 0 },
{ "65 66 3 PICK\nDEPTH 48 + EMIT\n", "Stack underflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "65 66 5 ROLL\n1 PICK\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
/* nine values and n: the stack is full when PICK and ROLL start */
{ ": P9 65 2 3 4 5 6 7 8 9 9 PICK >R 2DROP 2DROP 2DROP 2DROP R> EMIT EMIT ; P9\n", "AA ok\nok> ", 0 },
{ ": R9 65 2 3 4 5 6 7 8 9 9 ROLL EMIT 2DROP 2DROP 2DROP DROP 48 + EMIT ; R9\n", "A2 ok\nok> ", 0 },
{ "65 66 67 68 69 5 ROLL EMIT EMIT EMIT EMIT EMIT\n", "AEDCB ok\nok> ", 0 },
{ "65 66 67 68 69 4 ROLL EMIT EMIT EMIT EMIT EMIT\n", "BEDCA ok\nok> ", 0 },
{ ": P5 65 66 67 68 69 5 PICK EMIT 3 PICK EMIT EMIT EMIT EMIT EMIT EMIT ; P5\n", "ACEDCBA ok\nok> ", 0 },
{ ": T1 QUIT ; : T2 1 2 3 4 T1 ; T2\nDEPTH 48 + EMIT\n", "\nok> 4 ok\nok> ", 0 },
{ ": T3 1 2 3 4 5 6 7 8 9 ABORT ; T3\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 0 },
/* with the return stack full or nearly: the exit empties it before it prints */
{ ": B0 1 ABORT\" d\" ; : B1 B0 ; : B2 B1 ; : B3 B2 ; : B4 B3 ; : B5 B4 ; : B6 B5 ;\nB6\n", " ok\nok> d\n ok\nok> ", 0 },
{ ": I0 5 0 PICK ; : I1 I0 ; : I2 I1 ; : I3 I2 ; : I4 I3 ; : I5 I4 ; : I6 I5 ; I6\n", "PICK: Invalid index\n ERROR\nok> ", 0 },
{ ": J0 5 0 / ; : J1 J0 ; : J2 J1 ; : J3 J2 ; : J4 J3 ; : J5 J4 ; : J6 J5 ; J6\n", "/: Division by zero\n ERROR\nok> ", 0 },
{ "1 0 0 M/MOD\n", "M/MOD: Division by zero\n ERROR\nok> ", 0 },
{ ": Z0 0 / ; : Z1 65 EMIT 9 Z0 66 EMIT ; Z1\n: Z2 1 IF [ 5 0 MOD ]\nZ2\n",
"A/: Division by zero\n ERROR\nok> MOD: Division by zero\n ERROR\nok> UNKNOWN WORD: 'Z2'\n ERROR\nok> ", 0 },
@@ -194,7 +239,7 @@ int main(void)
w_quit = v4_text_word(&tx, "QUIT");
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
w_fault = v4_text_word(&tx, "(FAULT)");
w_fault = v4_text_word(&tx, "(FAULTS)");
capsule_latest = v4_text_latest(&tx);
CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR");
@@ -208,7 +253,8 @@ int main(void)
/* ---- the sessions ---- */
for (i = 0; i < NSCRIPT; i++) {
const transcript *t = &script[i];
CHECK(is(session(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
boot_bare();
CHECK(is(say(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
CHECK(n.mem[STATE] == 0, "session %u ends interpreting", i);
}
@@ -329,26 +375,26 @@ int main(void)
CHECK(is(say("L1 69 EMIT\n"), " ok\nok> "), "ABORT out of two loops, time %u", i);
CHECK(is(say(": SQ DUP * ; 7 SQ EMIT\n"), "1 ok\nok> "), "and the next line compiles and runs, time %u", i);
}
CHECK(canary_under_expect(), "none of it disturbed the data stack");
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 ----
* N7 is eight words deep; with the prompt's call of INTERPRET that is all
* nine return entries. A ninth word would overwrite the first (D-2), so
* it is not tried here. */
* nine return entries. A ninth word is a fault (D-16). */
{
unsigned deepest = 0;
for (i = 0; i <= 7; i++) {
for (i = 0; i <= 8; i++) {
char line[64], want[16];
boot();
if (!is(say(": N0 1+ ; : N1 N0 1+ ; : N2 N1 1+ ; : N3 N2 1+ ; : N4 N3 1+ ;\n"), " ok\nok> ")) break;
if (!is(say(": N5 N4 1+ ; : N6 N5 1+ ; : N7 N6 1+ ;\n"), " ok\nok> ")) break;
if (!is(say(": N5 N4 1+ ; : N6 N5 1+ ; : N7 N6 1+ ; : N8 N7 1+ ;\n"), " ok\nok> ")) break;
snprintf(line, sizeof line, "47 N%u EMIT 33 EMIT\n", i);
snprintf(want, sizeof want, "%c! ok\nok> ", (char)('0' + i));
if (!is(say(line), want)) break;
if (strcmp(say(line), want) != 0) break;
deepest = i + 1;
}
printf(" from the prompt, words may call each other %u deep\n", deepest);
CHECK(deepest == 8, "a word run from the prompt has all the return stack but the prompt's one entry");
CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and a ninth is reported");
}
/* and with text printed at the bottom of the chain */
boot();
@@ -390,6 +436,17 @@ int main(void)
CHECK(d >= 3, "the prompt leaves room on the data stack");
}
/* ---- the fault table: five words, each a jump to its handler ---- */
{
static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)" };
for (i = 0; i < V4_FAULT_KINDS; i++) {
v4_iword w = (v4_iword)((v4_ucell)n.mem[w_fault + (v4_cell)i] & 0xFFFFFFFFu);
CHECK(v4_iword_op(w, 0) == V4_OP_JUMP && v4_iword_branch(w_fault + (v4_cell)i + 1, w, 0) == v4_text_word(&tx, handler[i]),
"word %u of the fault table jumps to %s", i, handler[i]);
}
CHECK(n.fault_vector == w_fault, "and the node has it");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
printf(" %d checks, %d failures\n", checks, failures);
v4/tests/test_stack.c
+41
View File
@@ -320,6 +320,46 @@ static void test_differential_random(void)
printf(" differential: %d ops\n", OPS);
}
/* D-16: each stack counts what it holds. The count stops at the stack's size
* and at zero; push and pop go on doing what they always did there, and it is
* the executor that turns those two cases into faults (test_exec.c). */
static void test_depth_count(void)
{
v4_dstack d;
v4_rstack r;
unsigned i;
v4_dstack_reset(&d);
v4_rstack_reset(&r);
CHECK(d.depth == 0 && r.depth == 0, "reset stacks hold nothing");
for (i = 1; i <= V4_DATA_DEPTH + 3u; i++) {
v4_dstack_push(&d, (v4_cell)i);
CHECK(d.depth == (i < V4_DATA_DEPTH ? i : (unsigned)V4_DATA_DEPTH), "data depth after %u pushes is %u", i, d.depth);
}
for (i = V4_DATA_DEPTH; i-- > 0; ) {
(void)v4_dstack_pop(&d);
CHECK(d.depth == i, "data depth counts down to %u", i);
}
(void)v4_dstack_pop(&d);
CHECK(d.depth == 0, "and stays at zero");
for (i = 1; i <= V4_RET_DEPTH + 3u; i++) {
v4_rstack_push(&r, (v4_cell)i);
CHECK(r.depth == (i < V4_RET_DEPTH ? i : (unsigned)V4_RET_DEPTH), "return depth after %u pushes is %u", i, r.depth);
}
for (i = V4_RET_DEPTH; i-- > 0; ) {
(void)v4_rstack_pop(&r);
CHECK(r.depth == i, "return depth counts down to %u", i);
}
(void)v4_rstack_pop(&r);
CHECK(r.depth == 0, "and stays at zero");
v4_dstack_push(&d, 5); v4_dstack_push(&d, 6); v4_rstack_push(&r, 7);
v4_dstack_clear(&d); v4_rstack_clear(&r);
CHECK(d.depth == 0 && r.depth == 0, "clear empties a stack");
CHECK(d.t == 6 && d.s == 5 && r.r == 7, "and changes nothing else");
CHECK(v4_dstack_guards_intact(&d) && v4_rstack_guards_intact(&r), "guards intact");
}
int main(void)
{
printf("v4 stack tests: V4_CELL_BITS=%d, data depth %d, return depth %d\n",
@@ -332,6 +372,7 @@ int main(void)
test_underflow_wraps_rather_than_trapping();
test_exhaustive_sequences();
test_differential_random();
test_depth_count();
printf(" %d checks, %d failures\n", checks, failures);
return failures ? 1 : 0;