diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index b156200f..bd852f4d 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -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 diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index 38598b6f..356a2810 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -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 diff --git a/v4/capsule/tools.fth b/v4/capsule/tools.fth new file mode 100644 index 00000000..9578ef36 --- /dev/null +++ b/v4/capsule/tools.fth @@ -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 ; diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 18b6db67..ab396fa5 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -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");