feat(v4): every word but the ten is called, so it can be checked
Plan 2026-10-20 (ENGINE step 4), Task A2, for #189. Captain Bob, 2026-11-13: "The ten"; "Accept it". - compile.f18 (COMPILE,): a word is copied in line only when it is flagged in-line and compile-only (24) -- the ten that work on the return stack, >R R> R@ I J LEAVE and the later UNLOOP 2>R 2R> 2R@. Every other word, in-line ones too, is a call the hook at `call` sees. - EXECUTE calls the xt: `call xt` (opcode 3, slot 0) and a ; in (EXEC), run. INTERPRET runs a word by (GO): `call xt` and `jump (IL)` in (RUNX), entered by a jump, at the old return-stack depth. - host_map.h: (EXEC) BUF0_W-22, (RUNX) BUF0_W-115, from what was free. - Its cost, accepted: one return entry at the bottom of a chain (30 deep from the prompt, not 31) and one per explicit EXECUTE while its word runs; the hosted boot +2.4% (2.917 s to 2.987 s), instructions +0.4%. - Tests first (logs/20261113-045122/a2): inline_words_are_called, residue_stays_inline, execute_passes_the_hook, rstack_kept_across_call, abandoned_definition_not_called -- 3 of 1096 failed before. The depth checks moved to the new figures; SEE shows the calls; two layout checks use in-line test words; 2>R 2R@ 2R> checked in test_host_quit. - DECOMPOSITION.md EXECUTE, the plan's A2 and rulings, FABRIC-3 XLVIII.22. Suite: test, test-32 99 programs 0 failures; v4-checks 79 under the sanitizers 0 failures, the hosted builds alike; hosted POST 539/539. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_017RzZgrf7V7Zk2iczBXDRbm
This commit is contained in:
Claude
+34
-13
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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. |
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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%).
|
||||
Binary file not shown.
Binary file not shown.
@@ -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
|
||||
Binary file not shown.
+5
-1
@@ -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)
|
||||
|
||||
@@ -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"
|
||||
|
||||
+22
-14
@@ -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");
|
||||
|
||||
Reference in New Issue
Block a user