LithosAnanake/v4/tests/test_host_quit.c

/* test_host_quit.c -- the prompt, executed on the host node.
 *
 * capsule/quit.v4 on top of the earlier layers: QUIT, ABORT, ABORT" and ." .
 * For the first time the node is not handed a line: it is started at QUIT and
 * left running, characters are fed to its console, and what it prints is
 * read back.  Nothing here calls INTERPRET or pokes TIB.
 *
 * A session is some lines of input and everything the node printed until it
 * was waiting for more.  The sessions marked v3 were piped through the v3
 * binary on 2026-10-04 and the text is what v3 printed, less its colours and
 * the time stamp and "ERROR: " its log puts before a message.
 *
 * Where v4 parts from v3 here:
 *   - QUIT is FORTH-79's: it stops the line, from inside any word, and says
 *     nothing.  v3's goes on with the rest of the line, and cannot be
 *     compiled into a definition at all.
 *   - a line that fails while a definition is open ends the definition.
 *     v3 goes on compiling the lines that follow into it.
 *   - ABORT" at the prompt stops the line when its flag is true.  v3 prints
 *     the text and carries on.  Compiled into a word, v3's crashes (SIGSEGV).
 *   - control words that do not match give ERROR alone; v3 names the word.
 *   - QUERY takes 80 characters (FORTH-79); v3's line is 255.
 */
#include "v4/text.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
#include <string.h>

static int failures = 0, checks = 0;
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)

#define CANARY ((v4_cell)0x0C0FFEE5)

#include "host_map.h"

static v4_node       n;
static v4_exec_state es;
static v4_heat       h;
static v4_text       tx;
static v4_cell       w_quit, w_key, w_key_end, capsule_latest;
static char          out[V4_CONSOLE_CAP + 1];
static long          last_steps;

/* Run until the node has taken all its input and has been inside KEY, waiting,
 * for 64 instruction words; or until `max` words.  True if it is waiting. */
static int run_until_waiting(long max)
{
    long steps = 0;
    unsigned idle = 0;
    while (steps < max && idle < 64) {
        (void)v4_exec_step_word(&n, &es, &h);
        steps++;
        if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
    }
    last_steps = steps;
    return idle >= 64;
}

/* A node just switched on: an empty dictionary above the capsule's words,
 * `depth` marked cells and the canary on the data stack, started at QUIT. */
static void boot_with(unsigned depth)
{
    unsigned i;
    for (v4_cell k = DICT_W; k < DICT_END_W; k++) n.mem[k] = 0;
    n.mem[DP] = DICT_W * 4;
    n.mem[LATEST] = capsule_latest;
    n.mem[STATE] = 0;
    n.mem[CFP] = CFS_W;
    n.mem[BASE] = 10;
    n.mem[NODE_ERROR] = 0;
    v4_node_console_attach(&n, CONSOLE_TX);
    v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
    v4_dstack_reset(&n.ds);
    v4_rstack_reset(&n.rs);
    v4_exec_reset(&es);
    v4_heat_reset(&h);
    for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
    v4_dstack_push(&n.ds, CANARY);
    n.p = w_quit;
    (void)run_until_waiting(100000);
}
static void boot(void) { boot_with(0); }

/* While the node waits for a character, EXPECT's own cells are on top of the
 * data stack.  Pop them: true if the canary is under no more than four. */
static int canary_under_expect(void)
{
    unsigned k;
    for (k = 0; k < 5; k++) if (v4_dstack_pop(&n.ds) == CANARY) return 1;
    return 0;
}

/* Feed `input` and return what the node prints until it waits again. */
static const char *say(const char *input)
{
    unsigned len = (unsigned)strlen(input);
    v4_node_console_attach(&n, CONSOLE_TX);            /* empties the capture */
    if (v4_node_console_feed(&n, input, len) != len) return "(input queue full)";
    if (!run_until_waiting(40000000)) return "(still running)";
    if (n.console_dropped) return "(too much output)";
    memcpy(out, n.console, n.console_len);
    out[n.console_len] = 0;
    return out;
}
/* A whole session from switch-on. */
static const char *session(const char *input)
{
    boot();
    return say(input);
}
static void show(const char *label, const char *s)
{
    printf("    %s\"", label);
    for (; *s; s++) if (*s == '\n') printf("\\n"); else putchar(*s);
    printf("\"\n");
}
static int is(const char *got, const char *want)
{
    if (strcmp(got, want) == 0) return 1;
    show("got:    ", got);
    show("wanted: ", want);
    return 0;
}

