From 0da7e32a0bafe8d4246a0406a373a4865cb14d35 Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 17:31:18 -0400 Subject: [PATCH] feat(v4.0.0): the stacks are guarded (D-16); DEPTH, PICK and ROLL 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 --- docs/v4.0.0/DECOMPOSITION.md | 32 +++++---- v4/capsule/compile.v4 | 6 +- v4/capsule/forth.v4 | 85 ++++++++++++++++++++--- v4/capsule/quit.v4 | 61 ++++++++++++----- v4/include/v4/exec.h | 11 +-- v4/include/v4/node.h | 84 ++++++++++++++++------- v4/include/v4/stack.h | 24 ++++++- v4/include/v4/testcode.h | 3 +- v4/src/exec.c | 45 +++++++++++- v4/src/node.c | 24 +++++-- v4/src/stack.c | 9 +++ v4/src/testcode.c | 1 + v4/tests/host_map.h | 9 ++- v4/tests/test_exec.c | 128 ++++++++++++++++++++++++++++++++--- v4/tests/test_host_quit.c | 85 +++++++++++++++++++---- v4/tests/test_stack.c | 41 +++++++++++ 16 files changed, 542 insertions(+), 106 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 56b8dfe2..ce804b7f 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -50,7 +50,7 @@ model produces the same results as the v3 C primitive it replaces. | Cell | 32 bits (mesh node). The host node's width is a build parameter; see D-5. | | Addressing | Word-addressed (D-1). | | Registers | `T` (top of data stack), `S` (second), `R` (top of return stack), `P` (program counter), `A` and `B` (address registers). | -| Stacks | F18 circular hardware stacks, not visible to code (D-2): data stack `T`, `S` + 8 circular (10 deep), return stack `R` + 8 circular (9 deep). No overflow or underflow; pushing past the bottom silently overwrites the oldest entry. | +| Stacks | F18 hardware stacks, not addressable by code: data stack `T`, `S` + 8 (10 deep), return stack `R` + 8 (9 deep). Each counts what it holds, and a push onto a full stack or a pop from an empty one is a **fault** (D-16, which replaces D-2's silent wrap-around). | | Instruction word | Six 5-bit slots, plus 2 spare bits. | ### 1.2 Instruction word layout @@ -163,24 +163,26 @@ definition below depends on one, it says so. | ID | Decision | Ruling | | --- | --- | --- | | **D-1** | Word addressing (pure Moore) or byte addressing. | **Word addressing.** `C@`/`C!` are CAP; `CELLS` is a no-op. | -| **D-2** | Stack depth, and whether the stacks are visible. | **F18 circular stacks, hidden.** Data stack 10 deep (`T`, `S` + 8 circular), return stack 9 deep (`R` + 8 circular), exactly as the F18. No stack pointer is visible to code, so `DEPTH`, `PICK`, `ROLL`, `.S`, `SP@` and `SP!` are **retired everywhere**, host node included. | +| **D-2** | Stack depth, and whether the stacks are visible. | **F18 circular stacks, hidden.** Data stack 10 deep (`T`, `S` + 8 circular), return stack 9 deep (`R` + 8 circular), exactly as the F18. No stack pointer is visible to code, so `DEPTH`, `PICK`, `ROLL`, `.S`, `SP@` and `SP!` are **retired everywhere**, host node included. **Revised by D-16 (2026-10-04):** the sizes stand and the stacks are still not addressable, but they are no longer circular in effect — they are counted and guarded — and `DEPTH`, `PICK` and `ROLL` are back. | | **D-3** | Exact `+*` semantics at 32 bits: whether the add carries out of `T` into the shift. | **Plain F18 semantics.** The carry out of `T` is not kept. `UM*` in §4 is written for this and is exact over the full range (revised and proven on the golden model, 2026-10-02). | | **D-4** | Node memory map, including port and register addresses. | **Deferred** to step 2. Symbolic names only for now (§6, §7). | | **D-5** | Host node cell width. | **Match the host CPU:** 32 on a Zynq-7000 (Cortex-A9), 64 on an aarch64 host. The compiler capsule is written width-independent. | | **D-6** | Which heat structures exist in hardware: per-opcode counters only, or also per-call-target and word-to-word transition counters. | **Deferred** to step 2. The golden model implements per-opcode and per-call-target heat in the meantime. | -| **D-7** | `ROLL` semantics. | **Moot.** `ROLL` is retired under D-2. | +| **D-7** | `ROLL` semantics. | **FORTH-79** (2026-10-04, with D-16): `n ROLL` takes out the n-th value, counting from one and not counting `n`, and puts it on top; `3 ROLL` is `ROT`, `1 ROLL` does nothing; `n < 1` is an error. `PICK` counts the same way: `1 PICK` is `DUP`. v3's count from zero. | | **D-8** | Q48.16 signedness. | **Signed.** v3's unsigned comparisons and `Q.FROM-INT` clamping are retired. | | **D-9** | Instruction word width on a 64-bit-cell host (ruled 2026-10-02). | **32 bits at every cell width.** Six 5-bit slots plus 2 spare bits, as in §1.2. On a 64-bit host the instruction word is the low 32 bits of the cell and the high half is ignored, so compiled code is identical at both widths. Only data and `@p` literals are a full cell wide. | | **D-10** | Q48.16 width on a 64-bit-cell node (ruled 2026-10-02). | **Two cells at every cell width.** A Q value is a signed double on 32- and 64-bit nodes alike, so every Q word is the same double word at both widths. At 32-bit cells this is bit-for-bit v3's 64-bit Q. At 64-bit cells the low cell is v3's value, and where v3 wraps on Q48.16 overflow (a sum past Q max, `ABS` or `NEG` of Q min) the high cell carries the true result instead. | | **D-11** | `Q./` semantics: division by zero, rounding, overflow (ruled 2026-10-02). | **Saturate and flag; round toward zero; saturate on overflow.** The quotient of `a * 2^16 / b` is rounded toward zero, like `SM/REM`. When it does not fit a Q value it is clamped to Q max or Q min by its sign. Division by zero returns Q max or Q min by the sign of the dividend (`0 / 0` gives 0) and sets the node's `NODE-ERROR` register (§7), which `VM-ERROR?` reads. v3 returned 0 on division by zero and saturated whenever the dividend was 2^48 or more, even when the quotient would have fit. | | **D-12** | Q approximations outside their domain (ruled 2026-10-02). | **Return 0 and set `NODE-ERROR`.** `Q.SQRT` of a negative value and `Q.LOG` of zero or a negative value return 0 and set `NODE-ERROR` (§7), as `Q./` does on division by zero (D-11). v3 returned 0 for `ln(0)` without a flag and read negative arguments as large unsigned values. | | **D-13** | Pictured-output hold buffer: size and errors (ruled 2026-10-03). | **63 characters, as v3; on error set `NODE-ERROR` and drop the character.** The buffer holds 63 characters at either cell width. `HOLD` of a value outside 0–255, or into a full buffer, stores nothing and sets `NODE-ERROR` (§7), which is v3's behaviour (it set its error flag and dropped the character). A full double in base 2 therefore does not fit, as in v3. | -| **D-14** | An address outside the node's memory (ruled 2026-10-04). | **Guarded: an address fault.** Every address a running programme uses is checked before it is used — `P` when an instruction word or an `@p` literal is fetched or `!p` stores, `A` for `@ @+ ! !+`, `B` for `@b !b`. Outside `0 … memory size − 1` the opcode does nothing (no fetch, no store, stacks and `A`, `B` untouched), the rest of its instruction word is not executed, and `P` becomes the node's **fault handler**. Nothing is pushed: the handler does not return to the programme. On the host node the handler is `(FAULT)` (`v4/capsule/quit.v4`): it prints `Address out of range`, ends any definition that was open, prints ` ERROR` and returns to the prompt, from however deep the fault was. A node with no handler stops. v3 printed ` ERROR` alone. What a mesh node's handler does — it has no console — comes with the mesh (step 2). Executed on the golden model (2026-10-04): `tests/test_exec.c` for every memory opcode and for `P`, `tests/test_host_quit.c` from the prompt. | -| **D-15** | Division by zero in `/` `MOD` `/MOD` `*/` `*/MOD` `M/MOD` (ruled 2026-10-04). | **Guarded: the word reports it and the line ends.** Each of these words tests its divisor before anything else. If it is zero the word prints v3's message, its own name and `: Division by zero`, ends any definition that was open, prints ` ERROR` and returns to the prompt, from however deep; its caller is not returned to. `M/MOD` says so too, where v3 printed ` ERROR` alone. Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. `Q./` keeps D-11 (saturate and flag). `UM/MOD` and `SM/REM` are internal and unguarded: their callers have checked. What a mesh node, with no console, does on a zero divisor comes with the mesh (step 2); §4's definitions, which the mesh-node tests execute, still leave it unspecified. | +| **D-14** | An address outside the node's memory (ruled 2026-10-04). | **Guarded: an address fault.** Every address a running programme uses is checked before it is used — `P` when an instruction word or an `@p` literal is fetched or `!p` stores, `A` for `@ @+ ! !+`, `B` for `@b !b`. Outside `0 … memory size − 1` the opcode does nothing (no fetch, no store, `A` and `B` untouched), the rest of its instruction word is not executed, both stacks are emptied (D-16), and `P` becomes the node's **fault handler** for that kind of fault. The handler does not return to the programme. On the host node the handler is `(FAULT)` (`v4/capsule/quit.v4`): it prints `Address out of range`, ends any definition that was open, prints ` ERROR` and returns to the prompt, from however deep the fault was. A node with no handler stops. v3 printed ` ERROR` alone. What a mesh node's handler does — it has no console — comes with the mesh (step 2). Executed on the golden model (2026-10-04): `tests/test_exec.c` for every memory opcode and for `P`, `tests/test_host_quit.c` from the prompt. | +| **D-15** | Division by zero in `/` `MOD` `/MOD` `*/` `*/MOD` `M/MOD` (ruled 2026-10-04). | **Guarded: the word reports it and the line ends.** Each of these words tests its divisor before anything else. If it is zero the word prints v3's message, its own name and `: Division by zero`, takes its operands off the stack as v3 does, ends any definition that was open, prints ` ERROR` and returns to the prompt, from however deep; its caller is not returned to. `M/MOD` says so too, where v3 printed ` ERROR` alone. Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. `Q./` keeps D-11 (saturate and flag). `UM/MOD` and `SM/REM` are internal and unguarded: their callers have checked. What a mesh node, with no console, does on a zero divisor comes with the mesh (step 2); §4's definitions, which the mesh-node tests execute, still leave it unspecified. | +| **D-16** | Stack overflow and underflow; `DEPTH`, `PICK`, `ROLL` (ruled 2026-10-04; revises D-2). | **Guarded: a stack fault.** Each stack counts what it holds. Before every opcode the node checks that the stacks hold what the opcode takes — including a `T` or `S` it only reads — and have room for what it leaves. If not, the opcode does nothing and the node faults exactly as for a bad address (D-14), to that kind's handler: `Stack overflow`, `Stack underflow`, `Return stack overflow`, `Return stack underflow`, then ` ERROR` and the prompt. **Every fault, D-14's included, empties both stacks**: the handler does not return, and what a word stopped part-way has left on the data stack is of no use to its caller. (v3 keeps what the failing word had not taken, and names the word: `DROP: Stack underflow`.) The fault handler is a table of five words, one per kind, each a jump (`(FAULTS)` in `v4/capsule/quit.v4`). Two registers (§7) are all a programme sees of the stacks: `DSTACK-DEPTH` and `RSTACK-DEPTH` read as the depth, and a store to one empties that stack. There is still no stack pointer and no address for a stack cell, so `SP@` and `SP!` stay retired; `.S` waits for number output to reach the capsule. The sizes are unchanged, 10 and 9: one more value, or one more level of call, is now an error message where it used to be silent corruption. Executed on the golden model (2026-10-04): `tests/test_exec.c` for every opcode at every depth of both stacks, `tests/test_host_quit.c` from the prompt. | **Consequences of D-2 that every definition must respect.** The data stack holds 10 items and the return stack 9, and every `call`, `FOR`, `DO` loop frame and `push` uses return-stack slots. Nesting -is therefore shallow, and exceeding either depth corrupts silently rather than faulting. Every CAP +is therefore shallow, and exceeding either depth is a stack fault (D-16; before 2026-10-04 it +corrupted silently). Every CAP definition in §4 and §5 must be re-checked against these limits before it is accepted as a POST target; the hand traces so far assumed unbounded stacks. @@ -311,9 +313,9 @@ Section numbers match the v3 primitive reference. | `?DUP` | CAP | `if Z dup ; Z: ;` (`dup IF dup THEN` without the extra copy). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `ROT` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 4 return entries; in line, with `SWAP` in line, it calls nothing. | | `-ROT` | CAP | `SWAP push SWAP pop`, `SWAP` in line (`ROT ROT` in one pass). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 5 return entries. | -| `DEPTH` | RET | No visible stack pointer (D-2). | -| `PICK` | RET | No visible stack pointer (D-2). | -| `ROLL` | RET | No visible stack pointer (D-2); D-7 is moot. | +| `DEPTH` | CAP | FORTH-79: how many values were on the stack before `DEPTH`. `DSTACK-DEPTH b! @b` (D-16). Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04), including a transcript of the v3 binary. | +| `PICK` | CAP | FORTH-79 (D-7): `( n -- x )`, a copy of the n-th value counting from one; `1 PICK` is `DUP`, `2 PICK` is `OVER`. The stack has no addresses, so the `n - 1` values above the one wanted are set aside in memory and put back. `n < 1` prints `PICK: Invalid index`; `n` greater than the depth is a stack underflow fault. It works with the stack full (nine values and `n`). v3's `PICK` counts from zero. Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04). | +| `ROLL` | CAP | FORTH-79 (D-7): `( n -- )`, the n-th value counting from one is taken out and put on top; `3 ROLL` is `ROT`, `1 ROLL` does nothing. Built as `PICK` is, with the same errors. v3's `ROLL` counts from zero. Source in `v4/capsule/forth.v4`; executed on the golden model's host node (2026-10-04). | ### 5.2 Return stack @@ -469,7 +471,7 @@ All output reaches the console through `EMIT` (DEV). | `HLD` | CAP | Variable: byte address of the first held character. `HLD ( -- addr )` is the variable's word address, a literal. Not a v3 word. Executed on the golden model (2026-10-03): after `<#` and each `HOLD` or `#`, `HLD @` is the address `#>` returns. | | `.` `.R` `U.` `U.R` `D.` `D.R` | CAP | Built on pictured output and `TYPE`; definitions below. `.`, `U.` and `D.` print the number in the current base, then one space. The `.R` words right-justify it in `width` columns, print a wider number whole, pad nothing for `width <= 0`, and print no space after it: that is FORTH-79's reference word (ruled 2026-10-04); v3 printed a space after these too. Where v4 parts from v3: a double is `( lo hi )`, where v3's `D.` took the low cell on top; `D.` prints the whole double, where v3 printed `DOUBLE-OVERFLOW` unless it fitted one signed cell (they agree whenever it does); printing honours the `BASE` variable, where v3 printed in a host copy that only `DECIMAL`, `HEX` and `OCTAL` set, so `n BASE !` changed v3's input base but not its output; and the number is built in the 63-character hold buffer, so a longer one — a 64-bit cell in base 2, a large double in a small base — loses its leading characters and sets `NODE-ERROR` (D-13), where v3 printed from a private 80-character buffer. Executed on the golden model (2026-10-03) against a C reference in the ten bases of the pictured-output test and eleven field widths, and against five transcripts of the v3 binary (a sixth, the extreme cells, at 64-bit cells). Each leaves its caller 4 data cells; `U.` and `U.R` leave 3 return entries, the signed words 2, their sign waiting on the return stack. All clobber `A` and `B`. | | `(W)` | CAP | Variable, 2 cells: the field width of the `.R` words, and whether a blank follows the number. Like `BASE` and `HLD`, it lives in node memory, so the width is on neither stack while the picture runs. | -| `.S` | RET | No visible stack pointer (D-2). | +| `.S` | CC | Possible again under D-16 (`DEPTH` and `PICK`); not written until number output is in the capsule. | | `?` | CAP | `( addr -- )`: `a! @ jump .` — the cell at word address `addr` (D-1), printed as `.` prints it. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 2 return entries. Clobbers `A` and `B`. | | `DUMP` | CAP | `( baddr u -- )`: `u` bytes from byte address `baddr`, sixteen to a line, in v3's format: the address in hex, `": "`, each byte as two hex digits and a space (three spaces where the line runs out), `" \|"`, the bytes as characters with `.` for anything outside 32–126, `"\|"` and a new line. Always hex, whatever `BASE` is, and `BASE` is put back. The address is two hex digits per byte of a cell — 8 at 32-bit cells, 16 at 64, which is v3's width. Nothing for `u = 0`; for `u < 0` nothing is printed and `NODE-ERROR` is set, as `TYPE` does, where v3 raised its error flag. Addresses are not range-checked (open, `node.h`). Definition below. Executed on the golden model (2026-10-03) against a C reference at six alignments and every length 0–50, and at 64-bit cells against a transcript of the v3 binary, byte for byte. Leaves its caller 4 data cells and 4 return entries. Clobbers `A` and `B`. | | `(DP)` | CAP | Variable, 4 cells: `DUMP`'s saved `BASE`, address, count and column. | @@ -677,7 +679,7 @@ 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; 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). `,` calls nothing and leaves its caller 7 data cells and 8 return entries; `ALLOT` leaves 7 and 7. | -| `SP@` `SP!` | RET | No visible stack pointer (D-2). | +| `SP@` `SP!` | RET | A stack cell has no address (D-2, D-16). `DEPTH`, and a store to `DSTACK-DEPTH` to empty the stack, are what remain of them. | ### 5.13 Dictionary manipulation @@ -717,8 +719,8 @@ it, `xt + 1`; for any other word the parameter field is the code itself. | `(` `\` | CC | `(` is `41 WORD drop`; `\` is `SPAN @ >IN !`. In `v4/capsule/input.v4` under the names `PAREN` and `BACKSLASH`. Executed on the golden model's host node (2026-10-04). | | `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller). Executed on the golden model's host node (2026-10-04). | | `NOP` | OP | `nop` | -| `QUIT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. Clears the return stack, sets execution mode, returns control to the terminal; no message. It is the prompt: after a new line it prints `ok> `, reads a line with `QUERY`, clears `NODE-ERROR`, runs `INTERPRET`, prints ` ok` — or, if `NODE-ERROR` is set, ends any definition that was open and prints ` ERROR` — and goes round again, for as long as the node runs. The text is v3's. The line is not sent back; the terminal shows what is typed. The return stack is circular (D-2) and has no bottom to reset to: `QUIT` clears it by jumping into the loop and never returning, from however deep. The data stack is left alone. A definition open when `QUIT` runs is ended and stays hidden. Executed on the golden model's host node (2026-10-04): the node is started at `QUIT`, fed characters and its output read, including 16 sessions recorded from the v3 binary. v3's `QUIT` goes on with the rest of the line and cannot be compiled into a definition. | -| `ABORT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. As `QUIT`, and the line it stops ends with ` ok`, as v3. The data stack is circular (D-2): there is nothing to clear, and what was on it is still there. Executed on the golden model's host node (2026-10-04), from six calls down and from inside two loops, forty times over. | +| `QUIT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. Clears the return stack, sets execution mode, returns control to the terminal; no message. It is the prompt: after a new line it prints `ok> `, reads a line with `QUERY`, clears `NODE-ERROR`, runs `INTERPRET`, prints ` ok` — or, if `NODE-ERROR` is set, ends any definition that was open and prints ` ERROR` — and goes round again, for as long as the node runs. The text is v3's. The line is not sent back; the terminal shows what is typed. It empties the return stack first, by a store to `RSTACK-DEPTH` (D-16), so it works from however deep, with the return stack full. The data stack is left alone. A definition open when `QUIT` runs is ended and stays hidden. Executed on the golden model's host node (2026-10-04): the node is started at `QUIT`, fed characters and its output read, including 16 sessions recorded from the v3 binary. v3's `QUIT` goes on with the rest of the line and cannot be compiled into a definition. | +| `ABORT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. As `QUIT`, and it empties the data stack too (a store to `DSTACK-DEPTH`, D-16); the line it stops ends with ` ok`, as v3. Executed on the golden model's host node (2026-10-04), from six calls down and from inside two loops, forty times over, including transcripts of the v3 binary. | | `ABORT"` `(ABORT")` | CC | Not FORTH-79 (it is FORTH-83's); kept because v3 has it. `ABORT" text"` `( flag -- )`: if the flag is not zero, print the text, start a new line and `ABORT`. Compiled as `."` is, with `(ABORT")` as the run-time word; it also works at the prompt. Executed on the golden model's host node (2026-10-04). v3's crashes (SIGSEGV) when a word compiled with it runs, and at the prompt prints the text and carries on with the line. | | `COLD` `WARM` | CC | | | `BYE` `REBOOT` | HERA | | @@ -751,7 +753,7 @@ call would bury what it works on. A **compile-only** word may not be executed by `v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`, `LEAVE`, `@`, the in-line variables and so on). -**The short stacks (D-2) and the compiler.** The interpreter and compiler run on the same ten-cell and +**The short stacks (D-2, D-16) and the compiler.** The interpreter and compiler run on the same ten-cell and nine-entry stacks as the user's words, with the user's values beneath them. Two consequences are built into the capsule: @@ -1044,3 +1046,5 @@ Addresses are assigned in the node memory map (D-4). Names only here. | `CONSOLE-TX` | W | Console transmit: a store sends the low 8 bits of the value as one character. This is what `EMIT` writes to. On the single-node golden model it is a capture register: the character is appended to a buffer on the node and memory is not written (`v4_node_console_attach`, `v4/include/v4/node.h`), so printing words can be run and their output compared with v3's. With the mesh (step 2) it becomes the port to the console node. | | `CONSOLE-RX` | R | Console receive: a fetch gives the next pending character, 0–255, and takes it; with none pending it gives −1 and takes nothing. This is what `KEY` reads. On the single-node golden model the characters come from a queue the test feeds (`v4_node_console_input_attach`, `v4_node_console_feed`, `v4/include/v4/node.h`). Only the data fetches `@`, `@+` and `@b` see the register; instruction words and literals at the same address are read as memory. With the mesh (step 2) it becomes the port from the console node, and a read with nothing pending will block instead. | | `CONSOLE-STATUS` | R | Console receive status: a fetch gives −1 when a character is pending and 0 when not, and changes nothing. `?TERMINAL` reads it, and `KEY` polls it. On the mesh it is the console port's bit of `PORT-STATUS`. | +| `DSTACK-DEPTH` | R/W | A fetch gives how many values the data stack holds, the fetch's own push not counted. A store empties the data stack; the value stored is taken off first and ignored. `DEPTH` reads it; `ABORT` stores to it (D-16). | +| `RSTACK-DEPTH` | R/W | The same for the return stack. `QUIT`, `ABORT` and the error exits store to it before they call anything. | diff --git a/v4/capsule/compile.v4 b/v4/capsule/compile.v4 index 9fc77a11..c8656521 100644 --- a/v4/capsule/compile.v4 +++ b/v4/capsule/compile.v4 @@ -17,8 +17,8 @@ \ compile-only it may not be executed by the interpreter. \ An immediate word is executed even when compiling. \ -\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and no -\ way to see how full they are. The interpreter and compiler run on the same +\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and one +\ more of either is a fault (D-16). The interpreter and compiler run on the same \ stacks as the user's words, with the user's values beneath them, so: \ - every word here keeps what it works on in (C), and has at most three \ cells of its own on the data stack at any moment; @@ -184,7 +184,7 @@ header : 32 WORD (HEADER) LATEST (C)+2 a! @ xor if NONE drop HIDDEN (CG-RESET) CFBASE (CFP) a! ! jump RIGHT-BRACKET - NONE: drop ; + NONE: drop jump (ABANDON) \ no entry: the rest of the line is not a definition \ FORTH-79: compile the return, let the word be found, stop compiling header ; immediate compile-only diff --git a/v4/capsule/forth.v4 b/v4/capsule/forth.v4 index f1e89d8f..f9d65395 100644 --- a/v4/capsule/forth.v4 +++ b/v4/capsule/forth.v4 @@ -5,7 +5,7 @@ \ A word flagged inline is copied into a definition in place of a call; the \ ones that touch the return stack are compile-only as well. Rests on core.v4, \ compile.v4's loader constants, and quit.v4, which the division words leave -\ through when the divisor is zero. (F) is three cells of scratch for +\ through when the divisor is zero. (F) is seven cells of scratch for \ this file. \ ---- stack ---- @@ -19,6 +19,68 @@ header ?DUP : ?DUP if Z dup ; Z: ; header 2DUP inline : 2DUP over over ; header 2DROP inline : 2DROP drop drop ; +\ ---- the stack as a whole (D-16) ---- +\ DEPTH reads the stack register. PICK and ROLL reach under the top of a +\ stack that has no addresses: the values above the one wanted are set aside +\ in (S), and put back. (F)+3 how many are still to set aside, (F)+4 where +\ the next goes, (F)+5 the value wanted, (F)+6 how many are set aside. With nine values and n on the +\ stack it is full, so until a value has been set aside nothing here pushes +\ anything while n is still there, and never more than one cell after. + +\ FORTH-79: how many values were on the stack before DEPTH +header DEPTH +: DEPTH DSTACK-DEPTH b! @b ; + +\ ( name -- ) "xxxx: Invalid index", and the line ends with ERROR +: (INDEX) + R-CLEAR (EMIT4) $6E49203A (EMIT4) $696C6176 (EMIT4) $6E692064 (EMIT4) $786564 (EMIT4) CR + 2 jump (REPL) + +\ ( x1 .. xn-1 -- ) A: n, which is 2 or more. Set the n-1 values above +\ the n-th aside. If there are not that many, the pop that finds the stack +\ empty is a fault: "Stack underflow". The count is taken down only after a +\ value has been set aside, when there is room to do the arithmetic. +: (DIG) + (F)+3 b! a !b + (F)+4 b! (S) !b + (F)+6 b! 0 !b + L: (F)+4 b! @b a! !+ + a (F)+4 b! !b + (F)+6 b! @b 1 + !b + (F)+3 b! @b -1 + dup !b + -1 + if DONE drop jump L + DONE: drop ; +\ ( -- x1 .. xk ) put them back. The test that ends it pushes one cell: +\ after the last value is back the stack may be one short of full. +: (BURY) + L: (F)+6 b! @b if DONE -1 + !b + (F)+4 a! @ -1 + dup ! a! @ + jump L + DONE: drop ; + +\ ( n -- x ) FORTH-79: a copy of the n-th value, not counting n itself. +\ 1 PICK is DUP, 2 PICK is OVER. n less than one is an error. +header PICK +: PICK + -if POS jump BAD + POS: if BAD + a! a 2/ if ONE drop \ n is 1 when half of it is 0 + (DIG) dup (F)+5 a! ! (BURY) (F)+5 a! @ ; + ONE: drop dup ; + BAD: drop $4B434950 jump (INDEX) + +\ ( n -- ) FORTH-79: the n-th value, not counting n itself, is taken out +\ and put on top. 3 ROLL is ROT, 2 ROLL is SWAP, 1 ROLL does nothing. n +\ less than one is an error. +header ROLL +: ROLL + -if POS jump BAD + POS: if BAD + a! a 2/ if ONE drop + (DIG) (F)+5 a! ! (BURY) (F)+5 a! @ ; + ONE: drop ; + BAD: drop $4C4C4F52 jump (INDEX) + \ ---- return stack: in line, and only inside a definition ---- header >R inline compile-only : >R push ; header R> inline compile-only : R> pop ; @@ -56,11 +118,14 @@ header 2/ inline : TWO/ 2/ ; \ does anything else, and a zero divisor prints v3's message -- \ /: Division by zero \ -- and ends the line with ERROR, from however deep, as an address fault -\ does. Nothing is left for the word's caller: it is not returned to. +\ does. The word's operands are taken off the stack, as v3 takes them, and +\ its caller is not returned to. -\ ( name -- ) name is up to four characters of the word's name (EMIT4) +\ ( name2 name1 -- ) the word's name: its first four characters, and the +\ rest or 0 (EMIT4). The return stack is emptied before anything is called: +\ the word may have been run with it full. : (DIV0) - (EMIT4) $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4) \ ": Division b" + R-CLEAR (EMIT4) (EMIT4) $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4) \ ": Division b" $657A2079 (EMIT4) $6F72 (EMIT4) CR \ "y zero" 2 jump (REPL) @@ -119,27 +184,27 @@ header M* header /MOD : /MOD ( n1 n2 -- rem quot ) if Z push S>D pop jump SM/REM - Z: $444F4D2F jump (DIV0) + Z: drop drop 0 $444F4D2F jump (DIV0) header / : / ( n1 n2 -- quot ) if Z push S>D pop SM/REM NIP ; - Z: $2F jump (DIV0) + Z: drop drop 0 $2F jump (DIV0) header MOD : MOD ( n1 n2 -- rem ) if Z push S>D pop SM/REM drop ; - Z: $444F4D jump (DIV0) + Z: drop drop 0 $444F4D jump (DIV0) header */MOD : */MOD ( n1 n2 n3 -- rem quot ) if Z jump (*/MOD) - Z: $4F4D2F2A (EMIT4) $44 jump (DIV0) + Z: drop drop drop $44 $4F4D2F2A jump (DIV0) header */ : */ ( n1 n2 n3 -- quot ) if Z (*/MOD) NIP ; - Z: $2F2A jump (DIV0) + Z: drop drop drop 0 $2F2A jump (DIV0) header M/MOD : M/MOD ( d n -- rem quot ) if Z jump SM/REM - Z: $4F4D2F4D (EMIT4) $44 jump (DIV0) + Z: drop drop drop $44 $4F4D2F4D jump (DIV0) \ ---- logic and comparison ---- header AND inline : AND and ; diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index 93958afa..d3a269db 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -16,21 +16,29 @@ \ ERROR \ The line itself is not sent back: the terminal shows what is typed. \ -\ THE RETURN STACK is circular (D-2): it has no bottom to be reset to, and -\ what is on it is simply never returned to once QUIT stops returning. So -\ QUIT and ABORT "clear" it by jumping into the loop, from however deep. The -\ data stack is circular too: ABORT has nothing to clear. +\ THE STACKS are guarded (D-16): each counts what it holds, and a push onto +\ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which +\ never return to whatever ran them, must empty the return stack, and ABORT +\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that. \ \ Constants the loader supplies: \ (Q) word address of two cells of scratch for this file +\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers + +\ ( -- ) empty the return stack. `a` is only something to store: any +\ store to the register empties the stack, and `a` needs nothing to be on +\ the data stack. One cell of the data stack is used for a moment. +macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ ( -- ) stop compiling; forget the word being built and any open control \ structures. A definition that was under way stays hidden. : (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ; \ ( k -- ) the loop. It is entered with what to say first -- 0 nothing, -\ 1 " ok", anything else " ERROR" -- and never returns. Each line is -\ interpreted with one return entry under it, this word's call of INTERPRET. +\ 1 " ok", anything else " ERROR" -- and never returns. It is always jumped +\ to, never called, by something that has emptied the return stack (or by a +\ fault, which empties it). Each line is then interpreted with one return +\ entry under it, this word's call of INTERPRET. : (REPL) if GO -1 + if OK drop (RESET) $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR" @@ -48,21 +56,42 @@ \ FORTH-79: clear the return stack, set execution mode, return control to \ the terminal; no message is given. The data stack is left as it is. header QUIT -: QUIT (RESET) CR 0 jump (REPL) +: QUIT R-CLEAR (RESET) CR 0 jump (REPL) \ FORTH-79: clear the data and return stacks, set execution mode, return \ control to the terminal. As v3, the line it stops ends with " ok". +\ Both are emptied before anything is called: ABORT may be run with the +\ return stack full. header ABORT -: ABORT (RESET) 1 jump (REPL) +: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (REPL) -\ ( -- ) where the node goes when a programme uses an address outside its -\ memory (D-14): the loader makes this word the node's fault handler. The -\ opcode that faulted did nothing; whatever was running is abandoned, as by -\ ABORT, and the line ends with ERROR. -: (FAULT) - $72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) \ "Address out " - $7220666F (EMIT4) $65676E61 (EMIT4) CR \ "of range" +\ ---- faults (D-14, D-16) ------------------------------------------------------- +\ Where the node goes when a programme uses an address outside its memory, +\ pushes onto a full stack or pops an empty one. The opcode that faulted did +\ nothing, and both stacks have been emptied. Each handler says what happened; +\ whatever was running is abandoned, as by ABORT, and the line ends with +\ ERROR. +: (FAULT) \ "Address out of range" + $72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL) +: (D-OVER) \ "Stack overflow" + $63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR + 2 jump (REPL) +: (D-UNDER) \ "Stack underflow" + $63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR + 2 jump (REPL) +: (R-OVER) \ "Return stack overflow" + $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR + 2 jump (REPL) +: (R-UNDER) \ "Return stack underflow" + $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR + 2 jump (REPL) + +\ The table the loader gives the node: five words, one for each kind of +\ fault in the node's order, each a jump. A jump fills its word, so they +\ are one after another. +: (FAULTS) + jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) \ ---- text in the source --------------------------------------------------------- \ ." and ABORT" take the text up to the next " , which may be none at all @@ -108,7 +137,7 @@ header ." immediate \ the string. : (ABORT") if NO - drop pop 4* COUNT TYPE CR jump ABORT + drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT NO: drop pop 4* dup C@ + 4/ 1 + push ; \ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if diff --git a/v4/include/v4/exec.h b/v4/include/v4/exec.h index bb656a45..5bfa09d9 100644 --- a/v4/include/v4/exec.h +++ b/v4/include/v4/exec.h @@ -45,10 +45,13 @@ void v4_exec_reset(v4_exec_state *es); * so the call does not return while R is nonzero at a `unext`. Returns the * number of instructions retired. * - * An address outside node memory -- P at the fetch, or the address an opcode - * uses -- is a fault (node.h, D-14): that opcode and the rest of the word do - * not execute, and P is the node's fault handler on return. With no handler - * the node stops, and this does nothing and returns 0 from then on. */ + * FAULTS (node.h; D-14 and D-16). Before an opcode runs, the stacks must + * hold what it takes -- a T or S it only reads counts -- and have room for + * what it leaves; and an address it uses, or P at the fetch, must be inside + * node memory. If not, that opcode and the rest of the word do not execute, + * both stacks are emptied, and P is that kind's word of the node's fault + * table on return. With no table the node stops, and this does nothing and + * returns 0 from then on. */ unsigned v4_exec_step_word(v4_node *n, v4_exec_state *es, v4_heat *h); /* Execute a single opcode. The branch opcodes read their target from `w` and diff --git a/v4/include/v4/node.h b/v4/include/v4/node.h index 45cbb4c2..3b3e416d 100644 --- a/v4/include/v4/node.h +++ b/v4/include/v4/node.h @@ -81,11 +81,16 @@ typedef struct { unsigned input_pos; /* characters taken; input_len - input_pos are pending */ unsigned char input[V4_CONSOLE_CAP]; - /* Address faults (D-14). See v4_node_fault_attach below. */ - v4_cell fault_vector; /* word address of the handler, or -1: none */ - v4_cell fault_addr; /* the address of the latest fault */ + /* Faults (D-14, D-16). See v4_node_fault_attach below. */ + v4_cell fault_vector; /* word address of the handler table, or -1: none */ + v4_cell fault_addr; /* the address of the latest address fault */ + unsigned fault_kind; /* which kind the latest fault was (V4_FAULT_*) */ unsigned faults; /* how many there have been */ int stopped; /* non-zero: faulted with no handler */ + + /* DSTACK-DEPTH and RSTACK-DEPTH (D-16). See v4_node_stack_regs_attach. */ + v4_cell dstack_reg; /* its word address, or -1 */ + v4_cell rstack_reg; /* its word address, or -1 */ } v4_node; /* Zero P, A and B, empty the stacks, and clear memory. Installs every @@ -173,31 +178,58 @@ v4_cell v4_node_fetch(v4_node *n, v4_cell addr); /* 1 if `addr` is a word of node memory. */ int v4_node_addr_ok(v4_cell addr); -/* ADDRESS FAULTS (DECOMPOSITION.md D-14, ruled 2026-10-04: an address outside - * the node's memory is guarded, an error is shown, and the node returns to - * its prompt). +/* FAULTS (DECOMPOSITION.md D-14 and D-16, ruled 2026-10-04: an address + * outside the node's memory, and a stack pushed when full or popped when + * empty, are guarded; an error is shown; the node returns to its prompt). * - * The executor checks every address a programme uses before using it: P when - * an instruction word or an `@p` literal is fetched or `!p` stores, A for - * `@ @+ ! !+`, B for `@b !b`. If it is outside memory there is a fault: - * - the opcode does nothing: no fetch, no store, the stacks and A and B - * untouched, nothing retired; the rest of its instruction word is not - * executed; - * - fault_addr is the address and faults is one more; - * - P becomes fault_vector, the address of the node's handler. Nothing is - * pushed: the handler does not return to the programme, it reports and - * goes back to the prompt (capsule/quit.v4, (FAULT)). - * With no handler attached (fault_vector -1) the node stops instead: - * `stopped` is set and v4_exec_step_word does nothing more until the node is - * reset or a handler is attached. + * The executor checks before every opcode (exec.h): + * - that the stacks hold what the opcode takes and have room for what it + * leaves; + * - every address a programme uses: P when an instruction word or an `@p` + * literal is fetched or `!p` stores, A for `@ @+ ! !+`, B for `@b !b`. + * If a check fails there is a fault: + * - the opcode does nothing, and the rest of its instruction word is not + * executed; A and B are untouched; + * - fault_kind says which, fault_addr is the address for an address fault, + * and faults is one more; + * - both stacks are emptied. The handler does not return to the + * programme, and what a word stopped in the middle of its work has left + * on the data stack is not something its caller can use; + * - P becomes fault_vector + fault_kind. The handler table is five words, + * one for each kind in the order below, each a jump to that kind's + * handler (capsule/quit.v4, (FAULTS)). + * With no table attached (fault_vector -1) the node stops instead: `stopped` + * is set and v4_exec_step_word does nothing more until the node is reset or + * a table is attached. * - * v4_node_reset detaches the handler and clears the count. Attaching clears - * `stopped` and the count; `handler` must be a word of memory, or -1 to - * detach. */ -void v4_node_fault_attach(v4_node *n, v4_cell handler); + * v4_node_reset detaches the table and clears the count. Attaching clears + * `stopped` and the count; all five words of the table must be in memory, + * or `table` -1 to detach. */ +#define V4_FAULT_ADDRESS 0u /* an address outside memory (D-14) */ +#define V4_FAULT_DATA_OVER 1u /* a push onto a full data stack */ +#define V4_FAULT_DATA_UNDER 2u /* the data stack holds too little for the opcode */ +#define V4_FAULT_RET_OVER 3u /* a push onto a full return stack */ +#define V4_FAULT_RET_UNDER 4u /* the return stack holds too little for the opcode */ +#define V4_FAULT_KINDS 5u -/* For the executor: record a fault at `addr` and redirect or stop the node, - * as above. */ -void v4_node_fault(v4_node *n, v4_cell addr); +void v4_node_fault_attach(v4_node *n, v4_cell table); + +/* For the executor: record a fault of `kind` (at `addr`, for an address + * fault) and redirect or stop the node, as above. */ +void v4_node_fault(v4_node *n, unsigned kind, v4_cell addr); + +/* DSTACK-DEPTH and RSTACK-DEPTH, the stack registers (D-16). + * + * After v4_node_stack_regs_attach(n, d, r): + * a data fetch from `d` gives how many values the data stack holds (the + * fetch's own push not counted), and from `r` how many entries the return + * stack holds; + * a store to `d` empties the data stack (the value stored is taken off + * first and ignored), and a store to `r` empties the return stack. + * Neither reads or writes n->mem. This is all a programme can see of the + * stacks: there is still no stack pointer and no address for a stack cell. + * DEPTH reads the first; QUIT and ABORT store to them. v4_node_reset + * detaches both (-1); the addresses are the caller's choice (D-4). */ +void v4_node_stack_regs_attach(v4_node *n, v4_cell d, v4_cell r); #endif /* V4_NODE_H */ diff --git a/v4/include/v4/stack.h b/v4/include/v4/stack.h index 556e7143..c1bf3305 100644 --- a/v4/include/v4/stack.h +++ b/v4/include/v4/stack.h @@ -1,4 +1,11 @@ -/* stack.h -- F18 circular hardware stacks (DECOMPOSITION.md D-2). +/* stack.h -- F18 circular hardware stacks (DECOMPOSITION.md D-2), counted (D-16). + * + * REVISED BY D-16 (2026-10-04). What follows describes the storage, which is + * unchanged: registers over a ring that wraps. But a running programme no + * longer sees the wrap. Each stack also counts what it holds, and the + * executor faults before an opcode would push onto a full stack or pop an + * empty one (exec.h). The wrap is now only what push and pop do when C code + * calls them directly at either end. * * D-2 rules these explicitly: "F18 circular stacks, hidden. Data stack 10 * deep (T, S + 8 circular), return stack 9 deep (R + 8 circular), exactly as @@ -51,6 +58,7 @@ typedef struct { v4_cell t; /* T -- top of data stack (a register) */ v4_cell s; /* S -- second (a register) */ unsigned head; + unsigned depth; /* how many values it holds, 0 .. V4_DATA_DEPTH (D-16) */ v4_cell guard_head[V4_DATA_BOUND]; v4_cell ring[V4_DATA_RING]; @@ -60,6 +68,7 @@ typedef struct { typedef struct { v4_cell r; /* R -- top of return stack (a register) */ unsigned head; + unsigned depth; /* how many entries it holds, 0 .. V4_RET_DEPTH (D-16) */ v4_cell guard_head[V4_RET_BOUND]; v4_cell ring[V4_RET_RING]; @@ -83,6 +92,19 @@ v4_cell v4_rstack_peek(const v4_rstack *st); /* 1 if both boundaries of the data stack are intact, else 0. See guard.h for * what this catches that AddressSanitizer does not. */ +/* THE DEPTH COUNT (DECOMPOSITION.md D-16, ruled 2026-10-04). Each stack + * counts what it holds: a push adds one, up to the stack's size, and a pop + * takes one, down to zero. The storage is still the F18's -- registers over + * a ring -- and push and pop still do exactly what they did when the count + * is at either end, so these functions never fail. It is the executor that + * guards: it reads the count before every opcode and faults instead of + * pushing onto a full stack or popping an empty one (exec.h). + * + * v4_dstack_clear and v4_rstack_clear empty a stack: the count goes to zero + * and nothing else changes. */ +void v4_dstack_clear(v4_dstack *st); +void v4_rstack_clear(v4_rstack *st); + int v4_dstack_guards_intact(const v4_dstack *st); int v4_rstack_guards_intact(const v4_rstack *st); diff --git a/v4/include/v4/testcode.h b/v4/include/v4/testcode.h index 4e177ffb..a5045c82 100644 --- a/v4/include/v4/testcode.h +++ b/v4/include/v4/testcode.h @@ -12,7 +12,8 @@ * and step instruction words until the word returns. The stacks and A, B are * left as the caller set them, so arguments go on the data stack first. * Returns the number of instruction words stepped, or -1 if the word had not - * returned after `max_words` or the node stopped on an address fault (D-14). */ + * returned after `max_words` or the node stopped on a fault (D-14, D-16). A + * stop left by an earlier call is cleared first. */ long v4_test_call(v4_node *n, v4_exec_state *es, v4_heat *h, v4_cell entry, long max_words); diff --git a/v4/src/exec.c b/v4/src/exec.c index 26f051cf..d70741a7 100644 --- a/v4/src/exec.c +++ b/v4/src/exec.c @@ -39,10 +39,51 @@ static int ends_word(unsigned op) static int faulted(v4_node *n, v4_cell addr) { if (v4_node_addr_ok(addr)) return 0; - v4_node_fault(n, addr); + v4_node_fault(n, V4_FAULT_ADDRESS, addr); return 1; } +/* D-16: what each opcode takes from the stacks and leaves on them. If the + * data stack holds fewer than `dneed`, or the return stack fewer than + * `rneed`, or a stack the opcode leaves one more on is full, it is a fault + * and the opcode does nothing. An opcode that only looks at T (`if`) or at + * T and S (`+*`) needs them to be there. */ +static int stack_faulted(v4_node *n, unsigned op) +{ + unsigned dneed = 0, rneed = 0, dgrow = 0, rgrow = 0; + + switch (op) { + case V4_OP_SEMI: case V4_OP_EX: case V4_OP_UNEXT: case V4_OP_NEXT: + rneed = 1; break; + case V4_OP_CALL: + rgrow = 1; break; + case V4_OP_FETCH_P: case V4_OP_FETCH_INC: case V4_OP_FETCH_B: case V4_OP_FETCH_A: case V4_OP_PUSH_A: + dgrow = 1; break; + case V4_OP_IF: case V4_OP_MINUS_IF: + case V4_OP_STORE_P: case V4_OP_STORE_INC: case V4_OP_STORE_B: case V4_OP_STORE_A: + case V4_OP_TWO_STAR: case V4_OP_TWO_SLASH: case V4_OP_INV: case V4_OP_DROP: + case V4_OP_BANG_B: case V4_OP_BANG_A: + dneed = 1; break; + case V4_OP_MUL_STEP: case V4_OP_ADD: case V4_OP_AND: case V4_OP_XOR: + dneed = 2; break; + case V4_OP_DUP: + dneed = 1; dgrow = 1; break; + case V4_OP_OVER: + dneed = 2; dgrow = 1; break; + case V4_OP_RPOP: + rneed = 1; dgrow = 1; break; + case V4_OP_PUSH: + dneed = 1; rgrow = 1; break; + default: + break; /* jump, nop */ + } + if (n->ds.depth < dneed) { v4_node_fault(n, V4_FAULT_DATA_UNDER, 0); return 1; } + if (n->rs.depth < rneed) { v4_node_fault(n, V4_FAULT_RET_UNDER, 0); return 1; } + if (dgrow && n->ds.depth >= V4_DATA_DEPTH) { v4_node_fault(n, V4_FAULT_DATA_OVER, 0); return 1; } + if (rgrow && n->rs.depth >= V4_RET_DEPTH) { v4_node_fault(n, V4_FAULT_RET_OVER, 0); return 1; } + return 0; +} + void v4_exec_reset(v4_exec_state *es) { es->anticlock = 0; @@ -55,6 +96,8 @@ void v4_exec_op(v4_node *n, v4_exec_state *es, v4_heat *h, v4_rstack *rs = &n->rs; v4_cell x; + if (op <= V4_OP_BANG_A && stack_faulted(n, op)) return; + switch (op) { case V4_OP_SEMI: n->p = v4_rstack_pop(rs); diff --git a/v4/src/node.c b/v4/src/node.c index fdec5cf0..86ea11fb 100644 --- a/v4/src/node.c +++ b/v4/src/node.c @@ -14,6 +14,7 @@ void v4_node_reset(v4_node *n) v4_node_console_attach(n, -1); v4_node_console_input_attach(n, -1, -1); v4_node_fault_attach(n, -1); + v4_node_stack_regs_attach(n, -1, -1); } int v4_node_addr_ok(v4_cell addr) @@ -23,19 +24,29 @@ int v4_node_addr_ok(v4_cell addr) return (v4_ucell)addr < (v4_ucell)V4_NODE_WORDS; } -void v4_node_fault_attach(v4_node *n, v4_cell handler) +void v4_node_stack_regs_attach(v4_node *n, v4_cell d, v4_cell r) { - n->fault_vector = v4_node_addr_ok(handler) ? handler : (v4_cell)-1; + n->dstack_reg = d; + n->rstack_reg = r; +} + +void v4_node_fault_attach(v4_node *n, v4_cell table) +{ + n->fault_vector = (v4_node_addr_ok(table) && v4_node_addr_ok(table + (v4_cell)(V4_FAULT_KINDS - 1u))) ? table : (v4_cell)-1; n->fault_addr = 0; + n->fault_kind = 0; n->faults = 0; n->stopped = 0; } -void v4_node_fault(v4_node *n, v4_cell addr) +void v4_node_fault(v4_node *n, unsigned kind, v4_cell addr) { + n->fault_kind = kind; n->fault_addr = addr; n->faults++; - if (n->fault_vector >= 0) n->p = n->fault_vector; + v4_rstack_clear(&n->rs); + v4_dstack_clear(&n->ds); + if (n->fault_vector >= 0) n->p = n->fault_vector + (v4_cell)kind; else n->stopped = 1; } @@ -64,6 +75,9 @@ void v4_node_store(v4_node *n, v4_cell addr, v4_cell value) n->console_dropped++; return; } + /* The stack registers: a store empties the stack. -1 when not attached. */ + if (addr == n->dstack_reg) { v4_dstack_clear(&n->ds); return; } + if (addr == n->rstack_reg) { v4_rstack_clear(&n->rs); return; } if (!v4_node_addr_ok(addr)) return; n->mem[(unsigned)addr] = value; } @@ -81,6 +95,8 @@ v4_cell v4_node_fetch(v4_node *n, v4_cell addr) if (n->input_pos == n->input_len) n->input_pos = n->input_len = 0; return c; } + if (addr == n->dstack_reg) return (v4_cell)n->ds.depth; + if (addr == n->rstack_reg) return (v4_cell)n->rs.depth; return v4_node_load(n, addr); } diff --git a/v4/src/stack.c b/v4/src/stack.c index e00c9f0e..570d9579 100644 --- a/v4/src/stack.c +++ b/v4/src/stack.c @@ -33,6 +33,7 @@ void v4_dstack_reset(v4_dstack *st) st->t = 0; st->s = 0; st->head = 0; + st->depth = 0; for (unsigned i = 0; i < V4_DATA_RING; i++) st->ring[i] = 0; v4_guard_fill(st->guard_head, V4_DATA_BOUND, V4_GUARD_PATTERN_HEAD); v4_guard_fill(st->guard_tail, V4_DATA_BOUND, V4_GUARD_PATTERN_TAIL); @@ -50,14 +51,19 @@ void v4_dstack_push(v4_dstack *st, v4_cell x) st->s = st->t; st->t = x; st->head = (st->head + 1u) % V4_DATA_RING; + if (st->depth < V4_DATA_DEPTH) st->depth++; } +void v4_dstack_clear(v4_dstack *st) { st->depth = 0; } +void v4_rstack_clear(v4_rstack *st) { st->depth = 0; } + v4_cell v4_dstack_pop(v4_dstack *st) { v4_cell x = st->t; st->t = st->s; st->head = (st->head + V4_DATA_RING - 1u) % V4_DATA_RING; st->s = st->ring[st->head]; + if (st->depth > 0) st->depth--; return x; } @@ -75,6 +81,7 @@ void v4_rstack_reset(v4_rstack *st) { st->r = 0; st->head = 0; + st->depth = 0; for (unsigned i = 0; i < V4_RET_RING; i++) st->ring[i] = 0; v4_guard_fill(st->guard_head, V4_RET_BOUND, V4_GUARD_PATTERN_HEAD); v4_guard_fill(st->guard_tail, V4_RET_BOUND, V4_GUARD_PATTERN_TAIL); @@ -91,6 +98,7 @@ void v4_rstack_push(v4_rstack *st, v4_cell x) st->ring[st->head] = st->r; st->r = x; st->head = (st->head + 1u) % V4_RET_RING; + if (st->depth < V4_RET_DEPTH) st->depth++; } v4_cell v4_rstack_pop(v4_rstack *st) @@ -98,6 +106,7 @@ v4_cell v4_rstack_pop(v4_rstack *st) v4_cell x = st->r; st->head = (st->head + V4_RET_RING - 1u) % V4_RET_RING; st->r = st->ring[st->head]; + if (st->depth > 0) st->depth--; return x; } diff --git a/v4/src/testcode.c b/v4/src/testcode.c index 7cbc67b7..460fdd88 100644 --- a/v4/src/testcode.c +++ b/v4/src/testcode.c @@ -6,6 +6,7 @@ long v4_test_call(v4_node *n, v4_exec_state *es, v4_heat *h, { long words = 0; + n->stopped = 0; /* a stop left by an earlier call is over */ v4_rstack_push(&n->rs, V4_TEST_HALT); n->p = entry; while (n->p != V4_TEST_HALT) { diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index 86ef9bc9..029896ce 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -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++) { diff --git a/v4/tests/test_exec.c b/v4/tests/test_exec.c index 605a2b6b..77f31d80 100644 --- a/v4/tests/test_exec.c +++ b/v4/tests/test_exec.c @@ -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(); diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 2113f6b0..da4675af 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -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); diff --git a/v4/tests/test_stack.c b/v4/tests/test_stack.c index ba166f10..7295f684 100644 --- a/v4/tests/test_stack.c +++ b/v4/tests/test_stack.c @@ -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;