admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
- 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
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_host_quit.c
+29
View File
@@ -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");