/* What v3 prints starts with its first prompt; the node's first prompt is
 * printed at switch-on, before the input, so a v4 session lacks the leading
 * "ok> " and is otherwise the same. */
typedef struct { const char *in, *want; int v3; } transcript;
static const transcript script[] = {
    { "65 EMIT\n",                              "A ok\nok> ", 1 },
    { "\n   \n",                                " ok\nok>  ok\nok> ", 1 },
    { ": HI .\" Hello\" ; HI\n",                "Hello ok\nok> ", 1 },
    { "NOSUCH\n66 EMIT\n",                      "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> B ok\nok> ", 1 },
    { "1 2 NOSUCH 3 4\n+ 48 + EMIT\n",          "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
    { ": T 67 EMIT ABORT 68 EMIT ; T 70 EMIT\n69 EMIT\n", "C ok\nok> E ok\nok> ", 1 },
    { ": M 70 EMIT\n71 EMIT ;\nM\n",            " ok\nok>  ok\nok> FG ok\nok> ", 1 },
    { "IF\n72 EMIT\n",                          "IF: compile-only\n ERROR\nok> H ok\nok> ", 1 },
    { ".\" hi there\"\n",                       "hi there ok\nok> ", 1 },
    { "1 2 3\n+ + 48 + EMIT\n",                 " ok\nok> 6 ok\nok> ", 1 },
    { ": T .\" A\" .\" B\" CR .\" C\" ; T\n",   "AB\nC ok\nok> ", 1 },
    { ": T1 ABORT ; : T2 T1 66 EMIT ; : T3 65 EMIT T2 67 EMIT ; T3\n68 EMIT\n", "A ok\nok> D ok\nok> ", 1 },
    { "0 ABORT\" not\" 65 EMIT\n",              "A ok\nok> ", 1 },
    { ": P .\"  two  spaces \" 124 EMIT ; P\n", " two  spaces | ok\nok> ", 1 },
    { "65 EMIT CR 66 EMIT\n",                   "A\nB ok\nok> ", 1 },
    { ": E .\" \" 65 EMIT ; E\n",               "A ok\nok> ", 1 },
    /* v4's own */
    { ": BAD 1 NOSUCH 2 ;\nBAD\n65 EMIT\n",     "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'BAD'\n ERROR\nok> A ok\nok> ", 0 },
    { "1 ABORT\" now\" 65 EMIT\n66 EMIT\n",     "now\n ok\nok> B ok\nok> ", 0 },
    { ": B1 IF LOOP ;\n65 EMIT\n",              " ERROR\nok> A ok\nok> ", 0 },
    { ": A2 0 ABORT\" boom\" 67 EMIT ; A2\n",   "C ok\nok> ", 0 },
    { ": A1 ABORT\" boom\" 65 EMIT ; 1 A1 66 EMIT\n0 A1\n", "boom\n ok\nok> A ok\nok> ", 0 },
    { "1 2 3 QUIT 68 EMIT\n+ + 48 + EMIT\n",    "\nok> 6 ok\nok> ", 0 },
    { ": Q1 QUIT ; : Q2 65 EMIT Q1 66 EMIT ; : Q3 Q2 67 EMIT ; Q3 68 EMIT\n69 EMIT\n", "A\nok> E ok\nok> ", 0 },
    { ": HALF 1 2 [ QUIT\n65 EMIT\nHALF\n",     "\nok> A ok\nok> UNKNOWN WORD: 'HALF'\n ERROR\nok> ", 0 },
    { ": HALF 1 2 [ ABORT\n65 EMIT\n",          " ok\nok> A ok\nok> ", 0 },
    { "PAD PAD -1 CMOVE 65 EMIT\n66 EMIT\n",    "A ERROR\nok> B ok\nok> ", 0 },
    { ".\" no closing quote\n65 EMIT\n",        "no closing quote ok\nok> A ok\nok> ", 0 },
    { ".\" \"\n",                               " ok\nok> ", 0 },
    { ": T ABORT\" \" ; 1 T\n",                 "\n ok\nok> ", 0 },
    { "5 >R\n;\n",                              ">R: compile-only\n ERROR\nok> ;: compile-only\n ERROR\nok> ", 0 },
    { "16 BASE ! FF 2/ 2/ EMIT\n",              "? ok\nok> ", 0 },
};
#define NSCRIPT (sizeof script / sizeof script[0])

int main(void)
{
    unsigned i;

    printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);

    {
        static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "forth.v4", "quit.v4" };
        CHECK(host_load(&tx, &n, files, 7), "the capsule assembles");
    }
    CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
    CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
    printf("  capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
    if (failures) { printf("  %d checks, %d failures\n", checks, failures); return 1; }
    w_quit = v4_text_word(&tx, "QUIT");
    w_key = v4_text_word(&tx, "KEY");
    w_key_end = v4_text_word(&tx, "CR");               /* the word after KEY in core.v4 */
    capsule_latest = v4_text_latest(&tx);
    CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR");

    /* ---- switch-on ---- */
    boot();
    CHECK(n.console_len == 5 && memcmp(n.console, "\nok> ", 5) == 0, "QUIT starts a new line and prompts");
    CHECK(n.input_pos == n.input_len, "then waits for a line");
    CHECK(run_until_waiting(5000) && last_steps == 64 && n.console_len == 5, "and goes on waiting, printing nothing");
    CHECK(canary_under_expect(), "with the data stack as it found it");

    /* ---- the sessions ---- */
    for (i = 0; i < NSCRIPT; i++) {
        const transcript *t = &script[i];
        CHECK(is(session(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
        CHECK(n.mem[STATE] == 0, "session %u ends interpreting", i);
    }

    /* ---- one line at a time: the node keeps its state between them ---- */
    boot();
    CHECK(is(say("VARIABLE V  7 V !\n"), " ok\nok> "), "a variable is set on one line");
    CHECK(is(say(": SHOW V @ 48 + EMIT ;\n"), " ok\nok> "), "a word defined on the next");
    CHECK(is(say("SHOW  1 V +!  SHOW\n"), "78 ok\nok> "), "and both used on a third");
    CHECK(is(say("1 2 3 4 5 6\n"), " ok\nok> ") && is(say("+ + + + + 48 + EMIT\n"), "E ok\nok> "), "six values wait on the stack between lines");
    CHECK(is(say("SHOW"), ""), "nothing happens until the line is ended");
    CHECK(is(say(" SHOW\n"), "88 ok\nok> "), "and then all of it is read");
    CHECK(canary_under_expect(), "the data stack is as it was at switch-on");

    /* ---- a definition over several lines, and an error in the middle of one ---- */
    boot();
    CHECK(is(say(": LONG\n"), " ok\nok> ") && n.mem[STATE] != 0, "a line that leaves a definition open still says ok");
    CHECK(is(say("65 EMIT\n"), " ok\nok> ") && is(say("66 EMIT ;\n"), " ok\nok> ") && n.mem[STATE] == 0, "it is finished two lines later");
    CHECK(is(say("LONG\n"), "AB ok\nok> "), "and runs");
    CHECK(is(say(": BROKEN 1 IF\n"), " ok\nok> ") && n.mem[STATE] != 0 && n.mem[CFP] != CFS_W, "a definition with an IF open");
    CHECK(is(say("NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
          "an error ends it and empties the control-flow stack");
    CHECK(is(say("BROKEN\n"), "UNKNOWN WORD: 'BROKEN'\n ERROR\nok> "), "and it was never defined");
    CHECK(is(say("LONG\n"), "AB ok\nok> "), "what was defined before is still there");

    /* ---- QUIT, ABORT and a failed line each end a definition that is open ---- */
    boot();
    CHECK(is(say(": IQ QUIT ; IMMEDIATE  : IA ABORT ; IMMEDIATE\n"), " ok\nok> "), "QUIT and ABORT as immediate words");
    CHECK(is(say(": H1 1 IF IQ\n"), "\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "QUIT while compiling stops compiling");
    CHECK(is(say("65 EMIT\n"), "A ok\nok> ") && is(say("H1\n"), "UNKNOWN WORD: 'H1'\n ERROR\nok> "), "and the definition is gone");
    CHECK(is(say(": H2 1 IF IA\n"), " ok\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "ABORT while compiling stops compiling");
    CHECK(is(say("66 EMIT\n"), "B ok\nok> ") && is(say("H2\n"), "UNKNOWN WORD: 'H2'\n ERROR\nok> "), "and the definition is gone");
    CHECK(is(say(": H3 1 IF [ PAD PAD -1 CMOVE ]\n"), " ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
          "a word that sets NODE-ERROR while a definition is open ends it");
    CHECK(is(say("67 EMIT\n"), "C ok\nok> ") && is(say("H3\n"), "UNKNOWN WORD: 'H3'\n ERROR\nok> "), "and the definition is gone");
    CHECK(is(say(": H4 68 EMIT ; H4\n"), "D ok\nok> "), "the next definition compiles and runs");

    /* ---- the text is in the definition, a counted string after the call ---- */
    boot();
    for (v4_cell k = n.mem[DP] / 4; k < DICT_END_W; k++) n.mem[k] = (v4_cell)-1;       /* memory that was not zero */
    CHECK(is(say(": T .\" ABCDE\" ;\n"), " ok\nok> "), "a word that prints five characters");
    {
        v4_cell xt = n.mem[LATEST];
        CHECK((uint32_t)n.mem[xt + 1] == (5u | ('A' << 8) | ('B' << 16) | ((uint32_t)'C' << 24)) && (uint32_t)n.mem[xt + 2] == ('D' | ('E' << 8)),
              "the count and the characters follow the call, four to a cell, zeros after");
        CHECK((n.mem[DP] + 3) / 4 == xt + 4, "then the rest of the word: four cells in all");
    }
    /* every length from 0 to 12: the word goes on at the right cell */
    for (i = 0; i <= 12; i++) {
        char line[96], want[32];
        boot();
        snprintf(line, sizeof line, ": T 60 EMIT .\" %.*s\" 62 EMIT ; T\n", (int)i, "abcdefghijkl");
        snprintf(want, sizeof want, "<%.*s> ok\nok> ", (int)i, "abcdefghijkl");
        CHECK(is(say(line), want), ".\" with %u characters", i);
        snprintf(line, sizeof line, ": U 60 EMIT ABORT\" %.*s\" 62 EMIT ; 0 U 1 U 33 EMIT\n", (int)i, "abcdefghijkl");
        snprintf(want, sizeof want, "<><%.*s\n ok\nok> ", (int)i, "abcdefghijkl");
        CHECK(is(say(line), want), "ABORT\" with %u characters, false then true", i);
    }
    /* the longest: 76 characters fit an 80-character line after ." and a space.
     * EXPECT stops at the 80th character, so that line's new-line is still to
     * come and is read as an empty line (FORTH-79's EXPECT; see input.v4). */
    {
        char line[128], want[128], text[80];
        for (i = 0; i < 76; i++) text[i] = (char)('#' + i);                    /* no " in it */
        text[76] = 0;
        boot();
        snprintf(line, sizeof line, ".\" %s\"\n", text);
        snprintf(want, sizeof want, "%s ok\nok>  ok\nok> ", text);
        CHECK(is(say(line), want), "a string that fills an 80-character line");
        boot();
        snprintf(line, sizeof line, ".\" %s\"\n", text + 1);
        snprintf(want, sizeof want, "%s ok\nok> ", text + 1);
        CHECK(is(say(line), want), "and one that fills a 79-character line");
    }

    /* ---- QUERY takes 80 characters; what is over is the next line ---- */
    boot();
    {
        char line[128];
        memset(line, ' ', 100);
        memcpy(line, "65 EMIT", 7);
        memcpy(line + 70, "66 EMIT", 7);
        memcpy(line + 80, "67 EMIT 68 EMIT", 15);
        line[100] = '\n'; line[101] = 0;
        CHECK(is(say(line), "AB ok\nok> CD ok\nok> "), "a line of 100 characters is read as 80 and 20");
    }

    /* ---- ABORT and QUIT from deep in a programme, again and again ---- */
    boot();
    CHECK(is(say(": A0 ABORT ; : A1 A0 ; : A2 A1 ; : A3 A2 ; : A4 A3 ; : A5 A4 ;\n"), " ok\nok> "), "ABORT six calls down");
    CHECK(is(say(": Q0 QUIT ; : Q1 Q0 ; : Q2 Q1 ; : Q3 Q2 ; : Q4 Q3 ; : Q5 Q4 ;\n"), " ok\nok> "), "QUIT six calls down");
    CHECK(is(say(": L0 10 0 DO I 5 = IF ABORT THEN LOOP ; : L1 3 0 DO L0 LOOP ;\n"), " ok\nok> "), "ABORT inside two loops");
    for (i = 0; i < 40; i++) {
        CHECK(is(say("65 EMIT A5 66 EMIT\n"), "A ok\nok> "), "ABORT from six deep, time %u", i);
        CHECK(is(say("67 EMIT Q5 68 EMIT\n"), "C\nok> "), "QUIT from six deep, time %u", i);
        CHECK(is(say("L1 69 EMIT\n"), " ok\nok> "), "ABORT out of two loops, time %u", i);
        CHECK(is(say(": SQ DUP * ; 7 SQ EMIT\n"), "1 ok\nok> "), "and the next line compiles and runs, time %u", i);
    }
    CHECK(canary_under_expect(), "none of it disturbed the data stack");

    /* ---- how deep words may call each other from the prompt ----
     * N7 is eight words deep; with the prompt's call of INTERPRET that is all
     * nine return entries.  A ninth word would overwrite the first (D-2), so
     * it is not tried here. */
    {
        unsigned deepest = 0;
        for (i = 0; i <= 7; i++) {
            char line[64], want[16];
            boot();
            if (!is(say(": N0 1+ ; : N1 N0 1+ ; : N2 N1 1+ ; : N3 N2 1+ ; : N4 N3 1+ ;\n"), " ok\nok> ")) break;
            if (!is(say(": N5 N4 1+ ; : N6 N5 1+ ; : N7 N6 1+ ;\n"), " ok\nok> ")) break;
            snprintf(line, sizeof line, "47 N%u EMIT 33 EMIT\n", i);
            snprintf(want, sizeof want, "%c! ok\nok> ", (char)('0' + i));
            if (!is(say(line), want)) break;
            deepest = i + 1;
        }
        printf("  from the prompt, words may call each other %u deep\n", deepest);
        CHECK(deepest == 8, "a word run from the prompt has all the return stack but the prompt's one entry");
    }
    /* and with text printed at the bottom of the chain */
    boot();
    CHECK(is(say(": P0 .\" deep\" ; : P1 P0 ; : P2 P1 ; : P3 P2 ; : P4 P3 ; P4\n"), "deep ok\nok> "), ".\" five calls down");

    /* ---- how many values may wait on the stack from one line to the next ---- */
    {
        unsigned k, most = 0;
        for (k = 1; k <= 9; k++) {
            char line[96], want[16];
            size_t at = 0;
            unsigned m;
            boot();
            for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "%u ", m + 1);
            snprintf(line + at, sizeof line - at, "\n");
            if (strcmp(say(line), " ok\nok> ") != 0) break;
            for (at = 0, m = 1; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "+ ");
            snprintf(line + at, sizeof line - at, "32 + EMIT\n");
            snprintf(want, sizeof want, "%c ok\nok> ", (char)(32 + k * (k + 1) / 2));
            if (strcmp(say(line), want) != 0 || !canary_under_expect()) break;
            most = k;
        }
        printf("  %u values may wait on the stack while the next line is typed\n", most);
        CHECK(most >= 6, "reading a line leaves most of the stack to the user");
    }

    /* ---- how much of the data stack a line has ---- */
    {
        unsigned d;
        for (d = 0; d < V4_DATA_DEPTH; d++) {
            unsigned k, good = 1;
            boot_with(d + 1);
            if (strcmp(say(": Z1 .\" x\" 1 2 + ;  Z1 Z1 + 48 + EMIT\n"), "xx6 ok\nok> ") != 0) break;
            if (!canary_under_expect()) break;
            for (k = d + 1; k-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + k)) good = 0;
            if (!good) break;
        }
        printf("  defining and running a word from the prompt leaves %u data cells under it untouched\n", d);
        CHECK(d >= 3, "the prompt leaves room on the data stack");
    }

    CHECK(v4_node_guards_intact(&n), "guards intact");

    printf("  %d checks, %d failures\n", checks, failures);
    return failures ? 1 : 0;
}