feat(v4.0.0): the editor, redone in FORTH; COLD WARM PAGE VERSION DEFER
- capsule/editor.fth: the block editor as FORTH source, which the node compiles itself. It is a vocabulary, EDITOR, used at the ordinary prompt: n EDIT, then L N B T P E D S H R I WIPE DONE. v3's EDIT, a shell of its own, is not carried over (ruled 2026-10-05); v3's L S and SHOW are kept in FORTH as they were, with COPY. - system.v4: COLD (the system as the loader left it), WARM, PAGE, VERSION, 79-STANDARD (FORTH-79: silent), and DEFER IS DEFER@ as v3. - input.v4: where words are split at blanks a zero byte reads as a blank, so a block never written, or filled a line at a time, loads cleanly. - tests/test_host_quit.c: the editor's source fed to the prompt line by line, every command on empty and full screens, what reaches storage; the system words; deferred words. 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
c8dc14897c
commit
a1afb44598
@@ -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`, 9 `Shift count out of range`, 10 `Protected word`, 11 `Division by zero` (`Q./`), 12 `Argument out of range`, 13 `Block out of range`, 14 `No block is being loaded`; −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`, 11 `Division by zero` (`Q./`), 12 `Argument out of range`, 13 `Block out of range`, 14 `No block is being loaded`, 15 `Deferred word not set`; −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-19** | Block storage on the golden model (2026-10-05). | **Four memory-mapped registers on the host node, until the mesh carries the storage service.** `BLOCK-NUMBER`, `BLOCK-ADDRESS` (the word address of 256 cells), `BLOCK-COMMAND` (a store of 1 reads the block into those cells, 2 writes it from them) and `BLOCK-STATUS` (0 when the command worked, −1 for a block the device has not got or cells not all in memory). A block is 1024 bytes: 256 cells, four bytes to a cell, the first byte lowest, at either cell width. This is the console's arrangement (§7) applied to storage; like it, it is the model's stand-in and not the mesh protocol, which §5.11 still leaves to the device node. |
|
||||
|
||||
**Consequences of D-2 that every definition must respect.** The data stack holds 10 items and the
|
||||
@@ -671,7 +671,7 @@ The storage service belongs to the Artemis role, now a device node.
|
||||
| Word | Fate | Notes |
|
||||
| --- | --- | --- |
|
||||
| `BLOCK` `BUFFER` `UPDATE` `SAVE-BUFFERS` `EMPTY-BUFFERS` `FLUSH` | DEV | FORTH-79 (`FLUSH` is v3's, the same as `SAVE-BUFFERS`). Source in `v4/capsule/blocks.v4`, over the device of D-19. There are **two buffers**, so two blocks can be in memory at once; a buffer goes to the block that asks, turn about, and a block that was `UPDATE`d is written before its buffer is given away. `BLOCK` and `BUFFER` give a **byte address**, as `PAD` and `TIB` are — what `C@`, `CMOVE` and `TYPE` take. A block number below 1, or one the device has not got, is D-18's code 13, `Block out of range` (v3 says ` ERROR` alone). Executed on the golden model's host node (2026-10-05), including transcripts of the v3 binary, with the bytes on the device checked after each step. |
|
||||
| `LOAD` `THRU` `-->` `BLK` | CC | `LOAD` and `BLK` are FORTH-79; `THRU` and `-->` are v3's. Source in `v4/capsule/blocks.v4`. The text being interpreted is at the address in the variable `(SRC)`, `SPAN` characters long, `>IN` the place in it; `QUERY` makes that the terminal's buffer and `LOAD` a block's, all 1024 characters as one stream. `LOAD` saves `(SRC)`, `SPAN`, `>IN` and `BLK` on the return stack and puts them back, so a block may `LOAD` another and **the rest of the line `LOAD` was on is interpreted afterwards** (v3 drops it). `BLK` is the block being interpreted, 0 at the terminal; v3 has no `BLK`. A buffer can be given to another block between one word of the text and the next, so while a block is loading `WORD` first makes sure it is in a buffer (a hook `LOAD` installs). In a block `\` skips to the next 64-character line. `-->` at the terminal is code 14, `No block is being loaded`. An error while loading ends every `LOAD` under way and the terminal is the input again. Executed on the golden model's host node (2026-10-05), three blocks deep on two buffers, including transcripts of the v3 binary. |
|
||||
| `LOAD` `THRU` `-->` `BLK` | CC | `LOAD` and `BLK` are FORTH-79; `THRU` and `-->` are v3's. Source in `v4/capsule/blocks.v4`. The text being interpreted is at the address in the variable `(SRC)`, `SPAN` characters long, `>IN` the place in it; `QUERY` makes that the terminal's buffer and `LOAD` a block's, all 1024 characters as one stream. `LOAD` saves `(SRC)`, `SPAN`, `>IN` and `BLK` on the return stack and puts them back, so a block may `LOAD` another and **the rest of the line `LOAD` was on is interpreted afterwards** (v3 drops it). `BLK` is the block being interpreted, 0 at the terminal; v3 has no `BLK`. When words are split at blanks a zero byte reads as a blank, so a block that was never written, or whose lines were put there one at a time, loads cleanly. A buffer can be given to another block between one word of the text and the next, so while a block is loading `WORD` first makes sure it is in a buffer (a hook `LOAD` installs). In a block `\` skips to the next 64-character line. `-->` at the terminal is code 14, `No block is being loaded`. An error while loading ends every `LOAD` under way and the terminal is the input again. Executed on the golden model's host node (2026-10-05), three blocks deep on two buffers, including transcripts of the v3 binary. |
|
||||
| `LIST` | CAP | As v3: a new line, `Block n`, sixteen lines of 64 characters each after its two-digit number and a colon, and an empty line; a character that is not printable shows as a blank. Leaves `n` in `SCR`. Executed on the golden model's host node (2026-10-05) against a transcript of the v3 binary. |
|
||||
| `SCR` | CAP | Variable: the block `LIST` showed last. |
|
||||
| `BLK-CONFIRM-FORMAT` `RELOCATE-BLOCK` | DEV | Owner-only storage messages. |
|
||||
@@ -728,19 +728,19 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
| `QUIT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. Clears the return stack, sets execution mode, returns control to the terminal; no message. It is the prompt: after a new line it prints `ok> `, reads a line with `QUERY`, clears `NODE-ERROR`, runs `INTERPRET`, prints ` ok` — or, if `NODE-ERROR` is set, ends any definition that was open and prints ` ERROR` — and goes round again, for as long as the node runs. The text is v3's. The line is not sent back; the terminal shows what is typed. It empties the return stack first, by a store to `RSTACK-DEPTH` (D-16), so it works from however deep, with the return stack full. The data stack is left alone. A definition open when `QUIT` runs is ended and stays hidden. Executed on the golden model's host node (2026-10-04): the node is started at `QUIT`, fed characters and its output read, including 16 sessions recorded from the v3 binary. v3's `QUIT` goes on with the rest of the line and cannot be compiled into a definition. |
|
||||
| `ABORT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. As `QUIT`, and it empties the data stack too (a store to `DSTACK-DEPTH`, D-16); the line it stops ends with ` ok`, as v3. Executed on the golden model's host node (2026-10-04), from six calls down and from inside two loops, forty times over, including transcripts of the v3 binary. |
|
||||
| `ABORT"` `(ABORT")` | CC | Not FORTH-79 (it is FORTH-83's); kept because v3 has it. `ABORT" text"` `( flag -- )`: if the flag is not zero, print the text, start a new line and `ABORT`. Compiled as `."` is, with `(ABORT")` as the run-time word; it also works at the prompt. Executed on the golden model's host node (2026-10-04). v3's crashes (SIGSEGV) when a word compiled with it runs, and at the prompt prints the text and carries on with the line. |
|
||||
| `COLD` `WARM` | CC | |
|
||||
| `COLD` `WARM` | CC | Source in `v4/capsule/system.v4`. `WARM` prints v3's two lines and `ABORT`s: both stacks emptied, the dictionary kept. `COLD` first puts the system back as the loader left it — `DP` and the newest FORTH entry from the two cells `(BOOT)`, one vocabulary, decimal, empty block buffers, `FENCE` at the capsule's end — so everything defined since is gone. Executed on the golden model's host node (2026-10-05). |
|
||||
| `BYE` `REBOOT` | HERA | |
|
||||
| `SAVE-SYSTEM` | HERA | Snapshot becomes a capsule-image request. |
|
||||
| `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 | |
|
||||
| `PAGE` | DEV | As v3 on a terminal: `ESC [2J ESC [H`. Source in `v4/capsule/system.v4`; executed on the golden model's host node (2026-10-05). |
|
||||
| `79-STANDARD` | CC | FORTH-79: executes if a FORTH-79 system is there. It is, so nothing happens. v3's prints two lines and leaves a flag, which the standard does not have. |
|
||||
|
||||
### 5.16 Line editor
|
||||
|
||||
| Word | Fate |
|
||||
| --- | --- |
|
||||
| `L` `S` `SHOW` `EDIT` | CC |
|
||||
| `L` `S` `SHOW` `EDIT` and the `EDITOR` vocabulary | CC | **Redone for v4** (ruled 2026-10-05: v3's `EDIT`, a small shell of its own on stdin, is not the editor). The editor is FORTH source, `v4/capsule/editor.fth`, which the node compiles itself; it is a vocabulary, `EDITOR`, whose words are used at the ordinary prompt. `n EDIT` lists screen `n` and makes `EDITOR` the `CONTEXT` vocabulary. Then: `L` list the screen, `N` `B` the next and the one before, `n T` type a line, `n P text` put the rest of the input line on line `n`, `n E` erase, `n D` delete (the lines below move up; the line is held in `PAD`), `n S` spread (a blank line at `n`), `n H` hold, `n R` replace from `PAD`, `n I` insert `PAD`'s line, `WIPE` blank the screen, `DONE` write what changed and go back to FORTH. Every change is `UPDATE`d. In FORTH itself are v3's three as they were — `L ( n -- )` a line, `S ( baddr u n -- )` a line set from a string, `SHOW` the screen — and `COPY ( from to -- )`. A line outside 0–15 is `ABORT"`ed with `Line out of range`. Executed on the golden model's host node (2026-10-05): the source compiled line by line, every command, and what reaches storage. A screen editor, with a cursor, is not written. |
|
||||
|
||||
### 5.17 Defining words and the compiler
|
||||
|
||||
@@ -868,7 +868,7 @@ index should use them; they cost one instruction per iteration.
|
||||
| `ENTROPY@` `ENTROPY!` | MM | Per-call-target heat table (D-6). |
|
||||
| `WORD-ENTROPY` `RESET-ENTROPY` `TOP-WORDS` | CC | Reports over the heat registers. |
|
||||
| `(-` `INIT` | CC | |
|
||||
| `VERSION` | CC | |
|
||||
| `VERSION` | CC | Prints `StarForth v4.0.0 F18 32-bit` (or `64-bit`). Source in `v4/capsule/system.v4`. |
|
||||
| `SEED` `RANDOM` | CAP | Deterministic PRNG (xorshift) in capsule code, reproducible from the seed. |
|
||||
| `WAIT` | CAP | Loop until the `ANTICLOCK` register has advanced `n`. |
|
||||
| `HEARTBEAT-TICKS@` | MM | `HEARTBEAT` register. |
|
||||
@@ -970,7 +970,7 @@ The runtime governor moves into hardware as the multi-level Rolling Window of Tr
|
||||
|
||||
| Word | Fate | Notes |
|
||||
| --- | --- | --- |
|
||||
| `DEFER` `IS` `DEFER@` | CC | A deferred word's runtime is `@p push ;` followed by the stored xt. |
|
||||
| `DEFER` `IS` `DEFER@` | CC | As v3. `DEFER xxx` makes a data word whose run-time routine fetches the address in its parameter field and goes to it (`pop a! @ … push ;`), so the word it runs returns to `xxx`'s caller and a deferred word is no deeper than a plain one. `' yyy IS xxx` and `DEFER@ xxx` work at the prompt and in a definition. A deferred word with nothing set is D-18's code 15, `Deferred word not set`. Source in `v4/capsule/system.v4`; executed on the golden model's host node (2026-10-05), including transcripts of the v3 binary's behaviour. |
|
||||
|
||||
### 5.29 – 5.32 Framebuffer, keyboard, TrueType, scrollback
|
||||
|
||||
|
||||
@@ -17,6 +17,7 @@
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ 11 Division by zero (Q./) 12 Argument out of range
|
||||
\ 13 Block out of range 14 No block is being loaded
|
||||
\ 15 Deferred word not set
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
@@ -0,0 +1,68 @@
|
||||
\ editor.fth -- the block editor, in FORTH.
|
||||
\
|
||||
\ This file is FORTH source: the node compiles it itself, a line at a time,
|
||||
\ as if it were typed. No line is longer than 79 characters.
|
||||
\
|
||||
\ A block is a screen of 16 lines of 64 characters. SCR is the screen being
|
||||
\ edited. The editor is a vocabulary, EDITOR: its words are ordinary FORTH
|
||||
\ words used at the ordinary prompt, so everything else is there as well.
|
||||
\
|
||||
\ n EDIT edit screen n: list it and make EDITOR the CONTEXT vocabulary
|
||||
\ L list the screen N B the next, the one before
|
||||
\ n T type line n
|
||||
\ n P text put the rest of the input line on line n
|
||||
\ n E erase line n WIPE blank the whole screen
|
||||
\ n D delete line n; the lines below move up; it is held in PAD
|
||||
\ n S spread: a blank line at n; the lines from n move down
|
||||
\ n H hold line n in PAD n R replace line n from PAD
|
||||
\ n I insert PAD's line at n
|
||||
\ DONE write what has changed and go back to FORTH
|
||||
\ a b COPY copy screen a to screen b (in FORTH)
|
||||
\
|
||||
\ Every change is UPDATEd; nothing reaches storage until FLUSH or DONE, or
|
||||
\ until the buffer is wanted for another block.
|
||||
|
||||
FORTH DEFINITIONS
|
||||
|
||||
\ ( baddr -- ) 64 characters; a zero shows as a blank, others as a dot
|
||||
: (.LINE)
|
||||
64 0 DO DUP I + C@
|
||||
DUP 0= IF DROP 32 THEN DUP 32 < OVER 126 > OR IF DROP 46 THEN EMIT
|
||||
LOOP DROP ;
|
||||
\ ( n -- baddr ) where line n of screen SCR is
|
||||
: (LINE)
|
||||
DUP 0< OVER 15 > OR ABORT" Line out of range" 64 * SCR @ BLOCK + ;
|
||||
|
||||
\ v3's three: a line shown, a line set from a string, the screen shown
|
||||
: L ( n -- ) (LINE) (.LINE) CR ;
|
||||
: S ( baddr u n -- )
|
||||
(LINE) DUP 64 BLANK SWAP 0 MAX 64 MIN CMOVE UPDATE ;
|
||||
: SHOW ( -- )
|
||||
." Screen " SCR @ 0 .R ." :" CR
|
||||
16 0 DO I 2 .R ." : " I (LINE) (.LINE) CR LOOP ;
|
||||
|
||||
: COPY ( from to -- ) SWAP BLOCK SWAP BUFFER 1024 CMOVE UPDATE ;
|
||||
|
||||
VOCABULARY EDITOR EDITOR DEFINITIONS
|
||||
|
||||
: T ( n -- ) DUP (LINE) SWAP 2 .R ." : " (.LINE) CR ;
|
||||
: L ( -- ) SHOW ;
|
||||
: E ( n -- ) (LINE) 64 BLANK UPDATE ;
|
||||
: P ( n -- ) (LINE) DUP 64 BLANK 0 WORD COUNT 64 MIN ROT SWAP CMOVE UPDATE ;
|
||||
: H ( n -- ) (LINE) PAD 64 CMOVE ;
|
||||
: R ( n -- ) PAD SWAP (LINE) 64 CMOVE UPDATE ;
|
||||
: D ( n -- )
|
||||
DUP H DUP 15 < IF
|
||||
DUP 1+ (LINE) OVER (LINE) ROT 15 SWAP - 64 * CMOVE
|
||||
ELSE DROP THEN 15 E ;
|
||||
: S ( n -- )
|
||||
DUP 15 < IF DUP (LINE) OVER 1+ (LINE) 3 PICK 15 SWAP - 64 * CMOVE> THEN E ;
|
||||
: I ( n -- ) DUP S R ;
|
||||
: WIPE ( -- ) SCR @ BLOCK 1024 BLANK UPDATE ;
|
||||
: N ( -- ) 1 SCR +! L ;
|
||||
: B ( -- ) -1 SCR +! L ;
|
||||
: DONE ( -- ) FLUSH [COMPILE] FORTH ;
|
||||
|
||||
FORTH DEFINITIONS
|
||||
|
||||
: EDIT ( n -- ) DUP BLOCK DROP SCR ! EDITOR [ EDITOR ] L [ FORTH ] ;
|
||||
+9
-1
@@ -71,9 +71,17 @@ header QUERY
|
||||
\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside
|
||||
\ each other.)
|
||||
|
||||
\ ( -- c ) the character WORD is at. A zero reads as a blank when words
|
||||
\ are being split at blanks: a block that has never been written is all
|
||||
\ zeros, and so is the end of one whose lines were put there one at a time.
|
||||
: (SRC@)
|
||||
(P)+6 a! @ (SRC) a! @ + C@ if Z ;
|
||||
Z: drop (P) a! @ -32 + if B drop 0 ;
|
||||
B: drop 32 ;
|
||||
|
||||
\ In line, not called: WORD may have only a few return entries to spare.
|
||||
macro (LEFT) (P)+6 a! @ (P)+1 a! @ - endmacro \ ( -- d ) d < 0 while inside the text
|
||||
macro (CH) (P)+6 a! @ (SRC) a! @ + C@ (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (CH) (SRC@) (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (STEP) (P)+6 a! @ 1 + ! endmacro
|
||||
|
||||
\ ( c -- baddr ) FORTH-79: characters are taken from TIB until the
|
||||
|
||||
@@ -99,6 +99,7 @@ header ABORT
|
||||
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 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
||||
-1 + if M15
|
||||
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)
|
||||
@@ -114,6 +115,7 @@ header ABORT
|
||||
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
|
||||
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
|
||||
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
|
||||
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (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
|
||||
|
||||
@@ -7,6 +7,7 @@
|
||||
\ FENCE word address of the variable: FORGET will not remove an entry
|
||||
\ that starts below the address it holds
|
||||
\ VOC-LINK word address of the variable: the newest vocabulary, or 0
|
||||
\ (BOOT) word address of two cells: DP and (LATEST) as the loader left them
|
||||
|
||||
header FENCE inline : FENCE' FENCE ;
|
||||
|
||||
@@ -104,3 +105,64 @@ header FORGET
|
||||
C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop ;
|
||||
C3: drop (LATEST) CURRENT a! ! ;
|
||||
MISSING: drop (UNKNOWN) drop ;
|
||||
|
||||
\ ---- the system as a whole -------------------------------------------------------
|
||||
\ (BOOT) is two cells the loader fills when the capsule is in place: DP and
|
||||
\ the newest FORTH entry as they then are. COLD goes back to them.
|
||||
|
||||
\ FORTH-79: execute to be sure a FORTH-79 system is there. It is: nothing
|
||||
\ happens. (v3's prints two lines and leaves a flag.)
|
||||
header 79-STANDARD
|
||||
: 79-STANDARD ;
|
||||
|
||||
\ ( -- ) which system this is, and its cell width
|
||||
header VERSION
|
||||
: VERSION
|
||||
$72617453 (EMIT4) $74726F46 (EMIT4) $34762068 (EMIT4) $302E302E (EMIT4) $38314620 (EMIT4) $20 (EMIT4)
|
||||
N-1 1 + 0 U-DOT-R $7469622D (EMIT4) CR ;
|
||||
|
||||
\ ( -- ) clear the screen and put the cursor at the top, as v3: ESC [2J ESC [H
|
||||
header PAGE
|
||||
: PAGE 27 EMIT 91 EMIT 50 EMIT 74 EMIT 27 EMIT 91 EMIT 72 jump EMIT
|
||||
|
||||
\ ( -- ) as v3's message, and then ABORT: both stacks emptied, the prompt
|
||||
header WARM
|
||||
: WARM
|
||||
$54524F46 (EMIT4) $39372D48 (EMIT4) $72615720 (EMIT4) $7453206D (EMIT4) $747261 (EMIT4) CR
|
||||
$74737953 (EMIT4) $72206D65 (EMIT4) $61747365 (EMIT4) $64657472 (EMIT4) $2E (EMIT4) CR
|
||||
jump ABORT
|
||||
|
||||
\ ( -- ) the system as it was when the capsule had just been loaded:
|
||||
\ everything defined since is gone, there is one vocabulary, numbers are
|
||||
\ decimal, the block buffers are empty. Then as WARM.
|
||||
header COLD
|
||||
: COLD
|
||||
(BOOT) a! @ DP a! !
|
||||
(BOOT)+1 a! @ (LATEST) a! !
|
||||
(BOOT) a! @ 2/ 2/ FENCE a! !
|
||||
(LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! !
|
||||
10 BASE a! ! 0 SCR a! ! EMPTY-BUFFERS
|
||||
$54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR
|
||||
$74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR
|
||||
jump ABORT
|
||||
|
||||
\ ---- deferred words (as v3) -------------------------------------------------------
|
||||
\ DEFER xxx makes xxx, which does whatever word it has been given:
|
||||
\ ' yyy IS xxx gives it one; DEFER@ xxx leaves the one it has. A deferred
|
||||
\ word with none is an error (code 15, "Deferred word not set").
|
||||
: (DODEFER)
|
||||
pop a! @ if UNSET push ; \ go to it: it returns to xxx's caller
|
||||
UNSET: drop NODE-ERROR b! 15 !b ;
|
||||
header DEFER
|
||||
: DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ;
|
||||
: (is!) a! ! ;
|
||||
: (defer@) a! @ ;
|
||||
header IS immediate
|
||||
: IS
|
||||
(') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,)
|
||||
NOW: drop jump (is!)
|
||||
header DEFER@ immediate
|
||||
: DEFER@
|
||||
(') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,)
|
||||
NOW: drop jump (defer@)
|
||||
|
||||
|
||||
@@ -64,6 +64,7 @@
|
||||
#define SRC (BVARS + 8)
|
||||
#define SRC_HOOK (BVARS + 9)
|
||||
#define STORAGE_REG (BVARS + 10)
|
||||
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
|
||||
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
|
||||
#define BUF1_W (BUF0_W + 256)
|
||||
#define QVARS (BUF0_W - 4) /* (Q): quit.v4, system.v4 and blocks.v4, 4 cells */
|
||||
@@ -128,6 +129,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "(W)", WVARS);
|
||||
v4_text_constant(tx, "(X)", XVARS);
|
||||
v4_text_constant(tx, "(B)", BVARS);
|
||||
v4_text_constant(tx, "(BOOT)", BOOT_CELLS);
|
||||
v4_text_constant(tx, "SCR", SCR);
|
||||
v4_text_constant(tx, "BLK", BLK);
|
||||
v4_text_constant(tx, "(SRC)", SRC);
|
||||
|
||||
@@ -98,6 +98,8 @@ static void boot_with(unsigned depth)
|
||||
n.mem[CFP] = CFS_W;
|
||||
n.mem[BASE] = 10;
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
n.mem[BOOT_CELLS] = n.mem[DP];
|
||||
n.mem[BOOT_CELLS + 1] = capsule_latest;
|
||||
n.mem[FENCE] = DICT_W;
|
||||
n.mem[CONTEXT] = LATEST;
|
||||
n.mem[CURRENT] = LATEST;
|
||||
@@ -148,6 +150,36 @@ static const char *say(const char *input)
|
||||
out[n.console_len] = 0;
|
||||
return out;
|
||||
}
|
||||
/* Feed a file of FORTH source to the prompt, a line at a time, as if typed.
|
||||
* True if every line was accepted: the node said " ok" and nothing else. */
|
||||
static int load_source(const char *name)
|
||||
{
|
||||
char path[512], line[160];
|
||||
FILE *f;
|
||||
unsigned num = 0;
|
||||
snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, name);
|
||||
f = fopen(path, "r");
|
||||
if (!f) { printf(" cannot open %s\n", path); return 0; }
|
||||
while (fgets(line, sizeof line, f)) {
|
||||
size_t len = strlen(line);
|
||||
num++;
|
||||
if (len == 0 || line[len - 1] != '\n' || len > 80) { printf(" %s line %u: too long\n", name, num); fclose(f); return 0; }
|
||||
if (strcmp(say(line), " ok\nok> ") != 0) { printf(" %s line %u: %s", name, num, line); printf(" -> "); fputs(out, stdout); printf("\n"); fclose(f); return 0; }
|
||||
}
|
||||
fclose(f);
|
||||
return n.mem[STATE] == 0;
|
||||
}
|
||||
|
||||
/* What the editor's L prints for a screen of blanks. */
|
||||
static const char *blank_screen(int num)
|
||||
{
|
||||
static char text[2048];
|
||||
size_t at = (size_t)snprintf(text, sizeof text, "Screen %d:\n", num);
|
||||
for (unsigned k = 0; k < 16; k++) at += (size_t)snprintf(text + at, sizeof text - at, "%2u: %-64s\n", k, "");
|
||||
snprintf(text + at, sizeof text - at, " ok\nok> ");
|
||||
return text;
|
||||
}
|
||||
|
||||
static void show(const char *label, const char *s)
|
||||
{
|
||||
printf(" %s\"", label);
|
||||
@@ -932,6 +964,120 @@ int main(void)
|
||||
CHECK(strncmp(say("50 LIST\n"), "\nBlock 50\n00: \n01: ", 81) == 0 && n.mem[SCR] == 50,
|
||||
"a block of zeros lists as blanks, and SCR is the block listed");
|
||||
|
||||
/* ---- the editor: FORTH source, compiled by the node ---- */
|
||||
boot_bare();
|
||||
CHECK(load_source("editor.fth"), "editor.fth compiles, every line of it");
|
||||
CHECK(is(say("ORDER .S\n"), "Search order: FORTH \nCurrent: FORTH\n<0> \n ok\nok> "), "and leaves FORTH as it found it");
|
||||
{
|
||||
char want[2048], blank[65];
|
||||
size_t at;
|
||||
unsigned k;
|
||||
memset(blank, ' ', 64); blank[64] = 0;
|
||||
#define SCREEN(num, ...) do { static const char *const t_[] = { __VA_ARGS__ }; \
|
||||
at = (size_t)snprintf(want, sizeof want, "Screen %d:\n", num); \
|
||||
for (k = 0; k < 16; k++) at += (size_t)snprintf(want + at, sizeof want - at, "%2u: %-64s\n", k, k < sizeof t_ / sizeof t_[0] ? t_[k] : ""); \
|
||||
snprintf(want + at, sizeof want - at, " ok\nok> "); } while (0)
|
||||
SCREEN(9, "");
|
||||
CHECK(is(say("9 EDIT\n"), want), "EDIT lists the screen");
|
||||
CHECK(is(say("ORDER\n"), "Search order: EDITOR FORTH\nCurrent: FORTH\n ok\nok> ") && n.mem[SCR] == 9, "and the editor's words are now found first");
|
||||
CHECK(is(say("0 P first line\n"), " ok\nok> ") && is(say("1 P second, with blanks before it\n"), " ok\nok> ")
|
||||
&& is(say("3 P fourth\n"), " ok\nok> ") && is(say("15 P last\n"), " ok\nok> "), "P puts text on a line");
|
||||
SCREEN(9, "first line", " second, with blanks before it", "", "fourth", "", "", "", "", "", "", "", "", "", "", "", "last");
|
||||
CHECK(is(say("L\n"), want), "L lists it");
|
||||
CHECK(is(say("1 T 2 T\n"), " 1: second, with blanks before it \n 2: \n ok\nok> "), "T types a line");
|
||||
CHECK(is(say("2 S\n"), " ok\nok> ") && is(say("2 P put in the gap\n"), " ok\nok> "), "S spreads");
|
||||
SCREEN(9, "first line", " second, with blanks before it", "put in the gap", "", "fourth", "", "", "", "", "", "", "", "", "", "", "");
|
||||
CHECK(is(say("L\n"), want), "the lines below move down and the last is lost");
|
||||
CHECK(is(say("1 D\n"), " ok\nok> "), "D deletes");
|
||||
SCREEN(9, "first line", "put in the gap", "", "fourth");
|
||||
CHECK(is(say("L\n"), want), "the lines below move up");
|
||||
CHECK(is(say("5 I 0 H 7 R 2 E\n"), " ok\nok> "), "I inserts the deleted line; H and R copy one; E erases one");
|
||||
SCREEN(9, "first line", "put in the gap", "", "fourth", "", " second, with blanks before it", "", "first line");
|
||||
CHECK(is(say("L\n"), want), "as it should be");
|
||||
CHECK(is(say("0 D 0 D 0 D 0 D 0 D 15 S 15 D 0 S 0 D\n"), " ok\nok> "), "at the ends");
|
||||
SCREEN(9, " second, with blanks before it", "", "first line");
|
||||
CHECK(is(say("L\n"), want), "nothing is disturbed");
|
||||
CHECK(disk[9 * V4_BLOCK_BYTES] == 0, "nothing has reached storage yet");
|
||||
CHECK(is(say("16 T\n"), "Line out of range\n ok\nok> ") && is(say("-1 E\n"), "Line out of range\n ok\nok> ") && is(say("16 P x\n"), "Line out of range\n ok\nok> "),
|
||||
"a line that is not there");
|
||||
CHECK(is(say("9 EDIT\n"), want), "(ABORT left FORTH as CONTEXT; EDIT again)");
|
||||
CHECK(is(say("DONE ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && memcmp(disk + 9 * V4_BLOCK_BYTES, " second, with blanks", 21) == 0
|
||||
&& disk[9 * V4_BLOCK_BYTES + 128] == 'f' && disk[9 * V4_BLOCK_BYTES + 1023] == ' ', "DONE writes the screen and goes back to FORTH");
|
||||
/* text typed into a screen is a programme */
|
||||
CHECK(is(say("20 EDIT\n"), blank_screen(20)) && is(say("0 P : HELLO .\" Hello from a block\" ;\n"), " ok\nok> ")
|
||||
&& is(say("1 P HELLO \\ and say it\n"), " ok\nok> ") && is(say("2 P 3 4 + .\n"), " ok\nok> ") && is(say("DONE 20 LOAD\n"), "Hello from a block7 ok\nok> "),
|
||||
"a screen that has been edited can be loaded");
|
||||
CHECK(is(say("9 21 COPY 21 LIST\n"), out) && strstr(out, "Block 21\n00: second, with blanks before it") && strstr(out, "02: first line "), "COPY copies a screen");
|
||||
CHECK(is(say("FLUSH\n"), " ok\nok> ") && memcmp(disk + 21 * V4_BLOCK_BYTES, disk + 9 * V4_BLOCK_BYTES, V4_BLOCK_BYTES) == 0, "and the copy reaches storage");
|
||||
/* each change on its own reaches storage */
|
||||
CHECK(is(say("30 EDIT\n"), blank_screen(30)) && is(say("0 P only this\n"), " ok\nok> ") && is(say("DONE\n"), " ok\nok> ")
|
||||
&& memcmp(disk + 30 * V4_BLOCK_BYTES, "only this ", 10) == 0, "P alone is written");
|
||||
CHECK(is(say("30 EDIT\n"), out) && is(say("0 E DONE\n"), " ok\nok> ") && disk[30 * V4_BLOCK_BYTES] == ' ', "E alone is written");
|
||||
/* D and I with every line in use */
|
||||
CHECK(is(say("31 EDIT\n"), blank_screen(31)), "another screen");
|
||||
for (k = 0; k < 16; k++) {
|
||||
char line[32];
|
||||
snprintf(line, sizeof line, "%u P line %c\n", k, 'A' + k);
|
||||
CHECK(is(say(line), " ok\nok> "), "line %u", k);
|
||||
}
|
||||
CHECK(is(say("3 D\n"), " ok\nok> "), "delete line 3 of a full screen");
|
||||
SCREEN(31, "line A", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P", "");
|
||||
CHECK(is(say("L\n"), want), "every line below moved up, the last is blank");
|
||||
CHECK(is(say("1 I\n"), " ok\nok> "), "insert the deleted line at 1");
|
||||
SCREEN(31, "line A", "line D", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P");
|
||||
CHECK(is(say("L DONE\n"), want), "every line from 1 moved down");
|
||||
CHECK(is(say("21 EDIT\n"), out) && is(say("WIPE N\n"), blank_screen(22)) && is(say("B\n"), blank_screen(21)), "WIPE blanks it; N and B move to the next and back");
|
||||
CHECK(is(say("99 EDIT\n"), "Block out of range\n ERROR\nok> ") && n.mem[SCR] == 21, "EDIT of a block that is not there");
|
||||
/* v3's three, in FORTH */
|
||||
CHECK(is(say("FORTH 9 SCR ! 0 L 3 L\n"), " second, with blanks before it \n \n ok\nok> "),
|
||||
"FORTH's L shows a line, as v3's");
|
||||
CHECK(is(say("S\" a much longer line than hello\" 3 S\n"), " ok\nok> ")
|
||||
&& is(say("S\" hello world\" 3 S 3 L\n"), "hello world \n ok\nok> "), "and S sets one from a string, blanks after it");
|
||||
SCREEN(9, " second, with blanks before it", "", "first line", "hello world");
|
||||
CHECK(is(say("SHOW\n"), want), "and SHOW shows the screen");
|
||||
CHECK(is(say("7 PAD 3 16 S\n"), "Line out of range\n ok\nok> "), "a line out of range");
|
||||
#undef SCREEN
|
||||
}
|
||||
|
||||
/* ---- the small system words ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");
|
||||
{
|
||||
char want[64];
|
||||
snprintf(want, sizeof want, "StarForth v4.0.0 F18 %d-bit\n ok\nok> ", V4_CELL_BITS);
|
||||
CHECK(is(say("VERSION\n"), want), "VERSION");
|
||||
}
|
||||
CHECK(is(say("65 EMIT PAGE 66 EMIT\n"), "A\x1b[2J\x1b[HB ok\nok> "), "PAGE, as v3");
|
||||
CHECK(is(say(": KEEPME 1 ; 1 2 3 WARM 65 EMIT\n.S KEEPME .\n"), "FORTH-79 Warm Start\nSystem restarted.\n ok\nok> <0> \n1 ok\nok> "), "WARM empties the stacks and keeps the dictionary");
|
||||
{
|
||||
v4_cell dp = n.mem[BOOT_CELLS];
|
||||
CHECK(is(say("VOCABULARY VV VV DEFINITIONS : INVV 1 ; HEX 20 BLOCK DROP UPDATE 5 SCR !\n"), " ok\nok> "), "a vocabulary, a base, a block, a screen");
|
||||
CHECK(is(say("1 2 COLD 65 EMIT\n"), "FORTH-79 Cold Start\nSystem initialized.\n ok\nok> "), "COLD says so");
|
||||
CHECK(n.mem[DP] == dp && n.mem[LATEST] == capsule_latest && n.mem[CONTEXT] == LATEST && n.mem[CURRENT] == LATEST && n.mem[VOC_LINK] == 0
|
||||
&& n.mem[BASE] == 10 && n.mem[SCR] == 0 && n.mem[BVARS] == 0 && n.mem[FENCE] == dp / 4, "and everything is as the loader left it");
|
||||
CHECK(is(say("KEEPME\n"), "UNKNOWN WORD: 'KEEPME'\n ERROR\nok> ") && is(say("VV\n"), "UNKNOWN WORD: 'VV'\n ERROR\nok> ")
|
||||
&& is(say(".S : NEW 16 . ; NEW\n"), "<0> \n16 ok\nok> "), "what was defined is gone, and the system works");
|
||||
}
|
||||
/* deferred words */
|
||||
boot_bare();
|
||||
CHECK(is(say("DEFER FOO : BAR 65 EMIT ; ' BAR IS FOO FOO\n"), "A ok\nok> "), "a deferred word does what it is given");
|
||||
CHECK(is(say("DEFER@ FOO ' BAR = .\n"), "-1 ok\nok> "), "DEFER@ leaves it");
|
||||
CHECK(is(say(": BAZ 66 EMIT ; : U FOO FOO ; U ' BAZ IS FOO U\n"), "AABB ok\nok> "), "a word that uses it follows the change");
|
||||
CHECK(is(say(": SETB ['] BAR IS FOO ; : GET DEFER@ FOO ; SETB FOO GET ' BAR = .\n"), "A-1 ok\nok> "), "IS and DEFER@ in a definition");
|
||||
CHECK(is(say("7 DEFER QUX QUX 65 EMIT\n.S\n"), "Deferred word not set\n ERROR\nok> <1> 7 \n ok\nok> "), "a deferred word with nothing set");
|
||||
CHECK(is(say(": D3 1 2 3 ; ' D3 IS QUX QUX + + .\n"), "6 ok\nok> ") && is(say("DEFER\n"), "Name missing\n ERROR\nok> ") && is(say("' BAR IS NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> "),
|
||||
"its stack effect is the word's; and the errors");
|
||||
{
|
||||
/* a deferred word is no deeper than the word it runs */
|
||||
char line[64];
|
||||
CHECK(is(say("VARIABLE V VARIABLE C DEFER RR\n"), " ok\nok> ")
|
||||
&& is(say(": R1 C @ 1- DUP C ! IF RR EXIT THEN 65 EMIT ; ' R1 IS RR\n"), " ok\nok> "), "a word that runs itself through a deferred word");
|
||||
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 4u));
|
||||
CHECK(is(say(line), "A ok\nok> "), "each level takes one return entry, as a plain call does");
|
||||
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)V4_RET_DEPTH);
|
||||
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "and too many is an overflow, as for any word");
|
||||
}
|
||||
|
||||
/* ---- vocabularies (FORTH-79) ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say("CONTEXT @ CURRENT @ = . ORDER\n"), "-1 Search order: FORTH \nCurrent: FORTH\n ok\nok> "), "at switch-on there is FORTH");
|
||||
|
||||
Reference in New Issue
Block a user