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
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
a1afb44598
commit
8c540b0305
@@ -732,7 +732,7 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
| `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 | |
|
||||
| `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). |
|
||||
| `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`,
|
||||
`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
|
||||
words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine
|
||||
|
||||
@@ -124,6 +124,8 @@ header ABORT
|
||||
jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED)
|
||||
|
||||
\ ---- 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
|
||||
\ (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
|
||||
@@ -147,6 +149,7 @@ header ABORT
|
||||
\ 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
|
||||
\ that calls any other word.
|
||||
header (.") compile-only
|
||||
: (.")
|
||||
pop 4* dup C@ \ baddr n
|
||||
L: if DONE
|
||||
@@ -165,6 +168,7 @@ header ." immediate
|
||||
\ ( 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
|
||||
\ the string.
|
||||
header (ABORT") compile-only
|
||||
: (ABORT")
|
||||
if NO
|
||||
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
|
||||
\ call, and go on after it.
|
||||
header (S") compile-only
|
||||
: (S")
|
||||
pop 4* dup C@ \ baddr n
|
||||
over over + 4/ 1 + push \ the cell after the last character
|
||||
|
||||
@@ -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 ;
|
||||
@@ -1039,6 +1039,35 @@ int main(void)
|
||||
#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 ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");
|
||||
|
||||
Reference in New Issue
Block a user