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
@@ -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