feat(v4.0.0): SEE, a disassembler written in FORTH

- capsule/tools.fth: SEE as FORTH source the node compiles itself.  v4
  code is native, so it shows each instruction word of a definition: the
  opcodes by name, literals' values, the names of the words called or
  jumped to, and text compiled by ." S" and ABORT" as text.  A data word
  shows what it holds; an immediate word says so.
- quit.v4: the three string run-time words get names, compile-only, so
  that SEE can tell text from code.
- tests/test_host_quit.c: definitions with literals, text, IF and loops;
  the capsule's own words; SEE shown by SEE.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-05 10:53:22 -04:00
co-authored by Claude Opus 5.5
parent a1afb44598
commit 8c540b0305
4 changed files with 117 additions and 2 deletions
+2 -2
View File
@@ -732,7 +732,7 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
| `BYE` `REBOOT` | HERA | | | `BYE` `REBOOT` | HERA | |
| `SAVE-SYSTEM` | HERA | Snapshot becomes a capsule-image request. | | `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). | | `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 | | | `SEE` | CC | FORTH source, `v4/capsule/tools.fth`, compiled by the node. v4 code is native, so `SEE xxx` is a disassembler: the name, then each instruction word on a line — the opcodes by name, a literal's value after its `@p`, and after a call or a branch the name of the word it goes to, or the address if that is not a word. Text compiled by `."`, `S"` or `ABORT"` is shown in quotes after its call (the three run-time words `(.")` `(S")` `(ABORT")` have names for this, and are compile-only). Padding is not shown. It stops at the first `;`, `ex` or `jump` that no earlier branch goes past. A data word shows what it holds; an immediate word says so. v3's `SEE` lists the words of threaded code, which v4 has not got. Executed on the golden model's host node (2026-10-05), on definitions with literals, text, `IF` and loops, on the capsule's own words, and on itself. |
| `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). | | `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. | | `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. |
@@ -760,7 +760,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`, `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). `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`), `system.v4` (vocabularies, `WORDS`, `FORGET`), `blocks.v4` (mass storage and `LOAD`), `qmath.v4` (the Q48.16 words of §5.26: `Q.FROM-INT Q.TO-INT Q.1 Q.0 Q.SCALE Q.+ Q.- Q.* Q./ Q.ABS Q.NEG Q.= Q.< Q.> Q.0= Q.MAX Q.MIN Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS Q.PRINT`; `DUMP` is in `numout.v4`) 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. From the prompt, 122 results of the Q words printed by `Q.PRINT` — which shows all sixteen bits of a fraction — are digit for digit v3's, at both cell widths. Under D-18, `Q./` by zero and `Q.SQRT` and `Q.LOG` outside their domain leave the result D-11 and D-12 give and then raise an error (codes 11 `Division by zero` and 12 `Argument out of range`); v3 returns 0 and says nothing. 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` (vocabularies, `WORDS`, `FORGET`, `COLD`, `DEFER`), then the two files of FORTH source the node compiles itself, `editor.fth` and `tools.fth` (`SEE`); `blocks.v4` (mass storage and `LOAD`), `qmath.v4` (the Q48.16 words of §5.26: `Q.FROM-INT Q.TO-INT Q.1 Q.0 Q.SCALE Q.+ Q.- Q.* Q./ Q.ABS Q.NEG Q.= Q.< Q.> Q.0= Q.MAX Q.MIN Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS Q.PRINT`; `DUMP` is in `numout.v4`) 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. From the prompt, 122 results of the Q words printed by `Q.PRINT` — which shows all sixteen bits of a fraction — are digit for digit v3's, at both cell widths. Under D-18, `Q./` by zero and `Q.SQRT` and `Q.LOG` outside their domain leave the result D-11 and D-12 give and then raise an error (codes 11 `Division by zero` and 12 `Argument out of range`); v3 returns 0 and says nothing. 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 **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 words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine
+5
View File
@@ -124,6 +124,8 @@ header ABORT
jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED) jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED)
\ ---- text in the source --------------------------------------------------------- \ ---- text in the source ---------------------------------------------------------
\ The three run-time words have names, as v3's have, so that SEE can tell a
\ string in a definition from code; they cannot be used from the prompt.
\ ." and ABORT" take the text up to the next " , which may be none at all \ ." and ABORT" take the text up to the next " , which may be none at all
\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay \ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay
\ down a call to their run-time word and, after it, the text as a counted \ down a call to their run-time word and, after it, the text as a counted
@@ -147,6 +149,7 @@ header ABORT
\ It takes the return address off before it calls anything and keeps the \ It takes the return address off before it calls anything and keeps the
\ count there instead, so a word that prints text goes no deeper than one \ count there instead, so a word that prints text goes no deeper than one
\ that calls any other word. \ that calls any other word.
header (.") compile-only
: (.") : (.")
pop 4* dup C@ \ baddr n pop 4* dup C@ \ baddr n
L: if DONE L: if DONE
@@ -165,6 +168,7 @@ header ." immediate
\ ( flag -- ) the run time of ABORT" : if the flag is not zero print the \ ( flag -- ) the run time of ABORT" : if the flag is not zero print the
\ string after the call, start a new line and ABORT; otherwise go on after \ string after the call, start a new line and ABORT; otherwise go on after
\ the string. \ the string.
header (ABORT") compile-only
: (ABORT") : (ABORT")
if NO if NO
drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT
@@ -183,6 +187,7 @@ header ABORT" immediate
\ The run time of S" : leave the address and length of the string after the \ The run time of S" : leave the address and length of the string after the
\ call, and go on after it. \ call, and go on after it.
header (S") compile-only
: (S") : (S")
pop 4* dup C@ \ baddr n pop 4* dup C@ \ baddr n
over over + 4/ 1 + push \ the cell after the last character over over + 4/ 1 + push \ the cell after the last character
+81
View File
@@ -0,0 +1,81 @@
\ tools.fth -- SEE, in FORTH.
\
\ This file is FORTH source, compiled by the node a line at a time; no line
\ is longer than 79 characters.
\
\ v4 code is native: a definition is instruction words, six five-bit opcodes
\ to a word, so SEE is a disassembler. It prints the name, then each
\ instruction word on a line: the opcodes by name, a literal's value after
\ its @p, and after a call or a branch the name of the word it goes to, or
\ the address if that is not a word. Text compiled by ." S" or ABORT" is
\ shown in quotes after the call it follows. Padding (nop) is not shown.
\ It stops at the first ; ex or jump that no earlier branch goes past.
FORTH DEFINITIONS
\ the opcode names, five characters each, in the order of their numbers
: (OPS1) S" ; ex jump call unextnext if -if @p @+ @b @ " ;
: (OPS2) S" !p !+ !b ! +* 2* 2/ inv + and xor drop " ;
: (OPS3) S" dup pop over a nop push b! a! " ;
: (.OP) ( op -- )
DUP 12 < IF (OPS1) ELSE DUP 24 < IF 12 - (OPS2) ELSE 24 - (OPS3) THEN THEN
DROP SWAP 5 * + 5 -TRAILING TYPE ;
VARIABLE (SP) \ the address after the instruction word being shown
VARIABLE (SW) \ that word
VARIABLE (SK) \ the slot
VARIABLE (SOP) \ the opcode last shown
VARIABLE (SLITS) \ how many literals the word has had so far
VARIABLE (SEND) \ the furthest a branch has gone forward
VARIABLE (SN) \ how many lines
\ ( -- xt ) the newest word of FORTH
: (HEAD) CONTEXT @ >R [COMPILE] FORTH CONTEXT @ @ R> CONTEXT ! ;
\ ( addr xt -- baddr | 0 ) the name of the word at addr, in the list from xt
: (IN-LIST)
BEGIN DUP WHILE 2DUP = IF SWAP DROP >NAME EXIT THEN >LINK @ REPEAT
SWAP DROP ;
\ ( addr -- ) its name if it is a word, else the number
: (.ADDR)
DUP CONTEXT @ @ (IN-LIST) ?DUP 0= IF DUP (HEAD) (IN-LIST) THEN
?DUP IF COUNT 31 AND TYPE DROP ELSE 0 .R THEN ;
\ ( -- addr ) where the branch in this slot goes
: (TARGET)
1 27 (SK) @ 5 * - LSHIFT 1-
DUP INVERT (SP) @ AND SWAP (SW) @ AND OR ;
\ ( addr -- ) after a call to addr: if it is one of the words that are
\ followed by text, show the text and count its cells with the literals
: (TEXT?)
DUP ['] (.") = OVER ['] (ABORT") = OR SWAP ['] (S") = OR IF
(SP) @ (SLITS) @ + 4 * COUNT 34 EMIT 2DUP TYPE 34 EMIT SPACE
SWAP DROP 4 + 4 / (SLITS) +!
THEN ;
\ ( -- flag ) show this slot; true if the instruction word ends with it
: (SLOT)
(SW) @ 27 (SK) @ 5 * - RSHIFT 31 AND
DUP 28 = IF DROP 0 EXIT THEN
DUP (SOP) ! DUP (.OP) SPACE
DUP 8 = IF (SP) @ (SLITS) @ + @ . 1 (SLITS) +! THEN
DUP 2 = OVER 3 = OR OVER 5 = OR OVER 6 = OR OVER 7 = OR IF
(TARGET) DUP (.ADDR) SPACE
SWAP 3 = IF (TEXT?) ELSE (SEND) @ MAX (SEND) ! THEN
-1 EXIT
THEN
2 < ;
: (SEE-LINE) ( -- )
(SP) @ @ (SW) ! 1 (SP) +! 0 (SLITS) ! 0 (SK) ! 28 (SOP) !
2 SPACES
BEGIN (SLOT) IF -1 ELSE 1 (SK) +! (SK) @ 6 = THEN UNTIL
CR (SLITS) @ (SP) +! ;
: (SEE-CODE) ( xt -- )
DUP (SP) ! (SEND) ! 0 (SN) !
BEGIN (SEE-LINE) 1 (SN) +!
(SOP) @ 3 < (SP) @ (SEND) @ > AND (SN) @ 63 > OR
UNTIL ;
\ SEE xxx show the word xxx
: SEE
FIND DUP 0= ABORT" SEE: not found"
." : " DUP >NAME COUNT 31 AND TYPE CR
DUP 3 - @ 4 AND IF ." data: " DUP 1+ @ . CR ELSE DUP (SEE-CODE) THEN
3 - @ 1 AND IF ." IMMEDIATE" CR THEN ;
+29
View File
@@ -1039,6 +1039,35 @@ int main(void)
#undef SCREEN #undef SCREEN
} }
/* ---- 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("SEE DUP\n"), ": DUP\n dup ; \n ok\nok> ") && is(say("SEE EMIT\n"), out) && strncmp(out, ": EMIT\n @p ", 12) == 0 && strstr(out, " b! !b ; \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(": 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
&& 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
&& 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");
CHECK(is(say("SEE *\n"), out) && strstr(out, " +* unext drop drop a ; \n"), "the longest opcode name, in the capsule's multiply");
CHECK(is(say("SEE NOSUCH\n"), "SEE: not found\n ok\nok> ") && is(say("SEE\n"), "SEE: not found\n ok\nok> "), "a word that is not there");
CHECK(is(say("(.\")\n"), "(.\"): compile-only\n ERROR\nok> ") && is(say("(S\")\n"), "(S\"): compile-only\n ERROR\nok> "), "the string run-time words have names but cannot be run from the prompt");
/* ---- the small system words ---- */ /* ---- the small system words ---- */
boot_bare(); boot_bare();
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing"); CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");