feat(v4.0.0): CASE, ['], S", WORDS, FORGET and FENCE
- compile.v4: CASE OF ENDOF ENDCASE, as v3 (they nest; a word out of place is a control structure mismatch); ['] and [LITERAL]. - quit.v4: S" and its run-time word; at the prompt the text is copied to PAD. - capsule/system.v4: WORDS and VLIST; FORGET (FORTH-79), which gives the space back and will not remove a word below FENCE -- the capsule's own words -- where v3's FORGET DUP succeeds. - tests/test_host_quit.c: ten more transcripts of the v3 binary, and nesting, the fence and the listing. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
c02505db69
commit
e7d686c7a2
@@ -179,7 +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`. |
|
||||
| **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`, 9 `Shift count out of range`, 10 `Protected word`; −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
|
||||
@@ -582,7 +582,7 @@ width and print a flood of spaces.
|
||||
| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. `TIB` is the buffer's byte address and `>IN` and `SPAN` their variables' word addresses, all in line; `SOURCE ( -- baddr u )` is `TIB` and `SPAN @`, a negative `SPAN` read as 0. Executed on the golden model's host node (2026-10-04). |
|
||||
| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )` is FORTH-79 (ruled 2026-10-04): characters are taken from `TIB` until the delimiter `c` or the end of the text, leading delimiters ignored, and stored as a counted string; the delimiter met (`c`, or a zero if the text ran out) is stored after them, uncounted; `>IN` is left just past it; with nothing left the count is 0. The count is a byte, so a word over 255 characters is cut to 255; the buffer is 257 bytes. v3's `WORD` skipped every delimiter after the word, always stored a zero, and cut at 62. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )`, not a FORTH-79 word, works on a zero-terminated string as v3's. Executed on the golden model's host node (2026-10-04) against C, and `ENCLOSE` against values recorded from the v3 binary. `WORD` keeps what it works on in memory and has at most three cells of its own on the data stack: it leaves its caller 7 data cells and 6 return entries. `(PARSE) ( c -- baddr )` is `WORD` without the skipping of leading delimiters: the text starts at `>IN` and may be empty. It is what `."` and `ABORT"` use, so that `." "` is an empty string. |
|
||||
| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 2 return entries; the interpreter does not use it (it has a single-cell conversion of its own that needs far less of the stack). |
|
||||
| `S"` `(s")` `[']` | CC | Compiler words. |
|
||||
| `S"` `(S")` `[']` | CC | Source in `v4/capsule/quit.v4` and `compile.v4`. `S" text"` `( -- baddr u )`, as v3: in a definition the text is compiled after a call to `(S")`, as `."` compiles it, and `(S")` leaves its address and length and returns past it. At the prompt the text is copied to `PAD` and stays there until `PAD` is used again. `['] xxx` compiles `xxx`'s address as a literal. v3 also has `[LITERAL]`, another name for `LITERAL`. Executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. |
|
||||
| `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
|
||||
|
||||
```forth
|
||||
@@ -729,7 +729,8 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
| `COLD` `WARM` | CC | |
|
||||
| `BYE` `REBOOT` | HERA | |
|
||||
| `SAVE-SYSTEM` | HERA | Snapshot becomes a capsule-image request. |
|
||||
| `WORDS` `VLIST` `SEE` | CC | |
|
||||
| `WORDS` `VLIST` | CC | Source in `v4/capsule/system.v4`. The names in the dictionary, the newest first, a blank after each, a new line whenever one has passed column 64; a definition under way is not shown. v3 prints a heading, eight names to a line and a total. Executed on the golden model's host node (2026-10-04). |
|
||||
| `SEE` | CC | |
|
||||
| `PAGE` | DEV | |
|
||||
| `79-STANDARD` | CC | |
|
||||
|
||||
@@ -745,7 +746,7 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
| --- | --- | --- |
|
||||
| `:` `;` `EXIT` `IMMEDIATE` `STATE` `[` `]` `LITERAL` `COMPILE` `[COMPILE]` | CC | Source in `v4/capsule/compile.v4`, all to FORTH-79. `:` makes an entry and starts compiling; the word cannot be found until `;`, so a redefinition can use the old word. `;` lays the return, reveals the word and stops compiling. `LITERAL` compiles the number on the stack when compiling. `COMPILE xxx` lays code that compiles `xxx` when the word it is in runs; `[COMPILE] xxx` compiles `xxx` though it is immediate. Executed on the golden model's host node (2026-10-04) against results recorded from the v3 binary; v3's `COMPILE` does not work (`: C1 COMPILE DUP ; IMMEDIATE : U3 C1 + ;` gives `DUP: Stack underflow`), reported, not fixed. |
|
||||
| `CREATE` `VARIABLE` `CONSTANT` `DOES>` | CC | FORTH-79. A data word's code is one instruction word, a call to its run-time routine, and its parameter field is the cell after it: `(DOVAR)` is `pop ;` (the call's return address is the parameter field's address) and `(DOCON)` is `pop a! @ ;`. `VARIABLE` allots one cell, set to 0. `DOES>` lays a call to `(DOES)` and then `pop`: `(DOES)`, run by the defining word, rewrites the newest entry's code into a call to the code after it and returns from the defining word; that code's `pop` fetches the parameter field address. Executed on the golden model's host node (2026-10-04) against results recorded from the v3 binary. |
|
||||
| `FORGET` `FENCE` | CC | |
|
||||
| `FORGET` `FENCE` | CC | Source in `v4/capsule/system.v4`. `FORGET xxx` is FORTH-79: `xxx` and every word defined after it are removed and their space is free again. A word that is not there is an error (`UNKNOWN WORD`), and so is one that starts below the address in the variable `FENCE` — where the capsule's own words are — which is D-18's code 10, `Protected word`. v3's `FORGET DUP` succeeds and takes `FORGET` itself with it. Executed on the golden model's host node (2026-10-04), including a transcript of the v3 binary. |
|
||||
| `LIT` | OP | `@p` |
|
||||
| `does_rt` | RET | Internal helper; `DOES>` is implemented by the compiler capsule. |
|
||||
|
||||
@@ -757,7 +758,7 @@ call would bury what it works on. A **compile-only** word may not be executed by
|
||||
`v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`,
|
||||
`LEAVE`, `@`, the in-line variables and so on).
|
||||
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`), `system.v4` (`WORDS`, `FORGET`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top.
|
||||
|
||||
**The stacks and the compiler.** The interpreter and compiler run on the same stacks as the user's
|
||||
words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine
|
||||
@@ -811,7 +812,7 @@ lays down was then run.
|
||||
| --- | --- | --- |
|
||||
| `IF` `ELSE` `THEN` `BEGIN` `UNTIL` `AGAIN` `WHILE` `REPEAT` `DO` `?DO` `LOOP` `+LOOP` | CC | Compile-time structure words, immediate and compile-only; source in `v4/capsule/compile.v4`. Expansions per §2 and below. What an opening word leaves for the word that closes it goes on a **control-flow stack in memory** (32 cells), not on the data stack, with a number saying which word left it; a closing word that finds the wrong number, or nothing, abandons the line. A loop that tests at its end (`UNTIL`) must drop the flag on both ways out, so `BEGIN` lays `jump L0 Ld: drop L0:` and `UNTIL` lays `if Ld drop`. Executed on the golden model's host node (2026-10-04): the code laid down for each is word for word what the text assembler makes of the expansion given here, and the programmes run give what the v3 binary gave. |
|
||||
| `LEAVE` `I` `J` `UNLOOP` | CC | In-line words (below), compile-only. |
|
||||
| `CASE` `OF` `ENDOF` `ENDCASE` | CC | |
|
||||
| `CASE` `OF` `ENDOF` `ENDCASE` | CC | Source in `v4/capsule/compile.v4`; not FORTH-79, as v3. The value chosen on stays on the stack through the clauses. Each `x OF a ENDOF` is laid as `over xor if M drop jump N M: drop drop a jump END N:`, and `ENDCASE` lays the `drop` that the part after the last `ENDOF` leaves the value for, with `END` after it. The control-flow stack holds the jumps to `END`, how many there are, and the tag 7; inside a clause, the jump to `N` and 8. They nest, and a word out of place is a `Control structure mismatch`. Executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. |
|
||||
| `EXIT` | OP | `;` |
|
||||
| `(BRANCH)` | OP | `jump` |
|
||||
| `(0BRANCH)` | IN | `if L … drop` (§2) — executed on the golden model (2026-10-03) as `IF 1 ELSE 2 THEN`, including results recorded from the v3 binary. |
|
||||
|
||||
+41
-1
@@ -177,6 +177,13 @@ header LITERAL immediate
|
||||
header ' immediate
|
||||
: TICK (') jump LITERAL
|
||||
|
||||
\ ['] xxx the same inside a definition, whatever STATE is; and [LITERAL],
|
||||
\ which v3 has as another name for LITERAL.
|
||||
header ['] immediate compile-only
|
||||
: BRACKET-TICK (') jump (LIT,)
|
||||
header [LITERAL] immediate
|
||||
: BRACKET-LITERAL jump LITERAL
|
||||
|
||||
\ ---- colon definitions -----------------------------------------------------------
|
||||
|
||||
\ FORTH-79: start a definition; it cannot be found until ; ends it.
|
||||
@@ -263,7 +270,7 @@ header DOES> immediate compile-only
|
||||
\ ---- control structures (5.18, section 2) ---------------------------------------------
|
||||
\ All immediate and compile-only. Each puts what the word that closes it
|
||||
\ needs on the control-flow stack, with a number on top saying which word put
|
||||
\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO. A closing word that
|
||||
\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO, 7 CASE, 8 OF. A closing word that
|
||||
\ finds the wrong number abandons the line.
|
||||
|
||||
\ ( tag wanted -- ) if they differ, abandon the line and leave the control
|
||||
@@ -319,6 +326,39 @@ header REPEAT immediate compile-only
|
||||
CF> 3 (PAIR) CF> (JUMP,) CF> drop
|
||||
(C)+6 a! @ (HERE!) 23 jump (OP,)
|
||||
|
||||
\ CASE: the value being chosen on stays on the stack through the clauses.
|
||||
\ CASE x1 OF a ENDOF x2 OF b ENDOF c ENDCASE
|
||||
\ lays, for each clause,
|
||||
\ over xor if M drop jump N M: drop drop a jump END N:
|
||||
\ and ENDCASE lays the drop that the part after the last ENDOF leaves the
|
||||
\ value for, with END after it. The control-flow stack holds the jumps to
|
||||
\ END, how many there are, and 7; inside a clause, the jump to N and 8.
|
||||
: (of) over xor ;
|
||||
header CASE immediate compile-only
|
||||
: CASE 0 >CF 7 jump >CF
|
||||
header OF immediate compile-only
|
||||
: OF
|
||||
CF> 7 (PAIR)
|
||||
&(of) (INLINE,) 6 (BRANCH>) (C)+6 a! ! \ if M
|
||||
23 (OP,) 2 (BRANCH>) >CF \ drop, jump N
|
||||
(C)+6 a! @ (HERE!) 23 (OP,) 23 (OP,) \ M: drop drop
|
||||
8 jump >CF
|
||||
header ENDOF immediate compile-only
|
||||
: ENDOF
|
||||
CF> 8 (PAIR) CF> (C)+6 a! ! \ the jump to N
|
||||
CF> (C)+7 a! ! \ how many jumps to END so far
|
||||
2 (BRANCH>) >CF \ one more
|
||||
(C)+7 a! @ 1 + >CF
|
||||
(C)+6 a! @ (HERE!) \ N:
|
||||
7 jump >CF
|
||||
header ENDCASE immediate compile-only
|
||||
: ENDCASE
|
||||
CF> 7 (PAIR) CF> (C)+7 a! !
|
||||
23 (OP,)
|
||||
L: (C)+7 a! @ if DONE -1 + !
|
||||
CF> (HERE!) jump L
|
||||
DONE: drop ;
|
||||
|
||||
\ DO loops: the limit and index are on the return stack, limit below (5.18).
|
||||
: (do) over push push drop ;
|
||||
: (?do) over over xor ;
|
||||
|
||||
+1
-1
@@ -14,7 +14,7 @@
|
||||
\ 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
|
||||
\ 9 Shift count out of range
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
@@ -96,6 +96,7 @@ header ABORT
|
||||
-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 -1 + if M9
|
||||
-1 + if M10
|
||||
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)
|
||||
@@ -106,6 +107,7 @@ header ABORT
|
||||
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)
|
||||
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL)
|
||||
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (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
|
||||
@@ -170,3 +172,20 @@ header ABORT" immediate
|
||||
NOW: drop if NO
|
||||
drop WBUF COUNT TYPE CR jump ABORT
|
||||
NO: drop ;
|
||||
|
||||
\ The run time of S" : leave the address and length of the string after the
|
||||
\ call, and go on after it.
|
||||
: (S")
|
||||
pop 4* dup C@ \ baddr n
|
||||
over over + 4/ 1 + push \ the cell after the last character
|
||||
push 1 + pop ; \ baddr+1 n
|
||||
|
||||
\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled
|
||||
\ into it. At the prompt it is copied to PAD, where it stays until PAD is
|
||||
\ used again: WORD's buffer is overwritten by the very next word of the line.
|
||||
header S" immediate
|
||||
: S-QUOTE
|
||||
34 (PARSE) drop
|
||||
STATE a! @ if NOW
|
||||
drop &(S") (CALL,) jump (STRING,)
|
||||
NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
\ system.v4 -- words about the dictionary as a whole: WORDS, FORGET, FENCE.
|
||||
\
|
||||
\ DECOMPOSITION.md 5.13 and 5.15. Part of the compiler capsule; rests on
|
||||
\ dict.v4, quit.v4 and forth.v4.
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ FENCE word address of the variable: FORGET will not remove an entry
|
||||
\ that starts below the address it holds
|
||||
|
||||
header FENCE inline : FENCE' FENCE ;
|
||||
|
||||
\ ( -- ) the names in the dictionary, the newest first, a blank after
|
||||
\ each, a new line whenever one has passed column 64. Hidden entries -- a
|
||||
\ definition under way -- are not shown. (Q)+0 is the column.
|
||||
header WORDS
|
||||
: WORDS
|
||||
0 (Q) a! !
|
||||
LATEST
|
||||
L: if DONE
|
||||
dup -3 + a! @ 2 and if SHOW drop jump NXT
|
||||
SHOW: drop
|
||||
dup -2 + a! @ 4* COUNT 31 and \ xt baddr u
|
||||
dup (Q) a! @ + 1 + !
|
||||
TYPE SPACE
|
||||
(Q) a! @ -64 + -if WRAP drop jump NXT
|
||||
WRAP: drop CR 0 (Q) a! !
|
||||
NXT: -1 + a! @ jump L
|
||||
DONE: drop jump CR
|
||||
header VLIST
|
||||
: VLIST jump WORDS
|
||||
|
||||
\ FORGET xxx FORTH-79: remove xxx and every word defined after it. The
|
||||
\ space they took is free again. A word that is not there is an error, and
|
||||
\ so is one below FENCE, which is where the capsule's own words are (code
|
||||
\ 10, "Protected word").
|
||||
header FORGET
|
||||
: FORGET
|
||||
32 WORD (LOOKUP) if MISSING
|
||||
dup -2 + a! @ \ xt name
|
||||
dup FENCE a! @ inv + 1 + -if OK \ name - fence
|
||||
drop drop drop NODE-ERROR b! 10 !b ;
|
||||
OK: drop
|
||||
4* DP a! ! \ the space from its name on
|
||||
-1 + a! @ (LATEST) a! ! ; \ and the entry before it is the newest
|
||||
MISSING: drop (UNKNOWN) drop ;
|
||||
@@ -40,6 +40,7 @@
|
||||
#define FVARS (TOP - 105) /* (F): forth.v4, 7 cells */
|
||||
#define SVARS (TOP - 540 - (v4_cell)V4_DATA_DEPTH) /* (S): where PICK and ROLL set stack values aside, one cell for each cell of the stack */
|
||||
#define WVARS (TOP - 99) /* (W): numout.v4, 3 cells */
|
||||
#define FENCE (TOP - 26) /* FORGET's lower limit */
|
||||
#define HLD (TOP - 25) /* where the pictured number has got to */
|
||||
#define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */
|
||||
|
||||
@@ -116,6 +117,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "(X)", XVARS);
|
||||
v4_text_constant(tx, "MAX-INT", (v4_cell)(V4_MSB - 1u));
|
||||
v4_text_constant(tx, "HLD", HLD);
|
||||
v4_text_constant(tx, "FENCE", FENCE);
|
||||
v4_text_constant(tx, "HEND", HEND);
|
||||
v4_text_constant(tx, "-HFLOOR", -(HEND - 62));
|
||||
v4_text_constant(tx, "DSTACK-DEPTH", DSTACK_REG);
|
||||
|
||||
@@ -81,6 +81,7 @@ static void boot_with(unsigned depth)
|
||||
n.mem[CFP] = CFS_W;
|
||||
n.mem[BASE] = 10;
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
n.mem[FENCE] = DICT_W;
|
||||
v4_node_console_attach(&n, CONSOLE_TX);
|
||||
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
|
||||
v4_node_fault_attach(&n, w_fault);
|
||||
@@ -184,6 +185,24 @@ static const transcript script[] = {
|
||||
{ "2 BASE ! 5 . DECIMAL\n", "UNKNOWN WORD: '5'\n ERROR\nok> ", 1 },
|
||||
{ ": T 10 0 DO I . LOOP ; T\n", "0 1 2 3 4 5 6 7 8 9 ok\nok> ", 1 },
|
||||
{ "DEPTH . 1 2 DEPTH . . .\n", "0 2 2 1 ok\nok> ", 1 },
|
||||
/* CASE, ['], S", FORGET */
|
||||
{ ": C1 CASE 1 OF 65 EMIT ENDOF 2 OF 66 EMIT ENDOF 67 EMIT ENDCASE ;\n1 C1 2 C1 3 C1\n.S\n", " ok\nok> ABC ok\nok> <0> \n ok\nok> ", 1 },
|
||||
{ ": C2 CASE 1 OF 10 ENDOF 2 OF 20 ENDOF DUP 100 + SWAP ENDCASE ;\n1 C2 . 2 C2 . 7 C2 .\n.S\n", " ok\nok> 10 20 107 ok\nok> <0> \n ok\nok> ", 1 },
|
||||
{ ": C3 CASE ENDCASE ; 5 C3 .S\n", "<0> \n ok\nok> ", 1 },
|
||||
{ ": T1 11 ; : T2 ['] T1 EXECUTE ; T2 .\n", "11 ok\nok> ", 1 },
|
||||
{ ": S1 S\" hello\" TYPE ; S1\n", "hello ok\nok> ", 1 },
|
||||
{ ": S2 S\" abc\" ; S2 . DROP .S\n", "3 <0> \n ok\nok> ", 1 },
|
||||
{ "S\" xyz\" TYPE\n", "xyz ok\nok> ", 1 },
|
||||
{ ": A1 1 ; : A2 2 ; : A3 3 ; FORGET A2 A1 .\nA3\nA2\n", "1 ok\nok> UNKNOWN WORD: 'A3'\n ERROR\nok> UNKNOWN WORD: 'A2'\n ERROR\nok> ", 1 },
|
||||
{ ": L1 [ 5 ] [LITERAL] ; L1 .\n", "5 ok\nok> ", 1 },
|
||||
{ "CASE\n", "CASE: compile-only\n ERROR\nok> ", 1 },
|
||||
/* v4's own */
|
||||
{ ": C4 CASE 1 OF 65 EMIT ENDCASE ;\n: C5 1 OF ;\n: C6 CASE ENDOF ;\n: C7 ENDCASE ;\n",
|
||||
"Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> Control structure mismatch\n ERROR\nok> "
|
||||
"Control structure mismatch\n ERROR\nok> ", 0 },
|
||||
{ "7 FORGET DUP 65 EMIT\nFORGET NOSUCH\nDUP . .\n", "Protected word\n ERROR\nok> UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 7 7 ok\nok> ", 0 },
|
||||
{ ": S3 S\" \" SWAP DROP . S\" ab\" S\" cde\" TYPE TYPE ; S3\n", "0 cdeab ok\nok> ", 0 },
|
||||
{ ": T3 ['] NOSUCH ;\n['] DUP\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> [']: compile-only\n ERROR\nok> ", 0 },
|
||||
/* words.v4 */
|
||||
{ "1 2 3 4 2SWAP . . . .\n", "2 1 4 3 ok\nok> ", 1 },
|
||||
{ "1 2 3 4 2OVER . . . . . .\n", "2 1 4 3 2 1 ok\nok> ", 1 },
|
||||
@@ -312,8 +331,8 @@ int main(void)
|
||||
printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
{
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 9), "the capsule assembles");
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 10), "the capsule assembles");
|
||||
}
|
||||
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");
|
||||
@@ -637,6 +656,44 @@ int main(void)
|
||||
CHECK(most + 8u >= V4_DATA_DEPTH, ".S works with all but eight cells of the stack in use");
|
||||
}
|
||||
|
||||
/* ---- nested CASE, by value ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say(": IN CASE 1 OF 65 ENDOF 2 OF 66 ENDOF 63 SWAP ENDCASE ;\n"), " ok\nok> ")
|
||||
&& is(say(": OUT CASE 1 OF IN ENDOF 2 OF DROP 90 ENDOF DROP 33 SWAP ENDCASE EMIT ;\n"), " ok\nok> "), "a CASE that calls a CASE");
|
||||
CHECK(is(say("1 1 OUT 2 1 OUT 9 1 OUT 5 2 OUT 5 7 OUT .S\n"), "AB?Z!<0> \n ok\nok> "), "every path through both");
|
||||
CHECK(is(say(": NC CASE 1 OF CASE 5 OF 65 ENDOF 66 SWAP ENDCASE ENDOF 67 SWAP ENDCASE EMIT ;\n"), " ok\nok> ")
|
||||
&& is(say("5 1 NC 6 1 NC 7 2 NC .S\n"), "ABC<1> 7 \n ok\nok> "), "a CASE inside a clause of a CASE");
|
||||
|
||||
/* ---- FORGET gives the space back, and FENCE protects ---- */
|
||||
boot_bare();
|
||||
{
|
||||
v4_cell dp0 = n.mem[DP], latest0 = n.mem[LATEST];
|
||||
CHECK(is(say(": F1 1 ; VARIABLE F2 : F3 F1 F2 ;\n"), " ok\nok> ") && n.mem[DP] > dp0, "three words");
|
||||
CHECK(is(say("FORGET F1\n"), " ok\nok> ") && n.mem[DP] == dp0 && n.mem[LATEST] == latest0, "FORGET of the first puts HERE and LATEST back where they were");
|
||||
CHECK(is(say(": G1 65 EMIT ; : G2 66 EMIT ;\n"), " ok\nok> ") && is(say("HERE FENCE ! : G3 67 EMIT ;\n"), " ok\nok> "), "two words, the fence, and a third");
|
||||
CHECK(is(say("FORGET G2\n"), "Protected word\n ERROR\nok> ") && is(say("G1 G2 G3\n"), "ABC ok\nok> "), "a word below the fence cannot be forgotten");
|
||||
CHECK(is(say("FORGET G3 G1 G2\n"), "AB ok\nok> ") && is(say("G3\n"), "UNKNOWN WORD: 'G3'\n ERROR\nok> "), "one above it can");
|
||||
}
|
||||
|
||||
/* ---- WORDS ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say(": ZEBRA ; : YAK ; : HALFWAY 1\n"), " ok\nok> "), "two words and a definition under way");
|
||||
{
|
||||
const char *w = say("[ WORDS ]\n");
|
||||
const char *p, *line = w;
|
||||
unsigned longest = 0, names = 0;
|
||||
CHECK(strncmp(w, "YAK ZEBRA ", 10) == 0, "WORDS starts with the newest; a definition under way is not shown");
|
||||
CHECK(strstr(w, " DUP ") && strstr(w, " WORDS ") && strstr(w, " : ") && strstr(w, " ABORT\" ") && strstr(w, "UM* "), "and goes back to the capsule's first word");
|
||||
CHECK(strlen(w) > 9 && strcmp(w + strlen(w) - 9, "\n ok\nok> ") == 0, "it ends with a new line");
|
||||
for (p = w; *p; p++) {
|
||||
if (*p == ' ') names++;
|
||||
if (*p == '\n') { if ((unsigned)(p - line) > longest) longest = (unsigned)(p - line); line = p + 1; }
|
||||
}
|
||||
printf(" WORDS: %u names, longest line %u columns\n", names - 1u, longest);
|
||||
CHECK(longest <= 64u + 32u && names > 200u, "lines are wrapped");
|
||||
CHECK(is(say(";\n"), " ok\nok> ") && strncmp(say("VLIST\n"), "HALFWAY YAK ZEBRA ", 18) == 0, "VLIST is the same word; a finished definition is shown");
|
||||
}
|
||||
|
||||
/* ---- a full dictionary ---- */
|
||||
boot_bare();
|
||||
n.mem[DP] = (DICT_END_W - 2) * 4;
|
||||
|
||||
Reference in New Issue
Block a user