/* 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. * - an address outside memory says so (D-14); v3 gives ERROR alone. * - M/MOD by zero says so (D-15); v3 gives ERROR alone. * - the stacks hold ten values and nine return entries, and one more is * an error (D-16); v3's are far deeper. A stack fault names the stack, * not the word: "Stack underflow" where v3 says "DROP: Stack underflow". * - any fault empties the data stack; v3 keeps what the failing word had * not taken. * - PICK and ROLL count from one, as FORTH-79 has them: 1 PICK is DUP and * 3 ROLL is ROT. v3's count from zero. */ #include "v4/text.h" #include "v4/testcode.h" #include #include #include 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, w_fault, 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_node_fault_attach(&n, w_fault); 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); } /* The same with nothing at all on the data stack. */ static void boot_bare(void) { boot(); v4_dstack_reset(&n.ds); } /* 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; } 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 }, { "65 EMIT 1 0 / 66 EMIT\n67 EMIT\n", "A/: Division by zero\n ERROR\nok> C ok\nok> ", 1 }, { "1 0 MOD\n", "MOD: Division by zero\n ERROR\nok> ", 1 }, { "1 0 /MOD\n", "/MOD: Division by zero\n ERROR\nok> ", 1 }, { "1 1 0 */\n", "*/: Division by zero\n ERROR\nok> ", 1 }, { "1 1 0 */MOD\n", "*/MOD: Division by zero\n ERROR\nok> ", 1 }, { ": T 1 0 / 65 EMIT ; T 66 EMIT\n67 EMIT\n", "/: Division by zero\n ERROR\nok> C ok\nok> ", 1 }, { "0 0 /\n7 2 / 48 + EMIT\n", "/: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 }, { "DEPTH 48 + EMIT 5 6 DEPTH 48 + EMIT\n", "02 ok\nok> ", 1 }, { "1 2 3 NOSUCH\nDEPTH 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 }, { "5 6 7 1 0 MOD\nDEPTH 48 + EMIT\n", "MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 }, { "5 6 7 1 1 0 */MOD\nDEPTH 48 + EMIT\n", "*/MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 }, { "1 2 3 ABORT\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 1 }, /* v4's own */ { "1 2 3 QUIT\nDEPTH 48 + EMIT\n", "\nok> 3 ok\nok> ", 0 }, { "65 EMIT DROP 66 EMIT\n67 EMIT\n", "AStack underflow\n ERROR\nok> C ok\nok> ", 0 }, { "+\n1 +\nDUP\nOVER\n1 OVER\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> " "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 }, { "1 2 3 4 5 6 7 8 9 10 11\nDEPTH 48 + EMIT\n", "Stack overflow\n ERROR\nok> 0 ok\nok> ", 0 }, { ": OV 1 2 3 4 5 6 7 8 65 EMIT 9 10 11 66 EMIT ; OV\nDEPTH 48 + EMIT\n", "AStack overflow\n ERROR\nok> 0 ok\nok> ", 0 }, { "1 2 3 -1 @\nDEPTH 48 + EMIT\n", "Address out of range\n ERROR\nok> 0 ok\nok> ", 0 }, { ": RU R> DROP R> DROP ; 65 EMIT RU 66 EMIT\n67 EMIT\n", "AReturn stack underflow\n ERROR\nok> C ok\nok> ", 0 }, { ": N0 65 EMIT ; : N1 N0 ; : N2 N1 ; : N3 N2 ; : N4 N3 ; : N5 N4 ; : N6 N5 ;\n: N7 N6 ; N6 N7 66 EMIT\n67 EMIT\n", " ok\nok> AReturn stack overflow\n ERROR\nok> C ok\nok> ", 0 }, { ": DEEP 1 >R 2 >R 3 >R 4 >R 5 >R 6 >R 65 EMIT 7 >R 8 >R 66 EMIT ; DEEP\n", "AReturn stack overflow\n ERROR\nok> ", 0 }, { "65 66 67 1 PICK EMIT EMIT EMIT EMIT\n", "CCBA ok\nok> ", 0 }, { "65 66 67 2 PICK EMIT EMIT EMIT EMIT\n", "BCBA ok\nok> ", 0 }, { "65 66 67 3 PICK EMIT EMIT EMIT EMIT\n", "ACBA ok\nok> ", 0 }, { "65 66 67 1 ROLL EMIT EMIT EMIT\n", "CBA ok\nok> ", 0 }, { "65 66 67 2 ROLL EMIT EMIT EMIT\n", "BCA ok\nok> ", 0 }, { "65 66 67 3 ROLL EMIT EMIT EMIT\nDEPTH 48 + EMIT\n", "ACB ok\nok> 0 ok\nok> ", 0 }, { "65 66 0 PICK\nDEPTH 48 + EMIT\n", "PICK: Invalid index\n ERROR\nok> 2 ok\nok> ", 0 }, { "65 66 -3 ROLL\n65 66 0 ROLL\n", "ROLL: Invalid index\n ERROR\nok> ROLL: Invalid index\n ERROR\nok> ", 0 }, { "65 66 3 PICK\nDEPTH 48 + EMIT\n", "Stack underflow\n ERROR\nok> 0 ok\nok> ", 0 }, { "65 66 5 ROLL\n1 PICK\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 }, /* nine values and n: the stack is full when PICK and ROLL start */ { ": P9 65 2 3 4 5 6 7 8 9 9 PICK >R 2DROP 2DROP 2DROP 2DROP R> EMIT EMIT ; P9\n", "AA ok\nok> ", 0 }, { ": R9 65 2 3 4 5 6 7 8 9 9 ROLL EMIT 2DROP 2DROP 2DROP DROP 48 + EMIT ; R9\n", "A2 ok\nok> ", 0 }, { "65 66 67 68 69 5 ROLL EMIT EMIT EMIT EMIT EMIT\n", "AEDCB ok\nok> ", 0 }, { "65 66 67 68 69 4 ROLL EMIT EMIT EMIT EMIT EMIT\n", "BEDCA ok\nok> ", 0 }, { ": P5 65 66 67 68 69 5 PICK EMIT 3 PICK EMIT EMIT EMIT EMIT EMIT EMIT ; P5\n", "ACEDCBA ok\nok> ", 0 }, { ": T1 QUIT ; : T2 1 2 3 4 T1 ; T2\nDEPTH 48 + EMIT\n", "\nok> 4 ok\nok> ", 0 }, { ": T3 1 2 3 4 5 6 7 8 9 ABORT ; T3\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 0 }, /* with the return stack full or nearly: the exit empties it before it prints */ { ": B0 1 ABORT\" d\" ; : B1 B0 ; : B2 B1 ; : B3 B2 ; : B4 B3 ; : B5 B4 ; : B6 B5 ;\nB6\n", " ok\nok> d\n ok\nok> ", 0 }, { ": I0 5 0 PICK ; : I1 I0 ; : I2 I1 ; : I3 I2 ; : I4 I3 ; : I5 I4 ; : I6 I5 ; I6\n", "PICK: Invalid index\n ERROR\nok> ", 0 }, { ": J0 5 0 / ; : J1 J0 ; : J2 J1 ; : J3 J2 ; : J4 J3 ; : J5 J4 ; : J6 J5 ; J6\n", "/: Division by zero\n ERROR\nok> ", 0 }, { "1 0 0 M/MOD\n", "M/MOD: Division by zero\n ERROR\nok> ", 0 }, { ": Z0 0 / ; : Z1 65 EMIT 9 Z0 66 EMIT ; Z1\n: Z2 1 IF [ 5 0 MOD ]\nZ2\n", "A/: Division by zero\n ERROR\nok> MOD: Division by zero\n ERROR\nok> UNKNOWN WORD: 'Z2'\n ERROR\nok> ", 0 }, { ": Z3 5 0 DO 9 3 I - / DROP LOOP 65 EMIT ; Z3\n66 EMIT\n", "/: Division by zero\n ERROR\nok> B ok\nok> ", 0 }, { ": 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", "quit.v4", "forth.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 */ w_fault = v4_text_word(&tx, "(FAULTS)"); 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]; boot_bare(); CHECK(is(say(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"); /* ---- an address outside memory (D-14): a message, ERROR, and the prompt ---- */ { static const char *const lines[] = { "65 EMIT -1 @ 66 EMIT\n", "65 EMIT 5 -1 ! 66 EMIT\n", "65 EMIT 16384 @ 66 EMIT\n", "65 EMIT 5 16384 ! 66 EMIT\n", "65 EMIT 99999999 C@ 66 EMIT\n", "65 EMIT 7 -4 C! 66 EMIT\n", "65 EMIT -1 EXECUTE 66 EMIT\n", "65 EMIT 1 -1 +! 66 EMIT\n", "65 EMIT PAD -8 4 CMOVE 66 EMIT\n", "65 EMIT -9 COUNT 66 EMIT\n", "65 EMIT -9 3 TYPE 66 EMIT\n", ": F0 -1 @ ; : F1 F0 ; : F2 F1 ; : F3 65 EMIT F2 66 EMIT ; F3 67 EMIT\n", ": G0 9 0 DO I 3 = IF 0 -1 ! THEN LOOP ; : G1 65 EMIT G0 66 EMIT ; G1\n", }; boot(); for (i = 0; i < sizeof lines / sizeof lines[0]; i++) { unsigned before = n.faults; CHECK(is(say(lines[i]), "AAddress out of range\n ERROR\nok> "), "fault %u", i); CHECK(n.faults == before + 1 && !n.stopped && n.mem[STATE] == 0, "fault %u: one fault, and the node is at its prompt", i); CHECK(is(say("1 2 + 48 + EMIT\n"), "3 ok\nok> "), "and the next line runs, after fault %u", i); } CHECK(is(say("16383 @ DROP 0 @ DROP 67 EMIT\n"), "C ok\nok> "), "the first and last words of memory are not faults"); CHECK(is(say(": H5 1 IF [ -1 @ ]\n"), "Address out of range\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "a fault while a definition is open ends it"); CHECK(is(say("H5\n"), "UNKNOWN WORD: 'H5'\n ERROR\nok> ") && is(say(": H6 68 EMIT ; H6\n"), "D ok\nok> "), "and the next definition compiles and runs"); CHECK(v4_node_guards_intact(&n), "guards intact after the faults"); } /* ---- 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(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "ABORT has emptied 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 is a fault (D-16). */ { unsigned deepest = 0; for (i = 0; i <= 8; 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+ ; : N8 N7 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 (strcmp(say(line), want) != 0) 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"); CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and a ninth is reported"); } /* 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"); } /* ---- the fault table: five words, each a jump to its handler ---- */ { static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)" }; for (i = 0; i < V4_FAULT_KINDS; i++) { v4_iword w = (v4_iword)((v4_ucell)n.mem[w_fault + (v4_cell)i] & 0xFFFFFFFFu); CHECK(v4_iword_op(w, 0) == V4_OP_JUMP && v4_iword_branch(w_fault + (v4_cell)i + 1, w, 0) == v4_text_word(&tx, handler[i]), "word %u of the fault table jumps to %s", i, handler[i]); } CHECK(n.fault_vector == w_fault, "and the node has it"); } CHECK(v4_node_guards_intact(&n), "guards intact"); printf(" %d checks, %d failures\n", checks, failures); return failures ? 1 : 0; }