/* test_host_input.c -- reading a line and splitting it into words and * numbers, executed on the host node. * * DECOMPOSITION.md 5.9 and 5.15: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD * ENCLOSE CONVERT NUMBER and the comment words. The definitions are text, * capsule/core.v4 and capsule/input.v4, assembled here by the text assembler. * * These are FORTH-79 words and follow the standard (ruled 2026-10-04) where * v3 did something else: * EXPECT ( baddr n -- ) up to n characters, or to a new-line; a zero * after them; no action for n <= 0. v3 took n-1 (it was fgets). * QUERY up to 80 characters into TIB, >IN to 0. v3 took 1024. * WORD ( c -- baddr ) the next word of TIB as a counted string, the * delimiter met (or a zero at the end of the text) stored after * it; >IN just past that delimiter. v3 skipped every delimiter * after the word, stored a zero, and cut the word at 62. * CONVERT ( d1 baddr1 -- d2 baddr2 ) starts at baddr1 + 1, honours BASE, * and the double is ( lo hi ). v3 was base 10 only, started at * baddr1, and took the double low cell on top. * NUMBER ( baddr -- d ) a signed double in the current BASE; anything * that is not a number gives 0 and sets NODE-ERROR. v3 returned * ( n flag ) and read base 10 only. * SPAN, SOURCE, TIB and ENCLOSE are not in FORTH-79 and behave as v3's. * * The values marked "v3:" were recorded from the v3 binary on 2026-10-04. */ #include "v4/text.h" #include "v4/testcode.h" #include "v4/umul.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) #define MAXU ((v4_ucell)~(v4_ucell)0) #define GUARD ((v4_cell)0x5EED5EED) #include "host_map.h" static v4_node n; static v4_exec_state es; static v4_heat h; static v4_text tx; static unsigned char byte_at(v4_cell baddr) { return (unsigned char)(((v4_ucell)n.mem[baddr >> 2] >> (8u * (unsigned)(baddr & 3))) & 0xFFu); } static void put_bytes(v4_cell baddr, const void *src, unsigned len) { const unsigned char *s = (const unsigned char *)src; for (unsigned i = 0; i < len; i++) { v4_cell ba = baddr + (v4_cell)i; unsigned sh = 8u * (unsigned)(ba & 3); v4_ucell w = (v4_ucell)n.mem[ba >> 2]; n.mem[ba >> 2] = (v4_cell)((w & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)s[i] << sh)); } } static int bytes_are(v4_cell baddr, const void *want, unsigned len) { const unsigned char *w = (const unsigned char *)want; for (unsigned i = 0; i < len; i++) if (byte_at(baddr + (v4_cell)i) != w[i]) return 0; return 1; } /* A line in TIB as QUERY would leave it. */ static void set_line(const char *s) { unsigned len = (unsigned)strlen(s); put_bytes(TIB, s, len + 1u); n.mem[SPAN] = (v4_cell)len; n.mem[TO_IN] = 0; } static v4_cell W(const char *name) { v4_cell w = v4_text_word(&tx, name); if (w < 0) { failures++; printf("FAIL: no word %s\n", name); } return w; } static void fresh(void) { v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es); v4_heat_reset(&h); n.mem[NODE_ERROR] = 0; v4_dstack_push(&n.ds, CANARY); } static int go(const char *name) { return v4_test_call(&n, &es, &h, W(name), 4000000) > 0; } static int run(const char *name, unsigned argc, v4_cell a, v4_cell b, v4_cell c) { fresh(); if (argc > 0) v4_dstack_push(&n.ds, a); if (argc > 1) v4_dstack_push(&n.ds, b); if (argc > 2) v4_dstack_push(&n.ds, c); return go(name); } static v4_cell pop(void) { return v4_dstack_pop(&n.ds); } static int clean(void) { return pop() == CANARY; } static int err(void) { return n.mem[NODE_ERROR] != 0; } /* The counted string WORD left: its text, and after it the delimiter it met * (`after`), or a zero if the text ran out. */ static int word_is(v4_cell baddr, const char *want, int after) { unsigned len = (unsigned)strlen(want); return baddr == WBUF && byte_at(WBUF) == len && bytes_are(WBUF + 1, want, len) && byte_at(WBUF + 1 + (v4_cell)len) == (unsigned char)after; } /* Stack headroom, as in test_foundation.c. */ typedef void (*setup_fn)(void); static int fits(const char *name, setup_fn setup, unsigned argc, const v4_cell *args, unsigned nres, const v4_cell *want, unsigned dfill, unsigned rfill) { unsigned i; setup(); v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es); n.mem[NODE_ERROR] = 0; for (i = 0; i < dfill; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i)); v4_dstack_push(&n.ds, CANARY); for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, args[i]); for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i)); if (!go(name)) return 0; for (i = nres; i-- > 0; ) if (pop() != want[i]) return 0; if (pop() != CANARY) return 0; for (i = dfill; i-- > 0; ) if (pop() != (v4_cell)(0x5A000000 + i)) return 0; for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0; return 1; } static void headroom(const char *name, setup_fn setup, unsigned argc, v4_cell a, v4_cell b, v4_cell c, unsigned nres, int min_d, int min_r) { v4_cell args[3], want[4]; unsigned i; int dh, rh; args[0] = a; args[1] = b; args[2] = c; setup(); CHECK(run(name, argc, a, b, c), "%s runs", name); for (i = nres; i-- > 0; ) want[i] = pop(); for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(name, setup, argc, args, nres, want, (unsigned)dh + 1u, 0)) break; for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(name, setup, argc, args, nres, want, 0, (unsigned)rh + 1u)) break; printf(" %-8s headroom: data %d below canary, return %d below its return address\n", name, dh, rh); CHECK(dh >= min_d && rh >= min_r, "%s leaves room", name); } static void setup_line(void) { set_line(" hello world 12345 "); } static void setup_number(void) { put_bytes(SBUF, "\006-12345 ", 8); n.mem[BASE] = 10; } static void setup_expect(void) { v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); (void)v4_node_console_feed(&n, "abc\n", 4); } static uint32_t rng = 0x2545F491u; static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; } /* ---- C references ------------------------------------------------------- */ static int digit_of(int c) { if (c >= '0' && c <= '9') return c - '0'; if (c >= 'A' && c <= 'Z') return c - 'A' + 10; if (c >= 'a' && c <= 'z') return c - 'a' + 10; return -1; } static unsigned eff_base(v4_cell b) { return (b < 2 || b > 36) ? 10u : (unsigned)b; } /* d = d * base + digit, as a double of cells, wrapping. */ static void ref_accumulate(v4_ucell *lo, v4_ucell *hi, unsigned base, unsigned digit) { v4_ucell plo, phi, s; v4_umul(*lo, (v4_ucell)base, &plo, &phi); phi += *hi * (v4_ucell)base; s = plo + (v4_ucell)digit; if (s < plo) phi++; *lo = s; *hi = phi; } /* CONVERT on the text from s on; returns how many characters it took. */ static unsigned ref_convert(const char *s, unsigned base, v4_ucell *lo, v4_ucell *hi) { unsigned k = 0; for (;; k++) { int d = digit_of((unsigned char)s[k]); if (d < 0 || (unsigned)d >= base) break; ref_accumulate(lo, hi, base, (unsigned)d); } return k; } /* NUMBER on the text s of `len` characters; 0 if it is not a number. */ static int ref_number(const char *s, unsigned len, unsigned base, v4_ucell *lo, v4_ucell *hi) { unsigned i = 0; int neg = 0; *lo = *hi = 0; if (len == 0) return 0; if (s[0] == '-') { neg = 1; i = 1; if (len == 1) return 0; } for (; i < len; i++) { int d = digit_of((unsigned char)s[i]); if (d < 0 || (unsigned)d >= base) { *lo = *hi = 0; return 0; } ref_accumulate(lo, hi, base, (unsigned)d); } if (neg) { *lo = (v4_ucell)0 - *lo; *hi = ~*hi + (*lo == 0 ? 1u : 0u); } return 1; } int main(void) { unsigned i, t; printf("v4 host input 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" }; CHECK(host_load(&tx, &n, files, 2), "the capsule assembles"); } /* the in-line names, as words the test can call */ CHECK(v4_text_assemble(&tx, ": 'TIB TIB ; : '>IN >IN ; : 'SPAN SPAN ; : 'BL BL ;"), "wrappers: %s", v4_text_error(&tx)); CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); CHECK(v4_text_here(&tx) < SBUF_W, "code stays below the buffers"); printf(" code: %ld words\n", (long)v4_text_here(&tx) - 16); if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; } v4_node_console_attach(&n, CONSOLE_TX); v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); n.mem[BASE] = 10; /* ---- the core words as text do what the hand-assembled ones do ---- */ { static const v4_cell v[] = { 0, 1, 2, 3, -1, -2, 12345, (v4_cell)V4_MSB, (v4_cell)(V4_MSB - 1u), (v4_cell)(MAXU / 3u) }; for (i = 0; i < 10; i++) for (t = 0; t < 10; t++) { v4_ucell lo, hi, a = (v4_ucell)v[i], b = (v4_ucell)v[t]; v4_umul(a, b, &lo, &hi); CHECK(run("UM*", 2, v[i], v[t], 0) && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean(), "UM* [%u,%u]", i, t); fresh(); v4_dstack_push(&n.ds, v[i]); v4_dstack_push(&n.ds, v[t]); v4_dstack_push(&n.ds, v[(i + 3) % 10]); v4_dstack_push(&n.ds, v[(t + 7) % 10]); lo = a + (v4_ucell)v[(i + 3) % 10]; hi = b + (v4_ucell)v[(t + 7) % 10] + (lo < a); CHECK(go("D+") && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean(), "D+ [%u,%u]", i, t); lo = (v4_ucell)0 - a; hi = ~b + (lo == 0 ? 1u : 0u); CHECK(run("DNEGATE", 2, v[i], v[t], 0) && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean(), "DNEGATE [%u,%u]", i, t); } for (i = 0; i < 8; i++) { CHECK(run("C!", 2, (v4_cell)(0x300 + 'a' + i), SBUF + (v4_cell)i, 0) && clean(), "C! [%u]", i); CHECK(run("C@", 1, SBUF + (v4_cell)i, 0, 0) && pop() == (v4_cell)('a' + i) && clean(), "C@ [%u]", i); } CHECK(run("CMOVE", 3, SBUF, SBUF + 20, 8) && clean() && bytes_are(SBUF + 20, "abcdefgh", 8), "CMOVE"); /* C! writes one byte and nothing else, whatever is above the low byte of what it is given */ for (i = 0; i < 8; i++) { v4_ucell pat = (v4_ucell)0xA5C3F00Fu, want; unsigned sh = 8u * (i % 4u); n.mem[SBUF_W + 8] = (v4_cell)pat; n.mem[SBUF_W + 9] = (v4_cell)pat; n.mem[SBUF_W + 10] = (v4_cell)pat; n.mem[SBUF_W + 7] = (v4_cell)pat; want = (pat & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)0x5Eu << sh); CHECK(run("C!", 2, (v4_cell)-162 /* ...FF5E */, (SBUF_W + 8) * 4 + (v4_cell)i, 0) && clean(), "C! of a wide value [%u]", i); CHECK((v4_ucell)n.mem[SBUF_W + 8 + (v4_cell)(i / 4u)] == want && (v4_ucell)n.mem[SBUF_W + 9 - (v4_cell)(i / 4u)] == pat && (v4_ucell)n.mem[SBUF_W + 7] == pat && (v4_ucell)n.mem[SBUF_W + 10] == pat, "C! changes that byte only [%u]", i); } for (i = 0; i < 6; i++) { static const v4_cell b[] = { 10, 16, 2, 36, 1, 37 }; n.mem[BASE] = b[i]; CHECK(run("(BASE)", 0, 0, 0, 0) && pop() == (v4_cell)eff_base(b[i]) && clean(), "(BASE) [%u]", i); } n.mem[BASE] = 10; CHECK(v4_node_console_feed(&n, "Z", 1) == 1 && run("KEY", 0, 0, 0, 0) && pop() == 'Z' && clean(), "KEY"); /* a node has no console of its own: what it prints is kept to be sent (core.v4) */ n.mem[OUT_PTR] = OUT_W; CHECK(run("EMIT", 1, 'q', 0, 0) && clean() && n.mem[OUT_PTR] == OUT_W + 1 && n.mem[OUT_W] == 'q', "EMIT"); CHECK(run("EMIT", 1, 0x141, 0, 0) && clean() && n.mem[OUT_PTR] == OUT_W + 2 && n.mem[OUT_W + 1] == 'A', "EMIT prints the low 8 bits"); } /* ---- the in-line names ---- */ CHECK(run("'TIB", 0, 0, 0, 0) && pop() == TIB && clean(), "TIB is the buffer's byte address"); CHECK(run("'>IN", 0, 0, 0, 0) && pop() == TO_IN && clean(), ">IN is its variable's address"); CHECK(run("'SPAN", 0, 0, 0, 0) && pop() == SPAN && clean(), "SPAN is its variable's address"); CHECK(run("'BL", 0, 0, 0, 0) && pop() == 32 && clean(), "BL is 32"); /* ---- EXPECT ---- */ v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); /* FORTH-79: up to n characters. (v3, which was fgets, stored 7 of * "hello world this is long" for 8 EXPECT; the standard stores 8.) */ for (i = 0; i < 64; i++) n.mem[SBUF_W + (v4_cell)i] = 0x2A2A2A2A; CHECK(v4_node_console_feed(&n, "hello world this is long\n", 25) == 25, "fed"); CHECK(run("EXPECT", 2, SBUF, 8, 0) && clean() && !err(), "8 EXPECT returns"); CHECK(n.mem[SPAN] == 8 && bytes_are(SBUF, "hello wo\0", 9) && byte_at(SBUF + 9) == 0x2A, "8 EXPECT stores eight characters and a zero, SPAN 8"); CHECK(run("KEY", 0, 0, 0, 0) && pop() == 'r', "and leaves the rest of the line unread"); v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); CHECK(v4_node_console_feed(&n, "hi\nxyz\n", 7) == 7, "fed"); CHECK(run("EXPECT", 2, SBUF, 8, 0) && clean() && n.mem[SPAN] == 2 && bytes_are(SBUF, "hi\0", 3), "a short line: SPAN 2, the new-line taken, not stored"); CHECK(run("EXPECT", 2, SBUF, 3, 0) && clean() && n.mem[SPAN] == 3 && bytes_are(SBUF, "xyz\0", 4), "3 EXPECT stores three characters"); CHECK(run("KEY", 0, 0, 0, 0) && pop() == '\n', "and leaves the new-line unread"); v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); /* every size against every line length */ for (t = 1; t <= 12; t++) for (i = 0; i <= 12; i++) { char line[16]; unsigned want = i < t ? i : t, k; for (k = 0; k < i; k++) line[k] = (char)('A' + k); line[i] = '\n'; for (k = 0; k < 64; k++) n.mem[SBUF_W + (v4_cell)k] = 0x2A2A2A2A; v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); (void)v4_node_console_feed(&n, line, i + 1u); n.mem[SPAN] = 99; CHECK(run("EXPECT", 2, SBUF + 3, (v4_cell)t, 0) && clean() && !err(), "EXPECT returns [%u,%u]", t, i); CHECK(n.mem[SPAN] == (v4_cell)want, "EXPECT SPAN [%u,%u]: %ld", t, i, (long)n.mem[SPAN]); CHECK(bytes_are(SBUF + 3, line, want) && byte_at(SBUF + 3 + (v4_cell)want) == 0, "EXPECT text [%u,%u]", t, i); CHECK(byte_at(SBUF + 2) == 0x2A && byte_at(SBUF + 4 + (v4_cell)want) == 0x2A, "EXPECT writes nothing else [%u,%u]", t, i); /* what is left unread: nothing if the new-line was reached, else * the rest of the line and its new-line */ k = n.input_len - n.input_pos; CHECK(k == (i < t ? 0u : i + 1u - t), "EXPECT leaves %u unread [%u,%u]", k, t, i); } /* no action for n <= 0: nothing read, nothing stored, SPAN as it was, no error */ { static const v4_cell none[] = { 0, -1, -100, (v4_cell)V4_MSB }; for (i = 0; i < 4; i++) { for (t = 0; t < 64; t++) n.mem[SBUF_W + (v4_cell)t] = 0x2A2A2A2A; v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); (void)v4_node_console_feed(&n, "abc\n", 4); n.mem[SPAN] = 5; CHECK(run("EXPECT", 2, SBUF, none[i], 0) && clean() && !err() && n.mem[SPAN] == 5 && n.input_len - n.input_pos == 4 && byte_at(SBUF) == 0x2A, "EXPECT takes no action for n <= 0 [%u]", i); } v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); } /* ---- QUERY and SOURCE ---- */ n.mem[TIB_W - 1] = GUARD; n.mem[TIB_W + 21] = GUARD; n.mem[TO_IN] = 77; CHECK(v4_node_console_feed(&n, " 12 34 +\nnext line\n", 20) == 20, "fed"); CHECK(run("QUERY", 0, 0, 0, 0) && clean() && !err(), "QUERY returns"); CHECK(n.mem[SPAN] == 9 && n.mem[TO_IN] == 0 && bytes_are(TIB, " 12 34 +\0", 10), "QUERY fills TIB, sets SPAN and zeroes >IN"); CHECK(run("SOURCE", 0, 0, 0, 0) && pop() == 9 && pop() == TIB && clean(), "SOURCE is TIB and SPAN @"); CHECK(run("QUERY", 0, 0, 0, 0) && clean() && n.mem[SPAN] == 9 && bytes_are(TIB, "next line\0", 10), "the next QUERY reads the next line"); { static char longline[200]; for (i = 0; i < 150; i++) longline[i] = (char)('a' + i % 26); longline[150] = '\n'; CHECK(v4_node_console_feed(&n, longline, 151) == 151, "fed"); CHECK(run("QUERY", 0, 0, 0, 0) && clean() && n.mem[SPAN] == 80, "QUERY takes at most 80 characters"); CHECK(bytes_are(TIB, longline, 80) && byte_at(TIB + 80) == 0, "with a zero after them"); CHECK(n.mem[TIB_W - 1] == GUARD && n.mem[TIB_W + 21] == GUARD, "and nothing past the 81st byte written"); CHECK(run("QUERY", 0, 0, 0, 0) && clean() && n.mem[SPAN] == 70 && bytes_are(TIB, longline + 80, 70), "the rest of the line is the next QUERY's"); v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST); } n.mem[SPAN] = -5; CHECK(run("SOURCE", 0, 0, 0, 0) && pop() == 0 && pop() == TIB && clean(), "SOURCE reads a negative SPAN as 0"); /* ---- WORD ---- */ /* FORTH-79: the delimiter met is stored after the word, and >IN is left * just past it. (v3 skipped all the delimiters after a word, so its * >IN after "world" was 18 where the standard's is 17.) */ set_line(" hello world x"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "hello", ' ') && clean() && n.mem[TO_IN] == 9, "the first word; >IN is past one blank"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "world", ' ') && clean() && n.mem[TO_IN] == 17, "the second"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "x", 0) && clean() && n.mem[TO_IN] == 19, "the last word ends the text: a zero after it"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "", 0) && clean() && n.mem[TO_IN] == 19, "with nothing left the count is 0"); set_line("a b,,c d,e"); CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "a b", ',') && clean() && n.mem[TO_IN] == 4, "a comma-delimited word; one comma taken"); CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "c d", ',') && clean() && n.mem[TO_IN] == 9, "the leading comma of the next is skipped"); CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "e", 0) && clean() && n.mem[TO_IN] == 10, "the last one"); /* v3: "AAAA" with delimiter 65: count 0, >IN 4, count 0 -- the same in the standard */ set_line("AAAA"); CHECK(run("WORD", 1, 65, 0, 0) && word_is(pop(), "", 0) && clean() && n.mem[TO_IN] == 4, "v3: a line of delimiters: count 0, >IN 4"); CHECK(run("WORD", 1, 65, 0, 0) && word_is(pop(), "", 0) && clean() && n.mem[TO_IN] == 4, "v3: and again"); /* against C */ n.mem[WBUF_W - 1] = GUARD; n.mem[WBUF_W + WBUF_CELLS] = GUARD; for (t = 0; t < 400; t++) { char line[96], tok[96]; unsigned len = rnd() % 70, pos = 0, guard = 0; char delim = (char)(t % 3 == 0 ? ',' : ' '); for (i = 0; i < len; i++) line[i] = rnd() % 3 == 0 ? delim : (char)('a' + rnd() % 4); line[len] = 0; set_line(line); for (;;) { unsigned start, end, tl; int after; while (pos < len && line[pos] == delim) pos++; start = pos; while (pos < len && line[pos] != delim) pos++; end = pos; after = pos < len ? delim : 0; if (pos < len) pos++; tl = end - start; memcpy(tok, line + start, tl); tok[tl] = 0; CHECK(run("WORD", 1, (v4_cell)(0x700 + delim), 0, 0) && word_is(pop(), tok, after) && clean() && !err() && n.mem[TO_IN] == (v4_cell)pos, "WORD [%u] \"%s\" at %u", t, tok, pos); if (pos >= len || ++guard > 80) break; } CHECK(run("WORD", 1, (v4_cell)delim, 0, 0) && word_is(pop(), "", 0) && clean() && n.mem[TO_IN] == (v4_cell)len, "WORD at the end [%u]", t); CHECK(bytes_are(TIB, line, len + 1u) && n.mem[SPAN] == (v4_cell)len, "WORD leaves TIB and SPAN [%u]", t); } /* a word of 255 characters fits; a longer one is cut to 255, and >IN still passes all of it */ { static char line[400], cut[256]; memset(line, 'w', 255); line[255] = ' '; line[256] = 'z'; line[257] = 0; memset(cut, 'w', 255); cut[255] = 0; set_line(line); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), cut, ' ') && clean() && n.mem[TO_IN] == 256, "a 255-character word is whole"); memset(line, 'w', 300); line[300] = ' '; line[301] = 'z'; line[302] = 0; set_line(line); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), cut, ' ') && clean() && n.mem[TO_IN] == 301, "a 300-character word is cut to 255"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "z", 0) && clean(), "and the next word is the next word"); CHECK(n.mem[WBUF_W - 1] == GUARD && n.mem[WBUF_W + WBUF_CELLS] == GUARD, "nothing outside WORD's buffer written"); } set_line("abc def"); n.mem[TO_IN] = -3; CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "abc", ' ') && clean(), "a negative >IN reads as 0"); n.mem[SPAN] = -3; n.mem[TO_IN] = 0; CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "", 0) && clean() && n.mem[TO_IN] == 0, "a negative SPAN reads as an empty line"); /* ---- the comment words ---- */ set_line("skip this ) kept ( and ) too"); CHECK(run("PAREN", 0, 0, 0, 0) && clean() && n.mem[TO_IN] == 11, "( skips to just after the closing parenthesis"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "kept", ' ') && clean(), "and the next word follows"); set_line("one two three"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "one", ' ') && run("BACKSLASH", 0, 0, 0, 0) && clean() && n.mem[TO_IN] == 13, "\\ skips the rest of the line"); CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "", 0) && clean(), "nothing is left after it"); /* ---- ENCLOSE ---- */ /* v3: " ab cd" 32 ENCLOSE gives 2 4 6; "abc" gives 0 3 3 */ put_bytes(SBUF, " ab cd\0", 9); CHECK(run("ENCLOSE", 2, SBUF, 32, 0) && pop() == 6 && pop() == 4 && pop() == 2 && pop() == SBUF && clean(), "v3: ENCLOSE of \" ab cd\" is 2 4 6"); put_bytes(SBUF, "abc\0", 4); CHECK(run("ENCLOSE", 2, SBUF, 32, 0) && pop() == 3 && pop() == 3 && pop() == 0 && pop() == SBUF && clean(), "v3: ENCLOSE of \"abc\" is 0 3 3"); for (t = 0; t < 400; t++) { char s[48]; unsigned len = rnd() % 40, n1, n2, n3; for (i = 0; i < len; i++) s[i] = rnd() % 3 == 0 ? '/' : (char)('p' + rnd() % 3); s[len] = 0; for (n1 = 0; n1 < len && s[n1] == '/'; n1++) { } for (n2 = n1; n2 < len && s[n2] != '/'; n2++) { } for (n3 = n2; n3 < len && s[n3] == '/'; n3++) { } put_bytes(SBUF + 5, s, len + 1u); CHECK(run("ENCLOSE", 2, SBUF + 5, (v4_cell)(0x200 + '/'), 0) && pop() == (v4_cell)n3 && pop() == (v4_cell)n2 && pop() == (v4_cell)n1 && pop() == SBUF + 5 && clean() && bytes_are(SBUF + 5, s, len + 1u), "ENCLOSE [%u] \"%s\"", t, s); } /* ---- CONVERT ---- */ { static const v4_cell bases[] = { 10, 16, 2, 8, 36, 3, 0, 99 }; static const char *const texts[] = { "123abc", "0", "", "9zz", "ffFF.", "1010102", "777 8", "zZ9!", "00012", "-5", "4294967295x", "18446744073709551615 ", "99999999999999999999999999", "g", " 1", "7fffffff", "ZZZZZZZZZZZZZ" }; for (i = 0; i < sizeof bases / sizeof bases[0]; i++) for (t = 0; t < sizeof texts / sizeof texts[0]; t++) { v4_ucell lo = 0, hi = 0, lo2 = (v4_ucell)5, hi2 = (v4_ucell)7; unsigned len = (unsigned)strlen(texts[t]), took, took2; n.mem[BASE] = bases[i]; put_bytes(SBUF, "?", 1); /* CONVERT starts after the address it is given */ put_bytes(SBUF + 1, texts[t], len + 1u); took = ref_convert(texts[t], eff_base(bases[i]), &lo, &hi); CHECK(run("CONVERT", 3, 0, 0, SBUF) && pop() == SBUF + 1 + (v4_cell)took && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean() && !err(), "CONVERT base %ld \"%s\"", (long)bases[i], texts[t]); took2 = ref_convert(texts[t], eff_base(bases[i]), &lo2, &hi2); CHECK(took2 == took && run("CONVERT", 3, 5, 7, SBUF) && pop() == SBUF + 1 + (v4_cell)took && pop() == (v4_cell)hi2 && pop() == (v4_cell)lo2 && clean(), "CONVERT accumulates into 5 7, base %ld \"%s\"", (long)bases[i], texts[t]); CHECK(n.mem[BASE] == bases[i] && bytes_are(SBUF + 1, texts[t], len + 1u), "CONVERT changes neither BASE nor the text"); } /* every character: which are digits, and their values */ for (i = 0; i < 256; i++) CHECK(run("(DIGIT)", 1, (v4_cell)i, 0, 0) && pop() == (v4_cell)digit_of((int)i) && clean(), "(DIGIT) of character %u", i); /* a digit that carries out of the low cell: the low cell times the * base is all ones when it is a third of all ones and the base is 3 */ { static const char *const dig[] = { "1", "2", "12", "0" }; static const v4_cell his[] = { 0, 5, -1 }; for (i = 0; i < 4; i++) for (t = 0; t < 3; t++) { v4_ucell lo = MAXU / 3u, hi = (v4_ucell)his[t]; unsigned took = ref_convert(dig[i], 3, &lo, &hi); n.mem[BASE] = 3; put_bytes(SBUF + 1, dig[i], (unsigned)strlen(dig[i]) + 1u); CHECK(run("CONVERT", 3, (v4_cell)(MAXU / 3u), his[t], SBUF) && pop() == SBUF + 1 + (v4_cell)took && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean(), "CONVERT carries into the high cell [%u,%u]", i, t); } } /* the value v3 gave for "123abc" in base 10: 123, stopping at the 'a' */ n.mem[BASE] = 10; put_bytes(SBUF, " 123abc\0", 8); CHECK(run("CONVERT", 3, 0, 0, SBUF) && pop() == SBUF + 4 && pop() == 0 && pop() == 123 && clean(), "v3: 123abc converts to 123 and stops at the a"); } /* ---- NUMBER ---- */ { static const v4_cell bases[] = { 10, 16, 2, 36, 0 }; static const char *const texts[] = { "0", "7", "123", "-45", "-0", "12x", "+7", "-", "", "FF", "ff", "-ff", "1e2", "99999999999", "101", "2", "-101", "zz", "-ZZ", " 1", "1 ", "--1", "1-", "4294967295", "4294967296", "-2147483648", "18446744073709551615", "-9223372036854775808", "123456789012345678901234567890" }; for (i = 0; i < sizeof bases / sizeof bases[0]; i++) for (t = 0; t < sizeof texts / sizeof texts[0]; t++) { v4_ucell lo, hi; unsigned len = (unsigned)strlen(texts[t]); unsigned char cnt = (unsigned char)len; int ok = ref_number(texts[t], len, eff_base(bases[i]), &lo, &hi); n.mem[BASE] = bases[i]; put_bytes(SBUF + 2, &cnt, 1); put_bytes(SBUF + 3, texts[t], len); put_bytes(SBUF + 3 + (v4_cell)len, "\0", 1); /* as WORD leaves it */ CHECK(run("NUMBER", 1, SBUF + 2, 0, 0) && pop() == (v4_cell)hi && pop() == (v4_cell)lo && clean(), "NUMBER base %ld \"%s\"", (long)bases[i], texts[t]); CHECK(err() == !ok, "NUMBER base %ld \"%s\" %s NODE-ERROR", (long)bases[i], texts[t], ok ? "leaves" : "sets"); } n.mem[BASE] = 10; /* NUMBER relies on the character after the string not being a digit, * which WORD guarantees. If one is there the count no longer agrees * with what was converted, and that is reported, not returned. */ put_bytes(SBUF, "\00212345", 7); CHECK(run("NUMBER", 1, SBUF, 0, 0) && pop() == 0 && pop() == 0 && clean() && err(), "digits running past the count are an error"); /* through WORD, as the interpreter will use them */ set_line(" -4096 next"); CHECK(run("WORD", 1, 32, 0, 0) && go("NUMBER") && pop() == -1 && pop() == -4096 && clean() && !err(), "BL WORD NUMBER on -4096"); CHECK(run("WORD", 1, 32, 0, 0) && go("NUMBER") && pop() == 0 && pop() == 0 && clean() && err(), "BL WORD NUMBER on a word that is no number"); } /* What they leave their caller (D-2). */ headroom("WORD", setup_line, 1, 32, 0, 0, 1, 3, 3); headroom("NUMBER", setup_number, 1, SBUF, 0, 0, 2, 2, 2); headroom("EXPECT", setup_expect, 2, SBUF + 40, 20, 0, 0, 3, 4); headroom("ENCLOSE", setup_number, 2, SBUF, 32, 0, 4, 2, 4); CHECK(v4_node_guards_intact(&n), "guards intact"); printf(" %d checks, %d failures\n", checks, failures); return failures ? 1 : 0; }