admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
443439c3d2aecb9f619d3f2e4dc72fff016d1f3d
LithosAnanake/v4/tests/test_host_input.c
T
rajamesandClaude Opus 5.5 443439c3d2 feat(v4.0.0): reading a line and splitting it into words and numbers 
The first layer of the compiler capsule, on the host node: TIB >IN SPAN
SOURCE BL EXPECT QUERY WORD ENCLOSE CONVERT NUMBER and the comment
words.  The definitions are text, v4/capsule/core.v4 (the core words
they rest on) and v4/capsule/input.v4, assembled by the text assembler,
which can now read a file.

EXPECT, QUERY, WORD and ENCLOSE behave as v3's.  CONVERT and NUMBER are
FORTH-79 (ruled 2026-10-04): any BASE, a double in the standard order,
and NUMBER returns a signed double or sets NODE-ERROR.

Executed at both cell widths against C and against values recorded from
the v3 binary.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-04 08:30:32 -04:00

536 lines
28 KiB
C
Raw Blame History

/* 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.
*
* v3 (v3/src/word_source/string_words.c), kept:
* EXPECT ( baddr u -- ) at most u-1 characters, stopping after a
* new-line; a zero after them; SPAN is how many
* QUERY a line into TIB, >IN to 0
* WORD ( c -- baddr ) the next word of TIB as a counted string; the
* delimiters before it and all those after it are skipped
* ENCLOSE ( baddr c -- baddr n1 n2 n3 )
* FORTH-79, where v3 was something else (ruled 2026-10-04):
* 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.
*
* The values marked "v3:" were recorded from the v3 binary on 2026-10-04.
* v3's WORD returned the right count and left >IN right, but the text in its
* buffer was corrupt in those runs ("hello" came back as "hlllo"), so only
* its counts and >IN are used.
*/
#include "v4/text.h"
#include "v4/testcode.h"
#include "v4/umul.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)
#define MAXU ((v4_ucell)~(v4_ucell)0)
/* The memory map is open (D-4); the test puts everything at the top. */
#define TOP ((v4_cell)V4_NODE_WORDS)
#define NODE_ERROR (TOP - 2)
#define CONSOLE_TX (TOP - 4)
#define CONSOLE_RX (TOP - 6)
#define CONSOLE_ST (TOP - 7)
#define BASE (TOP - 8)
#define TO_IN (TOP - 9)
#define SPAN (TOP - 10)
#define PVARS (TOP - 16) /* six cells */
#define WBUF_W (TOP - 40) /* 16 cells = 64 bytes, with a cell free on each side */
#define TIB_W (TOP - 304) /* 260 cells = 1040 bytes */
#define SBUF_W (TOP - 384) /* 64 cells = 256 bytes for the tests' own strings */
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
#define SBUF (SBUF_W * 4)
#define TIB_SIZE 1025
#define GUARD ((v4_cell)0x5EED5EED)
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 that a zero follows it. */
static int word_is(v4_cell baddr, const char *want)
{
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) == 0;
}
/* 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);
v4_node_reset(&n);
v4_text_begin(&tx, &n, 16);
v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
v4_text_constant(&tx, "BASE", BASE);
v4_text_constant(&tx, "TIB", TIB);
v4_text_constant(&tx, "#TIB", TIB_SIZE);
v4_text_constant(&tx, ">IN", TO_IN);
v4_text_constant(&tx, "SPAN", SPAN);
v4_text_constant(&tx, "WBUF", WBUF);
v4_text_constant(&tx, "(P)", PVARS);
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
/* 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");
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");
CHECK(run("EMIT", 1, 'q', 0, 0) && clean() && n.console_len == 1 && n.console[0] == 'q', "EMIT");
}
/* ---- 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);
/* v3: B 8 EXPECT on "hello world this is long": SPAN 7, 68 65 6C 6C 6F 20 77 00, and
* the rest of the line ("orld ...") still to be read */
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(), "v3: 8 EXPECT returns");
CHECK(n.mem[SPAN] == 7 && bytes_are(SBUF, "hello w\0", 8) && byte_at(SBUF + 8) == 0x2A, "v3: 8 EXPECT stores \"hello w\" and a zero, SPAN 7");
CHECK(run("KEY", 0, 0, 0, 0) && pop() == 'o', "v3: and leaves the rest of the line unread");
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
/* v3: B 8 EXPECT on "hi": SPAN 2. Then B 3 EXPECT on "xyz": SPAN 2, 78 79 00, 'z' unread */
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), "v3: a short line: SPAN 2, the new-line taken, not stored");
CHECK(run("EXPECT", 2, SBUF, 3, 0) && clean() && n.mem[SPAN] == 2 && bytes_are(SBUF, "xy\0", 3), "v3: 3 EXPECT stores two characters");
CHECK(run("KEY", 0, 0, 0, 0) && pop() == 'z', "v3: and leaves the third unread");
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
/* every size against every line length */
for (t = 0; t <= 12; t++)
for (i = 0; i <= 12; i++) {
char line[16];
unsigned want = t == 0 ? 0 : (i < t - 1 ? i : t - 1), 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) && (t == 0 || byte_at(SBUF + 3 + (v4_cell)want) == 0), "EXPECT text [%u,%u]", t, i);
CHECK(byte_at(SBUF + 2) == 0x2A && byte_at(SBUF + 3 + (v4_cell)want + (t ? 1 : 0)) == 0x2A, "EXPECT writes nothing else [%u,%u]", t, i);
/* what is left unread: the line's tail if it did not fit, new-line
* included -- and, as with fgets, the new-line alone when the
* text exactly filled the u-1 characters */
k = n.input_len - n.input_pos;
CHECK(k == (t == 0 ? i + 1u : (i + 1u < t ? 0u : i + 1u - (t - 1u))), "EXPECT leaves %u unread [%u,%u]", k, t, i);
}
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
n.mem[SPAN] = 5;
CHECK(run("EXPECT", 2, SBUF, -1, 0) && clean() && err() && n.mem[SPAN] == 5, "EXPECT of a negative size sets NODE-ERROR and reads nothing");
/* ---- QUERY and SOURCE ---- */
n.mem[TIB_W - 1] = GUARD; n.mem[TIB_W + 260] = 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[1200];
for (i = 0; i < 1100; i++) longline[i] = (char)('a' + i % 26);
longline[1100] = '\n';
CHECK(v4_node_console_feed(&n, longline, 1101) == 1101, "fed");
CHECK(run("QUERY", 0, 0, 0, 0) && clean() && n.mem[SPAN] == 1024, "a line longer than TIB is cut at 1024 characters");
CHECK(bytes_are(TIB, longline, 1024) && byte_at(TIB + 1024) == 0, "with a zero after them");
CHECK(n.mem[TIB_W - 1] == GUARD && n.mem[TIB_W + 260] == GUARD, "and nothing outside TIB written");
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 ---- */
/* v3: " hello world x": BL WORD twice, then >IN is 18 and SPAN 19; a third gives count 1, >IN 19 */
set_line(" hello world x");
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "hello") && clean() && n.mem[TO_IN] == 11, "the first word");
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "world") && clean() && n.mem[TO_IN] == 18 && n.mem[SPAN] == 19, "v3: after two words >IN is 18");
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "x") && clean() && n.mem[TO_IN] == 19, "v3: the third has count 1 and >IN is 19");
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "") && clean() && n.mem[TO_IN] == 19, "at the end of the line the count is 0");
/* v3: "a b,,c d,e": SOURCE gives 10; 44 WORD twice, then >IN is 9 */
set_line("a b,,c d,e");
CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "a b") && clean() && n.mem[TO_IN] == 5, "a comma-delimited word; both commas skipped");
CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "c d") && clean() && n.mem[TO_IN] == 9, "v3: after two >IN is 9");
CHECK(run("WORD", 1, 44, 0, 0) && word_is(pop(), "e") && clean() && n.mem[TO_IN] == 10, "the last one");
/* v3: "AAAA" with delimiter 65: count 0, >IN 4, count 0 */
set_line("AAAA");
CHECK(run("WORD", 1, 65, 0, 0) && word_is(pop(), "") && 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(), "") && clean() && n.mem[TO_IN] == 4, "v3: and again");
/* against C */
n.mem[WBUF_W - 1] = GUARD; n.mem[WBUF_W + 16] = 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;
while (pos < len && line[pos] == delim) pos++;
start = pos;
while (pos < len && line[pos] != delim) pos++;
end = pos;
while (pos < len && line[pos] == delim) 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) && clean() && !err()
&& n.mem[TO_IN] == (v4_cell)pos, "WORD [%u] \"%s\" at %u", t, tok, pos);
if (tl == 0 || ++guard > 80) break;
}
CHECK(bytes_are(TIB, line, len + 1u) && n.mem[SPAN] == (v4_cell)len, "WORD leaves TIB and SPAN [%u]", t);
}
/* a word longer than the buffer is cut to 62, and >IN still passes all of it */
{
char line[200], cut[64];
memset(line, 'w', 150); line[150] = ' '; line[151] = 'z'; line[152] = 0;
memset(cut, 'w', 62); cut[62] = 0;
set_line(line);
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), cut) && clean() && n.mem[TO_IN] == 151, "a 150-character word is cut to 62");
CHECK(run("WORD", 1, 32, 0, 0) && word_is(pop(), "z") && clean(), "and the next word is the next word");
CHECK(n.mem[WBUF_W - 1] == GUARD && n.mem[WBUF_W + 16] == 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(), "") && 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 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(), "") && 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, 3);
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;
}
Reference in New Issue View Git Blame Copy Permalink