From dc7e37ba5c4f760fbf40f80cedbdd1f54efb2525 Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 20:13:23 -0400 Subject: [PATCH] feat(v4.0.0): every error is raised and ends the line (D-18) Ruled 2026-10-04: guard all errors. The errors that set NODE-ERROR and let the line run on now stop it at once, with a message. - A store of a non-zero code to NODE-ERROR is a trap, a sixth kind of fault: nothing after it executes, the return stack is emptied, and the data stack is left as the word left it. Not attached, NODE-ERROR is plain memory, as the tests below the prompt use it. - The capsule's words store a code where they stored -1, and the prompt's (RAISED) prints its message: Negative count, Not a number, Number too long, Not a character, Dictionary full, Name missing, Control structure mismatch, Control structures too deep. - ' and COMPILE and [COMPILE] of a word that is not there say UNKNOWN WORD: 'xxx', as the interpreter does. - tests: the trap in test_exec.c; every message from the prompt, with the rest of the line not run and the stack kept, in test_host_quit.c. Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 3 ++- v4/capsule/compile.v4 | 22 +++++++++-------- v4/capsule/core.v4 | 13 ++++++++-- v4/capsule/dict.v4 | 15 ++++++++---- v4/capsule/input.v4 | 2 +- v4/capsule/numout.v4 | 6 ++--- v4/capsule/quit.v4 | 23 ++++++++++++++++-- v4/include/v4/node.h | 30 +++++++++++++++++++---- v4/src/exec.c | 6 ++++- v4/src/node.c | 10 +++++++- v4/tests/test_exec.c | 43 +++++++++++++++++++++++++++++++++ v4/tests/test_host_quit.c | 46 +++++++++++++++++++++++++++++------- 12 files changed, 181 insertions(+), 38 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 1429ff48..ca70929a 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -179,6 +179,7 @@ definition below depends on one, it says so. | **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 were unchanged by this ruling, 10 and 9 (D-17 then deepens the host node's): 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. | | **D-17** | Stack sizes on the host node (2026-10-04, following D-16). | **32 values and 32 return entries on the host node; a mesh node keeps the F18's 10 and 9.** Once the stacks are counted (D-16) their size is a parameter of the node, like its memory, and the host node is the one that runs the interpreter and the compiler underneath the user's programme: at 10 and 9 the prompt left a programme about six values, and `/` could be used only four words deep. The mechanism is the same at both sizes — top registers over a ring — and so is every word's definition. v3's stacks are deeper still. In the golden model the sizes are `V4_DATA_RING` and `V4_RET_RING` (`stack.h`), set for the host-node tests in `v4/Makefile`. | +| **D-18** | Every other error (ruled 2026-10-04: "guard all errors"). | **A word that finds an error raises it, and the line ends there.** The word takes its own arguments off the stack and stores an error code in `NODE-ERROR` (§7). On a node with a prompt that store is a trap, a sixth kind of fault beside D-14's and D-16's: nothing after it executes, the return stack is emptied, and the prompt prints the code's message, ends any definition that was open, prints ` ERROR` and waits for the next line. Unlike the other faults it leaves the data stack as the word left it. The codes: 1 `Negative count` (`CMOVE`, `TYPE`), 2 `Not a number` (`NUMBER`), 3 `Number too long` (`HOLD` into a full buffer), 4 `Not a character` (`HOLD`), 5 `Dictionary full` (`,` `C,` `ALLOT`, any defining word), 6 `Name missing` (a defining word with nothing after it), 7 `Control structure mismatch`, 8 `Control structures too deep`; −1 means the word printed its own message (`UNKNOWN WORD: 'xxx'`, `xxx: compile-only`). Before this ruling these set the flag and the line ran on to its end. v3 stops at once too; its messages name the word (`LOOP: missing DO`) where v4's name the fault. With the trap not attached `NODE-ERROR` is plain memory and the word returns, which is how the words are tested below the prompt. D-11, D-12 and D-13 said "set `NODE-ERROR`"; on a node with a prompt that now means this. Executed on the golden model (2026-10-04): `tests/test_exec.c`, `tests/test_host_quit.c`. | **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 @@ -1047,7 +1048,7 @@ Addresses are assigned in the node memory map (D-4). Names only here. | `GOV-*` | R/W | Governor parameters and Jacquard selector state (`L8-*`, decay rate). | | `REC-ENABLE` | R/W | DoE recorder on/off (`HB-ON` / `HB-OFF`). | | `PORT-STATUS` | R | Per-port ready flags, for non-blocking polls. | -| `NODE-ERROR` | R/W | Arithmetic error flag: set to −1 by `Q./` on division by zero (D-11), by `Q.SQRT` / `Q.LOG` outside their domain (D-12) and by `HOLD` on a bad character or a full buffer (D-13), cleared by writing 0. `VM-ERROR?` reads it. | +| `NODE-ERROR` | R/W | Error register (D-18): a store of a non-zero code raises an error — on a node with a prompt it is a trap that ends the line with the code's message; a store of zero clears it. Originally the arithmetic error flag: set to −1 by `Q./` on division by zero (D-11), by `Q.SQRT` / `Q.LOG` outside their domain (D-12) and by `HOLD` on a bad character or a full buffer (D-13), cleared by writing 0. `VM-ERROR?` reads it. | | `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`. | diff --git a/v4/capsule/compile.v4 b/v4/capsule/compile.v4 index 1d08236c..c9f17564 100644 --- a/v4/capsule/compile.v4 +++ b/v4/capsule/compile.v4 @@ -35,6 +35,7 @@ \ (C)+5 what a loop's end lays after its test \ (C)+6 (C)+7 a branch and a tag a control word is holding \ (C)+8 whether a data word's entry was made +\ (C)+9 the error code a line is being abandoned with \ (CFP) word address of the control-flow stack's pointer \ CFBASE CFEND word addresses of its first cell and of the cell past its last @@ -47,11 +48,15 @@ macro ROT push SWAP pop SWAP endmacro \ NODE-ERROR. A definition that was under way stays hidden. It returns to \ whatever called INTERPRET, which is QUIT (quit.v4): QUIT sees NODE-ERROR \ and prints ERROR. -: (ABANDON) +\ (ABANDON-AS) is the same with an error code (core.v4) for the prompt to +\ print the message of. +: (ABANDON-AS) ( code -- ) + (C)+9 a! ! 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! SPAN a! @ >IN a! ! - NODE-ERROR b! -1 !b ; + (C)+9 a! @ NODE-ERROR b! !b ; +: (ABANDON) -1 jump (ABANDON-AS) \ ---- the control-flow stack ---------------------------------------------------- @@ -59,7 +64,7 @@ macro ROT push SWAP pop SWAP endmacro : >CF (CFP) a! @ CFEND xor if FULL drop (CFP) a! @ dup 1 + ! a! ! ; - FULL: drop drop jump (ABANDON) + FULL: drop drop 8 jump (ABANDON-AS) \ control structures too deep \ ( -- x ) pop; 0 from an empty stack, which no opening word leaves : CF> @@ -153,10 +158,7 @@ header INTERPRET drop STATE a! @ if KEEP drop (LIT,) jump L KEEP: drop jump L - BAD: drop drop \ "UNKNOWN WORD: '" - $4E4B4E55 (EMIT4) $204E574F (EMIT4) $44524F57 (EMIT4) $27203A (EMIT4) - (.WORD) 39 EMIT CR - jump (ABANDON) + BAD: drop drop (UNKNOWN) drop jump (ABANDON) EOL: drop drop ; \ ---- state --------------------------------------------------------------------- @@ -206,13 +208,13 @@ header COMPILE immediate compile-only : COMPILE 32 WORD (LOOKUP) if MISSING (LIT,) &(COMPILE,) jump (CALL,) - MISSING: drop jump (ABANDON) + MISSING: drop (UNKNOWN) drop jump (ABANDON) \ [COMPILE] xxx FORTH-79: compile xxx even though it is immediate header [COMPILE] immediate compile-only : BRACKET-COMPILE 32 WORD (LOOKUP) if MISSING jump (COMPILE,) - MISSING: drop jump (ABANDON) + MISSING: drop (UNKNOWN) drop jump (ABANDON) \ ---- data words --------------------------------------------------------------------- \ A data word's code is one call to its run-time routine; the call leaves the @@ -267,7 +269,7 @@ header DOES> immediate compile-only \ ( tag wanted -- ) if they differ, abandon the line and leave the control \ word that called this as well: its return address is dropped, so the \ abandoning returns to the interpreter and nothing more is laid down. -: (PAIR) xor if OK drop pop drop jump (ABANDON) OK: drop ; +: (PAIR) xor if OK drop pop drop 7 jump (ABANDON-AS) OK: drop ; \ ( ref -- ) the branch at ref lands here : (HERE!) (FLUSH) HERE SWAP jump (RESOLVE) diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index 3c763585..6faeaca5 100644 --- a/v4/capsule/core.v4 +++ b/v4/capsule/core.v4 @@ -6,6 +6,15 @@ \ \ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX, \ CONSOLE-RX, CONSOLE-STATUS, BASE. +\ +\ ERRORS (D-18). A word that finds an error takes its arguments off the stack +\ and stores a code in NODE-ERROR. On a node with a prompt that store is a +\ trap: the word goes no further, and the prompt prints the message for the +\ code and ERROR (quit.v4, (RAISED)). The codes: +\ 1 Negative count 2 Not a number 3 Number too long +\ 4 Not a character 5 Dictionary full 6 Name missing +\ 7 Control structure mismatch 8 Control structures too deep +\ -1 the word has printed its own message macro SWAP over push push drop pop pop endmacro macro - push inv pop + inv endmacro \ x y -- x-y @@ -72,7 +81,7 @@ header C! \ ---- section 5.9: strings ------------------------------------------------ header CMOVE : CMOVE ( src dst u -- ) - -if OK drop drop drop NODE-ERROR b! -1 !b ; + -if OK drop drop drop NODE-ERROR b! 1 !b ; OK: if DONE push over C@ over C! 1 + push 1 + pop pop -1 + jump OK DONE: drop drop drop ; @@ -93,7 +102,7 @@ header COUNT : COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ; header TYPE : TYPE ( baddr u -- ) - -if OK drop drop NODE-ERROR b! -1 !b ; + -if OK drop drop NODE-ERROR b! 1 !b ; OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK DONE: drop drop ; diff --git a/v4/capsule/dict.v4 b/v4/capsule/dict.v4 index f0f17cab..643e99b9 100644 --- a/v4/capsule/dict.v4 +++ b/v4/capsule/dict.v4 @@ -41,7 +41,7 @@ macro OR over inv and xor endmacro \ they are storing in A while the space is taken: nothing of theirs is then \ on the data stack under (DP+), which itself needs three cells (D-2). -: (DERR) ( -- 0 ) NODE-ERROR b! -1 !b 0 ; +: (DERR) ( -- 0 ) NODE-ERROR b! 5 !b 0 ; \ dictionary full \ ( n -- flag ) move DP by n bytes if it stays inside the dictionary space \ and say -1; otherwise leave it, set NODE-ERROR and say 0. The two @@ -66,7 +66,7 @@ header , a! DP b! @b 3 + -4 and \ the next whole cell, as a byte address dup inv DLIMIT + -3 + -if ROOM \ DLIMIT - (it + 4) - drop drop NODE-ERROR b! -1 !b ; + drop drop NODE-ERROR b! 5 !b ; ROOM: drop dup 4 + !b \ DP is past it 4/ b! a !b ; header C, @@ -148,7 +148,7 @@ header HIDDEN 0 , (D) a! @ , LATEST , HERE (LATEST) a! ! ; FULL: drop ; \ (DP+) has set NODE-ERROR - EMPTY: drop NODE-ERROR b! -1 !b ; + EMPTY: drop NODE-ERROR b! 6 !b ; \ name missing \ ---- looking a name up ----------------------------------------------------- @@ -186,5 +186,12 @@ header FIND \ ( -- addr ) FORTH-79: the parameter field address of the next word in the \ input stream. Not found is an error: 0, and NODE-ERROR is set. This is ' \ when interpreting; compile.v4 adds what ' does when compiling. +\ ( -- 0 ) say that the word WORD has just left is not known, as v3 does: +\ UNKNOWN WORD: 'xxx' +: (UNKNOWN) + $4E4B4E55 (EMIT4) $204E574F (EMIT4) $44524F57 (EMIT4) $27203A (EMIT4) + WBUF COUNT TYPE 39 EMIT CR + NODE-ERROR b! -1 !b 0 ; + : (') 32 WORD (LOOKUP) if MISSING jump PFA - MISSING: drop jump (DERR) + MISSING: drop jump (UNKNOWN) diff --git a/v4/capsule/input.v4 b/v4/capsule/input.v4 index 32dad659..953d1cea 100644 --- a/v4/capsule/input.v4 +++ b/v4/capsule/input.v4 @@ -183,7 +183,7 @@ header CONVERT header NUMBER : NUMBER (NUMBER?) if BAD drop ; - BAD: drop NODE-ERROR b! -1 !b ; + BAD: drop NODE-ERROR b! 2 !b ; \ ---- comments (5.15) ------------------------------------------------------- \ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line. diff --git a/v4/capsule/numout.v4 b/v4/capsule/numout.v4 index a5329832..244b0abd 100644 --- a/v4/capsule/numout.v4 +++ b/v4/capsule/numout.v4 @@ -43,9 +43,9 @@ header <# : <# ( -- ) HEND HLD b! !b ; header HOLD : HOLD ( c -- ) - dup -256 and if OKC drop jump ERR - OKC: drop HLD b! @b -HFLOOR + -if ROOM drop - ERR: drop NODE-ERROR b! -1 !b ; + dup -256 and if OKC drop drop NODE-ERROR b! 4 !b ; \ not a character + OKC: drop HLD b! @b -HFLOOR + -if ROOM + drop drop NODE-ERROR b! 3 !b ; \ the buffer is full ROOM: drop HLD b! @b -1 + dup !b jump C! header SIGN : SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ; diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index d3a269db..c88ae116 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -87,11 +87,30 @@ header ABORT $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 +\ A word has stored an error code in NODE-ERROR (D-18; the codes are listed +\ in core.v4). Print its message -- a negative code means the word printed +\ its own -- and end the line with ERROR. The return stack has been +\ emptied; the data stack is as the word left it. +: (RAISED) + NODE-ERROR b! @b + -if POS drop 2 jump (REPL) + POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4 + -1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 + drop 2 jump (REPL) + M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL) + M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL) + M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (REPL) + M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (REPL) + M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (REPL) + M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (REPL) + M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (REPL) + M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (REPL) + +\ The table the loader gives the node: six 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) + jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED) \ ---- text in the source --------------------------------------------------------- \ ." and ABORT" take the text up to the next " , which may be none at all diff --git a/v4/include/v4/node.h b/v4/include/v4/node.h index 3b3e416d..2d6bb0c1 100644 --- a/v4/include/v4/node.h +++ b/v4/include/v4/node.h @@ -91,6 +91,9 @@ typedef struct { /* 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 */ + + /* NODE-ERROR as a trap (D-18). See v4_node_error_attach. */ + v4_cell error_reg; /* its word address, or -1 */ } v4_node; /* Zero P, A and B, empty the stacks, and clear memory. Installs every @@ -194,8 +197,10 @@ int v4_node_addr_ok(v4_cell addr); * 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, + * on the data stack is not something its caller can use. (A raised + * error, below, empties only the return stack: the word that raised it + * chose to, after taking its own arguments off); + * - P becomes fault_vector + fault_kind. The handler table is six 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` @@ -203,14 +208,15 @@ int v4_node_addr_ok(v4_cell addr); * a table is attached. * * 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, + * `stopped` and the count; all six 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 +#define V4_FAULT_RAISED 5u /* a programme stored an error code in NODE-ERROR (D-18) */ +#define V4_FAULT_KINDS 6u void v4_node_fault_attach(v4_node *n, v4_cell table); @@ -232,4 +238,20 @@ void v4_node_fault(v4_node *n, unsigned kind, v4_cell addr); * 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); +/* NODE-ERROR as a trap (DECOMPOSITION.md D-18, ruled 2026-10-04: every error + * is guarded, shown, and returns the node to its prompt). + * + * A word that finds an error stores a code, which is not zero, in NODE-ERROR. + * After v4_node_error_attach(n, addr) a store of a non-zero value to `addr` + * writes that memory word, as before, and is then a fault of kind + * V4_FAULT_RAISED: the rest of the instruction word is not executed, the + * return stack is emptied, fault_addr is the code, and P becomes the sixth + * word of the fault table. The data stack is left alone. A store of zero + * -- which is how the flag is cleared -- is an ordinary store. + * + * Not attached (-1, as after v4_node_reset), NODE-ERROR is ordinary memory + * and a word that stores to it simply goes on: that is how a word can be run + * and its error seen with no prompt to return to. */ +void v4_node_error_attach(v4_node *n, v4_cell addr); + #endif /* V4_NODE_H */ diff --git a/v4/src/exec.c b/v4/src/exec.c index d70741a7..407c5605 100644 --- a/v4/src/exec.c +++ b/v4/src/exec.c @@ -257,7 +257,11 @@ unsigned v4_exec_step_word(v4_node *n, v4_exec_state *es, v4_heat *h) unsigned faults = n->faults; v4_exec_op(n, es, h, op, iw, slot); - if (n->faults != faults) break; /* P is the handler now, or the node has stopped */ + if (n->faults != faults) { /* P is the handler now, or the node has stopped */ + /* a store that raised an error (D-18) did execute; any other fault means the opcode did not */ + if (n->fault_kind == V4_FAULT_RAISED) executed++; + break; + } executed++; if (again) { diff --git a/v4/src/node.c b/v4/src/node.c index 86ea11fb..3e4c5182 100644 --- a/v4/src/node.c +++ b/v4/src/node.c @@ -15,6 +15,12 @@ void v4_node_reset(v4_node *n) v4_node_console_input_attach(n, -1, -1); v4_node_fault_attach(n, -1); v4_node_stack_regs_attach(n, -1, -1); + v4_node_error_attach(n, -1); +} + +void v4_node_error_attach(v4_node *n, v4_cell addr) +{ + n->error_reg = addr; } int v4_node_addr_ok(v4_cell addr) @@ -45,7 +51,7 @@ void v4_node_fault(v4_node *n, unsigned kind, v4_cell addr) n->fault_addr = addr; n->faults++; v4_rstack_clear(&n->rs); - v4_dstack_clear(&n->ds); + if (kind != V4_FAULT_RAISED) v4_dstack_clear(&n->ds); if (n->fault_vector >= 0) n->p = n->fault_vector + (v4_cell)kind; else n->stopped = 1; } @@ -80,6 +86,8 @@ void v4_node_store(v4_node *n, v4_cell addr, v4_cell value) if (addr == n->rstack_reg) { v4_rstack_clear(&n->rs); return; } if (!v4_node_addr_ok(addr)) return; n->mem[(unsigned)addr] = value; + /* NODE-ERROR: a non-zero code raises an error. -1 when not attached. */ + if (addr == n->error_reg && value != 0) v4_node_fault(n, V4_FAULT_RAISED, value); } v4_cell v4_node_fetch(v4_node *n, v4_cell addr) diff --git a/v4/tests/test_exec.c b/v4/tests/test_exec.c index 77f31d80..a8e32f93 100644 --- a/v4/tests/test_exec.c +++ b/v4/tests/test_exec.c @@ -421,6 +421,48 @@ static void test_stack_faults(void) CHECK(n.ds.t == 55, "detached, the address is memory"); } +/* D-18: NODE-ERROR as a trap. A store of a non-zero code is a fault of its + * own kind: the code is written, the return stack is emptied, the data stack + * is left, and P is the sixth word of the table. */ +static void test_raised_errors(void) +{ + static const unsigned store[] = { V4_OP_STORE_A, V4_OP_STORE_B, V4_OP_STORE_INC }; + unsigned k; + for (k = 0; k < 3; k++) { + fresh(); v4_node_fault_attach(&n, HANDLER); + v4_node_error_attach(&n, 700); + dpush(11); dpush(22); dpush(5); rpush(1); rpush(2); + n.a = 700; n.b = 700; + n.mem[0] = word6(store[k], V4_OP_DROP, V4_OP_DROP, NOP, NOP, NOP); n.p = 0; + CHECK(v4_exec_step_word(&n, &es, &h) == 1, "the store retires and nothing after it runs"); + CHECK(n.faults == 1 && n.fault_kind == V4_FAULT_RAISED && n.fault_addr == 5 && n.p == HANDLER + (v4_cell)V4_FAULT_RAISED, + "a non-zero store to NODE-ERROR raises: kind %u, code %lld", n.fault_kind, (long long)n.fault_addr); + CHECK(n.mem[700] == 5, "the code is in NODE-ERROR"); + CHECK(n.rs.depth == 0 && n.ds.depth == 2 && n.ds.t == 22 && n.ds.s == 11, "the return stack is emptied and the data stack left"); + /* zero clears it and is no fault */ + dpush(0); n.a = 700; v4_exec_op(&n, &es, &h, V4_OP_STORE_A, 0, 0); + CHECK(n.faults == 1 && n.mem[700] == 0, "a store of zero is an ordinary store"); + dpush(-1); n.a = 699; v4_exec_op(&n, &es, &h, V4_OP_STORE_A, 0, 0); + CHECK(n.faults == 1 && n.mem[699] == -1, "and so is a store next to it"); + } + /* detached: ordinary memory */ + fresh(); v4_node_fault_attach(&n, HANDLER); + CHECK(n.error_reg == -1, "a fresh node has no error trap"); + dpush(7); n.a = 700; v4_exec_op(&n, &es, &h, V4_OP_STORE_A, 0, 0); + CHECK(n.faults == 0 && n.mem[700] == 7, "not attached, NODE-ERROR is memory and the word goes on"); + /* with no table the node stops */ + fresh(); v4_node_error_attach(&n, 700); + dpush(7); n.a = 700; + CHECK(run1(V4_OP_STORE_A) == 1 && n.stopped && n.mem[700] == 7, "with no handler a raised error stops the node"); + v4_node_reset(&n); + CHECK(n.error_reg == -1, "reset detaches the trap"); + /* the table must be six words inside memory */ + v4_node_fault_attach(&n, (v4_cell)(V4_NODE_WORDS - V4_FAULT_KINDS)); + CHECK(n.fault_vector == (v4_cell)(V4_NODE_WORDS - V4_FAULT_KINDS), "a table that ends with memory is accepted"); + v4_node_fault_attach(&n, (v4_cell)(V4_NODE_WORDS - V4_FAULT_KINDS + 1u)); + CHECK(n.fault_vector == -1, "one that runs past it is not"); +} + /* 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. */ @@ -542,6 +584,7 @@ int main(void) test_iword_in_wide_cell(); #endif test_stack_faults(); + test_raised_errors(); test_address_faults(); test_soak(); diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index b8550e71..b409bf8e 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -18,7 +18,9 @@ * v3 goes on compiling the lines that follow into it. * - ABORT" at the prompt stops the line when its flag is true. v3 prints * the text and carries on. Compiled into a word, v3's crashes (SIGSEGV). - * - control words that do not match give ERROR alone; v3 names the word. + * - every error has a message (D-18), but v4's says what was wrong, not + * which word: "Control structure mismatch" where v3 says + * "LOOP: missing DO". * - 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. @@ -82,6 +84,7 @@ static void boot_with(unsigned depth) v4_node_console_attach(&n, CONSOLE_TX); v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); v4_node_fault_attach(&n, w_fault); + v4_node_error_attach(&n, NODE_ERROR); v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es); @@ -223,14 +226,28 @@ static const transcript script[] = { { ": Z3 5 0 DO 9 3 I - / DROP LOOP 65 EMIT ; Z3\n66 EMIT\n", "/: Division by zero\n ERROR\nok> B ok\nok> ", 0 }, { ": BAD 1 NOSUCH 2 ;\nBAD\n65 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'BAD'\n ERROR\nok> A ok\nok> ", 0 }, { "1 ABORT\" now\" 65 EMIT\n66 EMIT\n", "now\n ok\nok> B ok\nok> ", 0 }, - { ": B1 IF LOOP ;\n65 EMIT\n", " ERROR\nok> A ok\nok> ", 0 }, + { ": B1 IF LOOP ;\n65 EMIT\n", "Control structure mismatch\n ERROR\nok> A ok\nok> ", 0 }, { ": A2 0 ABORT\" boom\" 67 EMIT ; A2\n", "C ok\nok> ", 0 }, { ": A1 ABORT\" boom\" 65 EMIT ; 1 A1 66 EMIT\n0 A1\n", "boom\n ok\nok> A ok\nok> ", 0 }, { "1 2 3 QUIT 68 EMIT\n+ + 48 + EMIT\n", "\nok> 6 ok\nok> ", 0 }, { ": Q1 QUIT ; : Q2 65 EMIT Q1 66 EMIT ; : Q3 Q2 67 EMIT ; Q3 68 EMIT\n69 EMIT\n", "A\nok> E ok\nok> ", 0 }, { ": HALF 1 2 [ QUIT\n65 EMIT\nHALF\n", "\nok> A ok\nok> UNKNOWN WORD: 'HALF'\n ERROR\nok> ", 0 }, { ": HALF 1 2 [ ABORT\n65 EMIT\n", " ok\nok> A ok\nok> ", 0 }, - { "PAD PAD -1 CMOVE 65 EMIT\n66 EMIT\n", "A ERROR\nok> B ok\nok> ", 0 }, + /* every error stops the line at once, says what it was, and leaves the data stack (D-18) */ + { "1 2 3 PAD PAD -1 CMOVE 65 EMIT\n66 EMIT .S\n", "Negative count\n ERROR\nok> B<3> 1 2 3 \n ok\nok> ", 0 }, + { "7 PAD -5 TYPE 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + /* NUMBER takes a counted string: "-12" and "-1x", built at PAD */ + { "3 PAD C! 45 PAD 1+ C! 49 PAD 2+ C! 50 PAD 3 + C! 0 PAD 4 + C! PAD NUMBER D.\n", "-12 ok\nok> ", 0 }, + { "3 PAD C! 45 PAD 1+ C! 49 PAD 2+ C! 120 PAD 3 + C! 7 PAD NUMBER 65 EMIT\n.S\n", "Not a number\n ERROR\nok> <3> 7 0 0 \n ok\nok> ", 0 }, + { "7 <# 300 HOLD 65 EMIT\n.S\n", "Not a character\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { ": HH <# 70 0 DO 65 HOLD LOOP ; HH 66 EMIT\n67 EMIT\n", "Number too long\n ERROR\nok> C ok\nok> ", 0 }, + { "7 : \n.S\n", "Name missing\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { "VARIABLE\nCREATE\n5 CONSTANT\n", "Name missing\n ERROR\nok> Name missing\n ERROR\nok> Name missing\n ERROR\nok> ", 0 }, + { "7 ' NOSUCH 65 EMIT\n.S\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { ": X1 COMPILE NOSUCH ;\n: X2 [COMPILE] NOPE ;\n65 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'NOPE'\n ERROR\nok> A ok\nok> ", 0 }, + { ": X3 THEN ;\n: X4 BEGIN IF UNTIL ;\n: X5 DO REPEAT ;\n", "Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> " + "Control structure mismatch\n ERROR\nok> ", 0 }, + { ": X6 IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF IF 65 EMIT ;\n66 EMIT\n", "Control structures too deep\n ERROR\nok> B ok\nok> ", 0 }, { ".\" no closing quote\n65 EMIT\n", "no closing quote ok\nok> A ok\nok> ", 0 }, { ".\" \"\n", " ok\nok> ", 0 }, { ": T ABORT\" \" ; 1 T\n", "\n ok\nok> ", 0 }, @@ -303,8 +320,8 @@ int main(void) CHECK(is(say("65 EMIT\n"), "A ok\nok> ") && is(say("H1\n"), "UNKNOWN WORD: 'H1'\n ERROR\nok> "), "and the definition is gone"); CHECK(is(say(": H2 1 IF IA\n"), " ok\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "ABORT while compiling stops compiling"); CHECK(is(say("66 EMIT\n"), "B ok\nok> ") && is(say("H2\n"), "UNKNOWN WORD: 'H2'\n ERROR\nok> "), "and the definition is gone"); - CHECK(is(say(": H3 1 IF [ PAD PAD -1 CMOVE ]\n"), " ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, - "a word that sets NODE-ERROR while a definition is open ends it"); + CHECK(is(say(": H3 1 IF [ PAD PAD -1 CMOVE ]\n"), "Negative count\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, + "a word that raises an error while a definition is open ends it"); CHECK(is(say("67 EMIT\n"), "C ok\nok> ") && is(say("H3\n"), "UNKNOWN WORD: 'H3'\n ERROR\nok> "), "and the definition is gone"); CHECK(is(say(": H4 68 EMIT ; H4\n"), "D ok\nok> "), "the next definition compiles and runs"); @@ -527,8 +544,9 @@ int main(void) CHECK(is(say("-1 U.\n"), "18446744073709551615 ok\nok> "), "the largest number (as v3)"); CHECK(is(say("-9223372036854775808 . 9223372036854775807 .\n"), "-9223372036854775808 9223372036854775807 ok\nok> "), "the smallest and largest signed"); CHECK(is(say("HEX -1 U. DECIMAL\n"), "FFFFFFFFFFFFFFFF ok\nok> "), "in hex"); - /* 64 binary digits are one more than the hold buffer's 63 (D-13): the last is dropped and the line is an error */ - CHECK(is(say("2 BASE ! -1 U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ERROR\nok> "), "in binary, 63 of its 64 digits and ERROR"); + /* 64 binary digits are one more than the hold buffer's 63 (D-13): an error, and nothing is printed */ + CHECK(is(say("2 BASE ! -1 U. DECIMAL\n"), "Number too long\n ERROR\nok> "), "in binary, its 64 digits are one too many"); + CHECK(is(say("DECIMAL\n"), " ok\nok> "), "(back to decimal)"); CHECK(is(say("9223372036854775807 2 BASE ! U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ok\nok> "), "a 63-digit number prints whole"); #endif /* .S works on the stack it is printing, so it needs some of it free */ @@ -553,9 +571,19 @@ int main(void) CHECK(most + 8u >= V4_DATA_DEPTH, ".S works with all but eight cells of the stack in use"); } - /* ---- the fault table: five words, each a jump to its handler ---- */ + /* ---- a full dictionary ---- */ + boot_bare(); + n.mem[DP] = (DICT_END_W - 2) * 4; + CHECK(is(say(": FULL 1 2 3 4 5 6 7 8 9 ; 65 EMIT\n"), "Dictionary full\n ERROR\nok> ") && n.mem[STATE] == 0, "a definition that does not fit"); + CHECK(is(say("FULL\n"), "UNKNOWN WORD: 'FULL'\n ERROR\nok> "), "is not defined"); + n.mem[DP] = (DICT_END_W - 1) * 4; + CHECK(is(say("1 , 65 EMIT\n"), "A ok\nok> ") && is(say("2 , 66 EMIT\n"), "Dictionary full\n ERROR\nok> "), "the last cell can be used; the one after it cannot"); + CHECK(is(say("5 ALLOT 67 EMIT\n"), "Dictionary full\n ERROR\nok> ") && is(say("-99999 ALLOT\n"), "Dictionary full\n ERROR\nok> "), "nor can ALLOT go past either end"); + CHECK(is(say("68 EMIT .S\n"), "D<0> \n ok\nok> "), "and the prompt goes on"); + + /* ---- the fault table: six words, each a jump to its handler ---- */ { - static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)" }; + static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)", "(RAISED)" }; 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]),