diff --git a/capsules/v4/sys/compile.f18 b/capsules/v4/sys/compile.f18 index 8f4ba668..26d00aed 100644 --- a/capsules/v4/sys/compile.f18 +++ b/capsules/v4/sys/compile.f18 @@ -11,10 +11,13 @@ \ instruction words, and compiling a word into one lays down a call to it. \ Two flags on an entry (dict.f18) change that: \ inline its code is a straight run of opcodes and literals ending -\ in ; -- that run is copied in place of a call. Everything -\ that touches the return stack must be, since a call would -\ bury what it works on (DECOMPOSITION.md 0, fate IN). +\ in ; -- that run can be copied in place of a call. \ compile-only it may not be executed by the interpreter. +\ Only a word with both is copied in line: the words that work on the return +\ stack (>R R> R@ I J LEAVE UNLOOP 2>R 2R> 2R@), which a call would bury +\ (DECOMPOSITION.md 0, fate IN). Every other word is called, in-line ones +\ too, so that the node's hook at `call` sees it (plan 2026-10-20, Task A2; +\ #189; Captain Bob, 2026-11-13: "The ten"). \ An immediate word is executed even when compiling. \ \ THE STACKS ARE SHORT: written for ten cells of data and nine return entries @@ -38,6 +41,8 @@ \ (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 +\ (EXEC) word address of two cells: EXECUTE's call, and the ; after it +\ (RUNX) word address of two cells: INTERPRET's call, and the jump back macro ROT push SWAP pop SWAP endmacro @@ -94,10 +99,11 @@ macro ROT push SWAP pop SWAP endmacro NOP: drop drop jump NXT END: drop ; -\ ( xt -- ) compile the word at xt: in line if it is flagged so, else a call +\ ( xt -- ) compile the word at xt: in line if it is flagged in-line and +\ compile-only (24), else a call : (COMPILE,) - dup -3 + a! @ 8 and if CALL drop jump (INLINE,) - CALL: drop jump (CALL,) + dup -3 + a! @ 24 and -24 + if INL drop jump (CALL,) + INL: drop jump (INLINE,) \ ---- access control (5.20) ------------------------------------------------------- \ Each entry's flags cell also holds its access control fields: @@ -144,7 +150,13 @@ macro ROT push SWAP pop SWAP endmacro : (.WORD) WBUF COUNT jump TYPE set HDR-NFA here ", EXECUTE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here -: EXECUTE ( xt -- ) push ; +\ It calls the word, so that the hook at `call` sees it (#189, ENGINE.md 6, +\ ruled 2026-10-20): a `call xt` instruction word -- `call`, opcode 3, in slot +\ 0, the address in the 27 bits below it -- is put in (EXEC) with a ; after +\ it, and run. The word returns to the ;, which returns to EXECUTE's caller. +\ An EXECUTE inside the word rewrites only the call, which has been run. +: EXECUTE ( xt -- ) + $07FFFFFF and $18000000 xor (EXEC) a! ! 0 (EXEC)+1 a! ! (EXEC) push ; \ ---- the interpreter's inner loop --------------------------------------------- @@ -183,25 +195,34 @@ set HDR-NFA here ", EXECUTE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ UNKNOWN WORD: 'xxx' xxx: compile-only set HDR-NFA here ", INTERPRET #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : INTERPRET - L: 32 WORD dup C@ if EOL +: (IL) 32 WORD dup C@ if EOL drop (LOOKUP) if NUM dup -3 + a! @ \ xt flags STATE a! @ if INTERP drop 1 and if COMP \ compiling: immediate words still run - drop (ACL?) EXECUTE jump L - COMP: drop (ACL?) (COMPILE,) jump L + drop (ACL?) jump (GO) + COMP: drop (ACL?) (COMPILE,) jump (IL) INTERP: drop 16 and if RUN drop drop (.WORD) \ ": compile-only" $6F63203A (EMIT4) $6C69706D (EMIT4) $6E6F2D65 (EMIT4) $796C (EMIT4) CR jump (ABANDON) - RUN: drop (ACL?) EXECUTE jump L + RUN: drop (ACL?) jump (GO) NUM: drop (NUM?) if BAD drop - STATE a! @ if KEEP drop (LIT,) jump L - KEEP: drop jump L + STATE a! @ if KEEP drop (LIT,) jump (IL) + KEEP: drop jump (IL) BAD: drop drop (UNKNOWN) drop jump (ABANDON) EOL: drop drop ; +\ ( xt -- ) INTERPRET runs a word by a call, so that the hook at `call` sees +\ it (#189), and goes on at (IL) after it: `call xt` and `jump (IL)` are put in +\ (RUNX), and run. Entered by a jump, it leaves the return stack as deep as +\ EXECUTE's tail-jump did, so a word run from the prompt has the room it had. +\ A word that interprets (LOAD) rewrites only the call, which has been run. +: (GO) + $07FFFFFF and $18000000 xor (RUNX) a! ! + &(IL) $07FFFFFF and $10000000 xor (RUNX)+1 a! ! (RUNX) push ; + \ ---- state --------------------------------------------------------------------- set HDR-NFA here ", [ #, 1 #, HDR-NFA #, HDR-LINK set HDR-LINK here diff --git a/capsules/v4/sys/map-32.f18 b/capsules/v4/sys/map-32.f18 index a246f094..2e1288ce 100644 --- a/capsules/v4/sys/map-32.f18 +++ b/capsules/v4/sys/map-32.f18 @@ -113,6 +113,8 @@ constant -HFLOOR -63186 constant DSTACK-DEPTH 16369 constant RSTACK-DEPTH 16368 constant HEAT-OP 13824 +constant (EXEC) 14690 +constant (RUNX) 14597 constant ANTICLOCK 13856 constant CFBASE 16288 constant CFEND 16320 diff --git a/capsules/v4/sys/map-64.f18 b/capsules/v4/sys/map-64.f18 index 44046953..a25fac24 100644 --- a/capsules/v4/sys/map-64.f18 +++ b/capsules/v4/sys/map-64.f18 @@ -113,6 +113,8 @@ constant -HFLOOR -63186 constant DSTACK-DEPTH 16369 constant RSTACK-DEPTH 16368 constant HEAT-OP 13824 +constant (EXEC) 14690 +constant (RUNX) 14597 constant ANTICLOCK 13856 constant CFBASE 16288 constant CFEND 16320 diff --git a/docs/fabric/FABRIC-3.md b/docs/fabric/FABRIC-3.md index 378faf5c..7616aebf 100644 --- a/docs/fabric/FABRIC-3.md +++ b/docs/fabric/FABRIC-3.md @@ -6601,3 +6601,27 @@ and memorize frequently so we can pick up where we left off"). config (`physics_execution_hooks.c`, `kernel/src/vm/vm_core.c`). `ssm_jacquard.h` says what is wired, bit by bit; `v3/CLAUDE.md` and the L8 reference corrected. - **Seen to pass:** both tests; v4 does not read the rolling window, so acceptance is unchanged. + +### 22. #189: v4's physics, the first of it -- the hook at `call`, HEAT-OP, every word called (2026-11-12/13) + +- **Found** (2026-11-12, wiring #188): v4 -- what every acceptance boot runs -- has no Compudynamics + beyond a count per opcode and the anti-clock, which nothing read; the rolling window, decay, + pipelining, inference, L8 and the heartbeat are v3's alone (`V3-PARITY.md` 2.2, 2026-10-07, never a + release blocker). Captain Bob: "That's a critical finding that blocks alpha.0" -- it blocks the alpha.5 + release; #189. The way is the plan of 2026-10-20 (`docs/v4.0.0/plans/2026-10-20-engine-step4-node-in- + the-vms-place.md`), ruled then: Part A, Phases 1, 2, then 7 ("A, 1, 2, then 7"). +- **A1, the hook at `call`:** `v4/src/exec.c` calls whoever runs the node at every `call`, after the + return address is pushed; the engine's per-call-target table, which counted no capsule word, is gone. +- **HEAT-OP** ("Add HEAT-OP. If it's a huge performance hit, we'll revert it"; a full array): + `HEAT-OP[0..31]` and `ANTICLOCK`, 33 read-only registers at word 13824, read by `HEAT-OP@` and + `ANTICLOCK@`. No measurable cost (the hosted boot's median, 3.734 s then 3.731 s): it stands. +- **A2, every word called:** the compiler copies in line only the ten words that work on the return + stack ("The ten": `>R R> R@ I J LEAVE` and the later `UNLOOP 2>R 2R> 2R@`, by their flags); every + other word is a call the hook sees. `EXECUTE` calls the xt through a two-cell `call`/`;`, and the + interpreter through `(GO)`, whose second cell jumps back into its loop. Its cost ("Accept it"): one + return entry at the bottom of a chain, and one per explicit `EXECUTE` while its word runs; the + hosted boot +2.4% (2.917 s to 2.987 s), instructions +0.4%. `SEE` shows the calls. +- **Tested first, seen to fail:** the hook (`test_exec.c`), the registers (`test_node.c`, + `test_host_quit.c`), A2's five (`test_host_compile.c`); the depth checks moved to the new figures. +- **Next:** Phase 1 -- v4 in the kernel's boot, the Stadium and the heartbeat started; then Phase 2, + the word accounts at `call`; then Phase 7, the loops on them. diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 007ec105..47425870 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -723,7 +723,7 @@ it, `xt + 1`; for any other word the parameter field is the code itself. | Word | Fate | Notes | | --- | --- | --- | | `(` `\` | 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). | +| `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).~~ **2026-11-13 (#189, ruled 2026-10-20: "`EXECUTE` calls the xt"):** a `call xt` instruction word -- opcode 3 in slot 0, the address in the 27 bits below -- is put in `(EXEC)` with a `;` after it, and run; the xt returns to the `;`, which returns to `EXECUTE`'s caller, and the hook at `call` sees it. It costs one return entry while the xt runs (Captain Bob: "Accept it"). The interpreter runs a word the same way, by `(GO)`, whose second cell jumps back into its loop, at no cost in return entries. | | `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. 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. | diff --git a/docs/v4.0.0/plans/2026-10-20-engine-step4-node-in-the-vms-place.md b/docs/v4.0.0/plans/2026-10-20-engine-step4-node-in-the-vms-place.md index 024a5693..fb7e1029 100644 --- a/docs/v4.0.0/plans/2026-10-20-engine-step4-node-in-the-vms-place.md +++ b/docs/v4.0.0/plans/2026-10-20-engine-step4-node-in-the-vms-place.md @@ -179,10 +179,16 @@ acceptance. Only Part A is written in tasks below; it does not depend on Q1 to Q **Interfaces:** Consumes A1's hook (the test sets it to observe). -- [ ] **Step 1: Failing tests** `inline_words_are_called` (for each callable in-line word of `V3-PARITY.md` 1f, a definition using it produces a call the hook sees), `residue_stays_inline` (`>R R> R@ I J LEAVE` compile in line), `execute_passes_the_hook` (`' DUP EXECUTE` seen once; Review Focus 1, from inside a definition that goes on after), `rstack_kept_across_call` (Review Focus 2), `abandoned_definition_not_called` (Review Focus 4). -- [ ] **Step 2:** Run — FAIL. -- [ ] **Step 3:** The compiler's in-line table becomes the six; `EXECUTE` calls the xt. Regenerate the maps (`make -C v4 sysmap`). -- [ ] **Step 4:** Suite passes; POST 538/538; record the new `dict_hash` (equal at both widths' products as before). +- [x] **Step 1: Failing tests** `inline_words_are_called` (for each callable in-line word of `V3-PARITY.md` 1f, a definition using it produces a call the hook sees), `residue_stays_inline` (`>R R> R@ I J LEAVE` compile in line), `execute_passes_the_hook` (`' DUP EXECUTE` seen once; Review Focus 1, from inside a definition that goes on after), `rstack_kept_across_call` (Review Focus 2), `abandoned_definition_not_called` (Review Focus 4). +- [x] **Step 2:** Run — FAIL. +- [x] **Step 3:** The compiler's in-line table becomes the six; `EXECUTE` calls the xt. Regenerate the maps (`make -C v4 sysmap`). + **Ruled 2026-11-13 (Captain Bob): "The ten"** -- four later words also work on the return stack + (`UNLOOP 2>R 2R> 2R@`, `words.f18`, `forth.f18`) and stay in line with the six: every word flagged + in-line *and* compile-only (24), decided by the flag. **And "Accept it"**: a call at the bottom of a + chain costs one return entry (words nest from the prompt 30 deep, not 31, at 32 entries), and each + explicit `EXECUTE` one while its word runs (recursion through `EXECUTE` gets half as deep). The + interpreter runs a word by `(GO)` (`compile.f18`), at the old depth. +- [x] **Step 4:** Suite passes; POST 538/538; record the new `dict_hash` (equal at both widths' products as before). (POST is 539 since #190.) - [ ] **Step 5:** Full acceptance (three boots, test-32; boot times before and after, Review Focus 5); commit `feat(v4): every word but the six is called, so it can be checked`, then the logs. Phase 1's plan is written when Part A is accepted and Q1 to Q5 are ruled. diff --git a/logs/20261113-045122/a2/README.txt b/logs/20261113-045122/a2/README.txt new file mode 100644 index 00000000..ee6abd3b --- /dev/null +++ b/logs/20261113-045122/a2/README.txt @@ -0,0 +1,5 @@ +# A2 (plan 2026-10-20; #189), 2026-11-13 +test_host_compile-before.log: A2's five tests against the compiler before the change: 3 of 1096 fail (no call seen for DUP and +; EXECUTE not seen, in a definition or at the prompt); the other two pin what must not change. +test-test32.log: make -C v4 test test-32 after: 99 programs, 3724180 checks, 0 failures. +../v4-checks: scripts/nightly.sh v4-checks after: 79 programs under the sanitizers, 0 failures; the hosted builds alike. +timing.txt: the hosted amd64 boot (POST 539), five runs each, alternating: OLD = bacb7b06, NEW = A2. Median 2.917 s / 2.987 s (+2.4%); instructions 59302047 / 59537530 (+0.4%). diff --git a/logs/20261113-045122/a2/test-test32.log b/logs/20261113-045122/a2/test-test32.log new file mode 100644 index 00000000..1583e7ca --- /dev/null +++ b/logs/20261113-045122/a2/test-test32.log @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:de1e752dcf4aa5ebbe43786d043133c81a9f31c970dd0c71b8d0d3a3607ddc09 +size 124786 diff --git a/logs/20261113-045122/a2/test_host_compile-before.log b/logs/20261113-045122/a2/test_host_compile-before.log new file mode 100644 index 00000000..8493c6c5 --- /dev/null +++ b/logs/20261113-045122/a2/test_host_compile-before.log @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:27a4e66bc2e273b10b3d4774dcc4c74c70a4a146309d66c795a5189d130546ec +size 441 diff --git a/logs/20261113-045122/a2/timing.txt b/logs/20261113-045122/a2/timing.txt new file mode 100644 index 00000000..16349c30 --- /dev/null +++ b/logs/20261113-045122/a2/timing.txt @@ -0,0 +1,10 @@ +OLD 1 2.901 s instructions=59302047 V4_POST tests=539 pass=539 +NEW 1 2.995 s instructions=59537530 V4_POST tests=539 pass=539 +OLD 2 2.958 s instructions=59302047 V4_POST tests=539 pass=539 +NEW 2 2.987 s instructions=59537530 V4_POST tests=539 pass=539 +OLD 3 2.917 s instructions=59302047 V4_POST tests=539 pass=539 +NEW 3 2.858 s instructions=59537530 V4_POST tests=539 pass=539 +OLD 4 3.025 s instructions=59302047 V4_POST tests=539 pass=539 +NEW 4 2.964 s instructions=59537530 V4_POST tests=539 pass=539 +OLD 5 2.903 s instructions=59302047 V4_POST tests=539 pass=539 +NEW 5 2.989 s instructions=59537530 V4_POST tests=539 pass=539 diff --git a/logs/20261113-045122/v4-checks/v4-checks-20261113-045122.log b/logs/20261113-045122/v4-checks/v4-checks-20261113-045122.log new file mode 100644 index 00000000..feb34293 --- /dev/null +++ b/logs/20261113-045122/v4-checks/v4-checks-20261113-045122.log @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:62533e9a1cc98612773d7431f0378cc3e18ecf4ed776711bc70ba4091f0df9fb +size 152224 diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index b2a35730..4d7f8b0b 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -122,7 +122,9 @@ /* THE IMAGE RECORD: where the system's source says, with `store`, the addresses a host needs (v4/image.h): where the * node waits for a message, its fault table, and KEY's code. */ #define ROM_IMG (BUF0_W - 119) /* idle, fault table, KEY, the word after KEY: 4 cells */ -/* FREE, plain memory: BUF0_W - 22 .. - 21; - 115 .. - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after +#define EXEC_W (BUF0_W - 22) /* (EXEC): EXECUTE's `call xt`, and the ; after it (compile.f18; #189) */ +#define RUNX_W (BUF0_W - 115) /* (RUNX): INTERPRET's `call xt`, and the jump back (compile.f18; #189) */ +/* FREE, plain memory: BUF0_W - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after * a full output buffer); and OUT_W - 144 .. OUT_W - 65. They and * the cells above held the messages waiting, the refusals owed and what went with them (MESH.md 7a, 7b), which a * node no longer keeps. */ @@ -368,6 +370,8 @@ static unsigned host_branch_slots(void) X("DSTACK-DEPTH", DSTACK_REG) \ X("RSTACK-DEPTH", RSTACK_REG) \ X("HEAT-OP", HEAT_REG) \ + X("(EXEC)", EXEC_W) \ + X("(RUNX)", RUNX_W) \ X("ANTICLOCK", HEAT_REG + 32) \ X("CFBASE", CFS_W) \ X("CFEND", CFS_W + CFS_CELLS) diff --git a/v4/tests/test_host_compile.c b/v4/tests/test_host_compile.c index 4c477972..ae1f037e 100644 --- a/v4/tests/test_host_compile.c +++ b/v4/tests/test_host_compile.c @@ -67,6 +67,37 @@ static void new_session(void) * starts with the canary alone; `depth` extra marked cells go under it and * `rdepth` under the return address, for the headroom tests. True when * INTERPRET returns. */ +/* The hook at `call` (plan 2026-10-20, Task A2; #189): while `watching`, every call's target is + * recorded, as the kernel will see it. */ +static int watching; +static v4_cell called[4096]; +static unsigned ncalled; +static void record_call(void *ctx, v4_node *nd, v4_cell target) +{ + (void)ctx; (void)nd; + if (ncalled < sizeof called / sizeof called[0]) called[ncalled] = target; + ncalled++; +} +static unsigned times_called(v4_cell xt) +{ + unsigned k, c = 0; + for (k = 0; k < ncalled && k < sizeof called / sizeof called[0]; k++) if (called[k] == xt) c++; + return c; +} +static int called_in_order(const char *const *names, unsigned count) /* names, in this order, among the calls */ +{ + unsigned k, i = 0; + for (k = 0; k < ncalled && k < sizeof called / sizeof called[0] && i < count; k++) + if (called[k] == v4_text_word(&tx, names[i])) i++; + return i == count; +} +static unsigned calls_from(v4_cell lo) /* how many calls went to an address at or above lo */ +{ + unsigned k, c = 0; + for (k = 0; k < ncalled && k < sizeof called / sizeof called[0]; k++) if (called[k] >= lo) c++; + return c; +} + static int interpret_with(const char *line, unsigned depth, unsigned rdepth) { unsigned len = (unsigned)strlen(line), i; @@ -77,6 +108,7 @@ static int interpret_with(const char *line, unsigned depth, unsigned rdepth) v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es); + if (watching) { es.on_call = record_call; es.on_call_ctx = 0; ncalled = 0; } v4_heat_reset(&h); for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i)); v4_dstack_push(&n.ds, CANARY); @@ -203,8 +235,12 @@ int main(void) } /* two in-line words of the test's own, to exercise the in-liner: one with * two literals in one instruction word, one with a nop in it */ - CHECK(v4_text_assemble(&tx, "header TWOLIT inline : TWOLIT 3 + 100 + ;\n" - "header HASNOP inline : HASNOP dup nop drop 7 ;\n"), "the test's in-line words: %s", v4_text_error(&tx)); + CHECK(v4_text_assemble(&tx, "header TWOLIT inline compile-only : TWOLIT 3 + 100 + ;\n" + "header HASNOP inline compile-only : HASNOP dup nop drop 7 ;\n" + /* and two that stay in line (A2), so the control structures' code can be + * compared word for word without calls in it */ + "header 1-I inline compile-only : 1-I -1 + ;\n" + "header DUPI inline compile-only : DUPI dup ;\n"), "the test's in-line words: %s", v4_text_error(&tx)); CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space"); printf(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16); @@ -237,16 +273,48 @@ int main(void) } /* ---- what was compiled, word for word ---- */ + /* ---- A2 (plan 2026-10-20; #189; Captain Bob, 2026-11-13: "The ten"): every word is called, so + * the hook at `call` sees it -- but the ten that work on the return stack (in line and + * compile-only: >R R> R@ I J LEAVE UNLOOP 2>R 2R> 2R@), which a call would bury ---- */ new_session(); - CHECK(ok(": T DUP OVER + SWAP DROP 5 + ;") && same_code(": T dup over + over push push drop pop pop drop 5 + ;"), "in-line words are copied in line"); + CHECK(ok(": T DUP OVER + SWAP DROP 5 + ;"), "a definition of in-line words"); + watching = 1; + { + static const char *const order[] = { "DUP", "OVER", "PLUS", "SWAP'", "DROP", "PLUS" }; + CHECK(one("3 T") == 11 && called_in_order(order, 6) && times_called(v4_text_word(&tx, "DUP")) == 1 + && times_called(v4_text_word(&tx, "PLUS")) == 2, + "inline_words_are_called: the hook sees DUP OVER + SWAP DROP + called, in order (DUP %u, + %u times)", + times_called(v4_text_word(&tx, "DUP")), times_called(v4_text_word(&tx, "PLUS"))); + } + watching = 0; + new_session(); + CHECK(ok(": T 1 >R R> ;") && same_code(": T 1 push pop ;"), "residue_stays_inline: >R R> are copied in line"); + new_session(); + CHECK(ok(": T 4 0 DO I LOOP + + + ;") && one("T") == 6, "residue_stays_inline: I in a loop, still in line"); + new_session(); + CHECK(ok(": T 3 0 DO I 1 = IF UNLOOP 7 EXIT THEN LOOP 9 ;") && one("T") == 7, "residue_stays_inline: UNLOOP then EXIT leaves the word"); + new_session(); + watching = 1; + CHECK(ok(": T 5 ' DUP EXECUTE + 1+ ;") && one("T") == 11 && times_called(v4_text_word(&tx, "DUP")) == 1, + "execute_passes_the_hook: ' DUP EXECUTE inside a definition is seen once (%u), and the definition goes on after", + times_called(v4_text_word(&tx, "DUP"))); + CHECK(one("6 ' DUP EXECUTE +") == 12 && times_called(v4_text_word(&tx, "DUP")) >= 1, "and at the prompt"); + watching = 0; + new_session(); + CHECK(ok(": T 7 >R 1 DUP + R> + ;") && one("T") == 9, "rstack_kept_across_call: a call does not disturb what >R put there"); + new_session(); + watching = 1; + CHECK(abandoned(": T 1 DUP NOSUCH") && calls_from(DICT_W) == 0, + "abandoned_definition_not_called: the hook sees no call into a definition that was abandoned (%u)", calls_from(DICT_W)); + watching = 0; new_session(); CHECK(ok(": T IF 1 THEN ;") && same_code(": T if L1 drop 1 jump L2 L1: drop L2: ;"), "IF THEN, as section 2 gives it"); new_session(); CHECK(ok(": T IF 1 ELSE 2 THEN ;") && same_code(": T if L1 drop 1 jump L2 L1: drop 2 L2: ;"), "IF ELSE THEN, as section 2 gives it"); new_session(); - CHECK(ok(": T BEGIN 1- DUP UNTIL ;") && same_code(": T jump L0 LD: drop L0: -1 + dup if LD drop ;"), "BEGIN UNTIL"); + CHECK(ok(": T BEGIN 1-I DUPI UNTIL ;") && same_code(": T jump L0 LD: drop L0: -1 + dup if LD drop ;"), "BEGIN UNTIL"); new_session(); - CHECK(ok(": T BEGIN DUP WHILE 1- REPEAT ;") && same_code(": T jump L0 LD: drop L0: dup if LX drop -1 + jump L0 LX: drop ;"), "BEGIN WHILE REPEAT"); + CHECK(ok(": T BEGIN DUPI WHILE 1-I REPEAT ;") && same_code(": T jump L0 LD: drop L0: dup if LX drop -1 + jump L0 LX: drop ;"), "BEGIN WHILE REPEAT"); new_session(); CHECK(ok(": T DO I LOOP ;") && same_code(": T over push push drop BODY: pop dup push" diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 8a5b58d5..8d3a1e6e 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -972,6 +972,10 @@ int main(void) CHECK(is(say(": T3 24 HEAT-OP@ 56 HEAT-OP@ = IF 89 EMIT THEN ; T3\n"), "Y ok\nok> "), "an opcode number is taken mod 32: 56 reads dup's count (opcode 24), with no dup between"); + /* ---- A2 (#189): 2>R 2R@ 2R>, in words.f18, stay in line -- a call would bury their values ---- */ + boot(); + CHECK(is(say(": T4 1 2 2>R 2R@ 2R> + + + 48 + EMIT ; T4\n"), "6 ok\nok> "), "2>R 2R@ 2R> keep their values in a definition"); + /* ---- a definition over several lines, and an error in the middle of one ---- */ boot(); CHECK(is(say(": LONG\n"), " ok\nok> ") && n.mem[STATE] != 0, "a line that leaves a definition open still says ok"); @@ -1095,8 +1099,10 @@ int main(void) CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "ABORT has emptied the data stack"); /* ---- how deep words may call each other from the prompt ---- - * The prompt's call of INTERPRET is one return entry, so a chain of words - * one shorter than the return stack runs, and the next is a fault. */ + * The prompt's call of INTERPRET is one return entry; and N0's 1+ is a call + * since A2 (#189; Captain Bob, 2026-11-13: "Accept it"), one more at the + * bottom. So a chain two shorter than the return stack runs, and the next + * is a fault. */ { unsigned deepest = 0; char line[64], want[16]; @@ -1113,16 +1119,17 @@ int main(void) deepest = i + 1; } printf(" from the prompt, words may call each other %u deep\n", deepest); - CHECK(deepest == V4_RET_DEPTH - 1u, "a word run from the prompt has all the return stack but the prompt's one entry"); + CHECK(deepest == V4_RET_DEPTH - 2u, "a word run from the prompt has all the return stack but the prompt's one entry and the call of the in-line 1+ at the bottom (%u)", deepest); CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and one more is reported"); } /* ---- the exits, taken with the return stack full ---- - * RR runs itself through EXECUTE; each level holds one return entry, and - * EXECUTE one more while it starts the next. With C at its largest and - * one >R besides, there is room for exactly the action's own call. An - * exit that did not empty the return stack before it printed would - * overflow it. */ + * RR runs itself through EXECUTE. EXECUTE calls the word since A2 (#189), + * so each level below the first holds two return entries -- RR's own, and + * the ; EXECUTE's call returns to -- and the first one: 2 + 2(C-1) with the + * prompt's. With C at its largest, (D-2)/2, and one >R besides, there is + * room for the action's own call. An exit that did not empty the return + * stack before it printed would overflow it. */ { static const struct { const char *action, *want; } e[] = { { "1 ABORT\" x\"", "x\n ok\nok> " }, @@ -1139,12 +1146,12 @@ int main(void) CHECK(is(say("VARIABLE V VARIABLE C\n"), " ok\nok> "), "two variables"); snprintf(line, sizeof line, ": RR C @ 1- DUP C ! IF V @ EXECUTE EXIT THEN 1 >R %s ;\n", e[i].action); CHECK(is(say(line), " ok\nok> "), "a word that runs itself C times and then: %s", e[i].action); - snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)(V4_RET_DEPTH - 3u)); + snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)((V4_RET_DEPTH - 2u) / 2u)); CHECK(is(say(line), e[i].want), "%s with the return stack full", e[i].action); CHECK(n.faults == 0, "%s: and it was not a fault", e[i].action); CHECK(is(say("65 EMIT\n"), "A ok\nok> "), "and the next line runs"); /* one level more and the action's own call does not fit */ - snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 2u)); + snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)((V4_RET_DEPTH - 2u) / 2u + 1u)); CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "%s one level deeper is a return stack overflow", e[i].action); } } @@ -1565,25 +1572,26 @@ int main(void) /* ---- SEE: FORTH source too ---- */ boot_bare(); CHECK(load_source("tools.fth"), "tools.fth compiles, every line of it"); - CHECK(is(say(": SQ DUP * ; SEE SQ\n"), ": SQ\n dup call * \n ; \n ok\nok> "), "a definition: an in-line word, a call by name, the return"); + CHECK(is(say(": SQ DUP * ; SEE SQ\n"), ": SQ\n call DUP \n call * \n ; \n ok\nok> "), + "a definition: an in-line word called since A2 (#189), a call by name, the return"); CHECK(is(say("SEE DUP\n"), ": DUP\n dup ; \n ok\nok> ") && is(say("SEE EMIT\n"), out) && strncmp(out, ": EMIT\n @p 255 and ", 20) == 0 && strstr(out, " pop a! ; \n"), "the capsule's own words; a literal's value follows its @p"); CHECK(is(say("VARIABLE V 7 V ! SEE V\n"), ": V\n data: 7 \n ok\nok> ") && is(say("5 CONSTANT K SEE K\n"), ": K\n data: 5 \n ok\nok> "), "a variable and a constant show what they hold"); CHECK(is(say(": IM 1 ; IMMEDIATE SEE IM\n"), ": IM\n @p 1 ; \nIMMEDIATE\n ok\nok> "), "an immediate word says so"); - CHECK(is(say(": ST .\" hi\" 300 + ; SEE ST\n"), ": ST\n call (.\") \"hi\" \n @p 300 + ; \n ok\nok> "), "text in a definition is shown as text, and the code after it as code"); + CHECK(is(say(": ST .\" hi\" 300 + ; SEE ST\n"), ": ST\n call (.\") \"hi\" \n @p 300 call + \n ; \n ok\nok> "), "text in a definition is shown as text, and the code after it as code"); CHECK(is(say(": S3 S\" abcdefg\" 0 ABORT\" x\" ; SEE S3\n"), ": S3\n call (S\") \"abcdefg\" \n @p 0 call (ABORT\") \"x\" \n ; \n ok\nok> "), "S\" and ABORT\" the same"); { /* branches: the addresses are this node's, so they are read back rather than written here */ const char *o = say(": AB DUP 0< IF NEGATE THEN ; SEE AB\n"); long a1, a2; - CHECK(sscanf(o, ": AB\n dup call 0< \n if %ld \n drop inv @p 1 + \n jump %ld \n drop \n ; \n ok", &a1, &a2) == 2 && a2 == a1 + 1 + CHECK(sscanf(o, ": AB\n call DUP \n call 0< \n if %ld \n drop call NEGATE \n jump %ld \n drop \n ; \n ok", &a1, &a2) == 2 && a2 == a1 + 1 && a1 > (long)DICT_W && a1 < (long)DICT_END_W, "IF and THEN: the if goes to the drop, the jump to the word after it"); CHECK(is(say("7 AB -7 AB + .\n"), "14 ok\nok> "), "(and the word works)"); o = say(": LP 10 0 DO I . LOOP ; SEE LP\n"); CHECK(strstr(o, ": LP\n @p 10 @p 0 over push push drop \n pop dup push \n call . \n") == o && strstr(o, "\n drop drop drop ; \n ok\nok> "), "a loop runs to its last return, past the returns inside it"); o = say("SEE SEE\n"); - CHECK(strstr(o, ": SEE\n call FIND \n dup call 0= \n call (ABORT\") \"SEE: not found\" \n call (.\") \": \" \n") == o + CHECK(strstr(o, ": SEE\n call FIND \n call DUP \n call 0= \n call (ABORT\") \"SEE: not found\" \n call (.\") \": \" \n") == o && strstr(o, "call (SEE-CODE) ") && strstr(o, "\"IMMEDIATE\" \n call CR \n") && strlen(o) < 700, "SEE shows itself"); } CHECK(is(say(": S4 .\" abcd\" 65 EMIT ; SEE S4\n"), ": S4\n call (.\") \"abcd\" \n @p 65 call EMIT \n ; \n ok\nok> "), "text that fills its last cell but for the count");