From 443439c3d2aecb9f619d3f2e4dc72fff016d1f3d Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 08:30:32 -0400 Subject: [PATCH] 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 --- docs/v4.0.0/DECOMPOSITION.md | 12 +- v4/Makefile | 12 +- v4/capsule/core.v4 | 77 +++++ v4/capsule/input.v4 | 142 ++++++++++ v4/include/v4/text.h | 5 +- v4/src/text.c | 29 ++ v4/tests/test_host_input.c | 535 +++++++++++++++++++++++++++++++++++ 7 files changed, 802 insertions(+), 10 deletions(-) create mode 100644 v4/capsule/core.v4 create mode 100644 v4/capsule/input.v4 create mode 100644 v4/tests/test_host_input.c diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 70739894..abb48215 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -566,11 +566,11 @@ width and print a flood of spaces. | `SEARCH` | CAP | `( a1 u1 a2 u2 -- a3 u3 flag )`: the rest of string 1 from the first place string 2 occurs and `-1`, or string 1 and `0`; an empty string 2 is found at the start. See below; the inner comparison is in line, not a call to `COMPARE`. Same notes. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 3 data cells and 5 return entries. Clobbers `A` and `B`. | | `SCAN` `SKIP` | CAP | `( baddr u c -- baddr' u' )`: `SCAN` stops at the first byte equal to the low byte of `c` (or at the end, with `u' = 0`); `SKIP` stops at the first byte not equal to it. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 5 data cells and 5 return entries. Clobber `A`. | | `(S)` | CAP | Variable, 4 cells: `COMPARE`'s two lengths; `SEARCH`'s string 2 and the whole of string 1. | -| `BL` | IN | `32` | -| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV). | -| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. | -| `WORD` `ENCLOSE` | CC | Parser. | -| `NUMBER` `CONVERT` | CC | Rewritten to honour `BASE` (v3's `NUMBER` is base 10 only). | +| `BL` | IN | `32` — executed on the golden model (2026-10-04). | +| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV); source in `v4/capsule/input.v4`. `EXPECT ( baddr u -- )` as v3's `fgets`: at most `u-1` characters, stopping after a new-line (taken, not stored), then a zero; `SPAN` is the count; a line that does not fit leaves its tail to be read next; `u < 0` does nothing and sets `NODE-ERROR`. `QUERY` is `TIB #TIB EXPECT 0 >IN !` with `#TIB` 1025, as v3. Executed on the golden model's host node (2026-10-04), including results recorded from the v3 binary. Both part from FORTH-79, which takes up to `u` characters in `EXPECT` and 80 in `QUERY`: reported 2026-10-04, awaiting a ruling. `EXPECT` leaves its caller 6 data cells and 4 return entries. | +| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. `TIB` is the buffer's byte address and `>IN` and `SPAN` their variables' word addresses, all in line; `SOURCE ( -- baddr u )` is `TIB` and `SPAN @`, a negative `SPAN` read as 0. Executed on the golden model's host node (2026-10-04). | +| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )`, as v3: the next word of `TIB` delimited by `c`, as a counted string in a 64-byte buffer with a zero after it; delimiters before it are skipped and so are all those after it; a longer word is cut to 62 characters; at the end of the line the count is 0. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )` on a zero-terminated string. Executed on the golden model's host node (2026-10-04) against C and the counts and `>IN` values recorded from the v3 binary (the text in v3's own buffer was corrupt in those runs: `hello` came back as `hlllo`). `WORD` parts from FORTH-79 in skipping every trailing delimiter, storing a zero where the standard stores the delimiter, and cutting at 62: reported 2026-10-04, awaiting a ruling. `WORD` leaves its caller 4 data cells and 3 return entries. | +| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 3 return entries. | | `S"` `(s")` `[']` | CC | Compiler words. | | `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. | @@ -690,7 +690,7 @@ The storage service belongs to the Artemis role, now a device node. | Word | Fate | Notes | | --- | --- | --- | -| `(` `\` | CC | | +| `(` `\` | CC | `(` is `41 WORD drop`; `\` is `SPAN @ >IN !`. In `v4/capsule/input.v4` under the names `PAREN` and `BACKSLASH`. Executed on the golden model's host node (2026-10-04). | | `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller) | | `NOP` | OP | `nop` | | `QUIT` `ABORT` `ABORT"` `(ABORT")` `COLD` `WARM` | CC | | diff --git a/v4/Makefile b/v4/Makefile index 617a7117..e31ef7a9 100644 --- a/v4/Makefile +++ b/v4/Makefile @@ -43,6 +43,12 @@ BINDIR := $(HERE)/build HOST_WORDS := 16384 node_size = $(if $(findstring /test_host_,$(1)),-DV4_NODE_WORDS=$(HOST_WORDS)) +# The capsule sources: definitions as text (include/v4/text.h), which tests +# assemble onto a node. The directory is passed to the tests so that they +# find the files whatever directory make was run from. +CAPSULES := $(wildcard $(HERE)/capsule/*.v4) +capsule_dir := -DV4_CAPSULE_DIR='"$(HERE)/capsule"' + .PHONY: all test sanitize clean $(addprefix test-,$(WIDTHS)) all: test @@ -71,13 +77,13 @@ endif define TEST_RULE $(BINDIR)/$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile @mkdir -p $(BINDIR) - $$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) \ + $$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \ $(2) $$(SRCS) -o $$@ $(BINDIR)/san-$(1)-$(notdir $(2)): $(2) $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile @mkdir -p $(BINDIR) $$(CC) $$(CSTD) $$(WARN) -O1 -g -fno-omit-frame-pointer \ - -fsanitize=address,undefined -fno-sanitize-recover=all -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) \ + -fsanitize=address,undefined -fno-sanitize-recover=all -I$(HERE)/include -DV4_CELL_BITS=$(1) $(call node_size,$(2)) $(capsule_dir) \ $(2) $$(SRCS) -o $$@ endef @@ -87,7 +93,7 @@ endef # that does not survive the define/eval expansion, and a silently-empty loop # list is exactly the vacuous-pass failure this file already made once. define RUN_RULE -run-$(1)-$(notdir $(2)): $(BINDIR)/$(1)-$(notdir $(2)) +run-$(1)-$(notdir $(2)): $(BINDIR)/$(1)-$(notdir $(2)) $$(CAPSULES) @echo " [V4_CELL_BITS=$(1) $$@]" @$(BINDIR)/$(1)-$(notdir $(2)) diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 new file mode 100644 index 00000000..0aed9d2d --- /dev/null +++ b/v4/capsule/core.v4 @@ -0,0 +1,77 @@ +\ core.v4 -- the core words the host-node capsules rest on. +\ +\ Each is the definition DECOMPOSITION.md gives and the golden-model tests +\ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c), +\ written here as text for the text assembler (v4/include/v4/text.h). +\ +\ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX, +\ CONSOLE-RX, CONSOLE-STATUS, BASE. + +macro SWAP over push push drop pop pop endmacro +macro - push inv pop + inv endmacro \ x y -- x-y +macro NEGATE inv 1 + endmacro +macro NIP push drop pop endmacro + +\ ---- section 4: multiply ------------------------------------------------ +: UM* ( u1 u2 -- ulo uhi ) + over 1 and inv 1 + over 2/ and \ u1 u2 t0 t0 = u2 2/ if u1 odd + over a! N-1 push \ A: u2 R: loop count + push over 2/ pop \ u1 u2 s t0 s = u1 2/ + L: +* unext \ u1 u2 s hi A: lo + push drop pop \ u1 u2 hi + 2* a -if L0 drop 1 + jump L1 L0: drop L1: push + over -if L2 drop dup jump L3 L2: drop 0 L3: push + dup -if L4 drop over 1 and jump L5 L4: drop 0 L5: + pop + pop + push + and 1 and a 2* + pop ; + +\ ---- section 5.7: doubles ------------------------------------------------ +: D+ ( d1 d2 -- d3 ) + push over push push drop pop \ al bl R: bh ah + over over xor -if L1 + drop + -if C1 jump C0 + L1: drop over -if L2 + drop + jump C1 + L2: drop + + C0: pop pop + ; + C1: pop pop + 1 + ; + +: DNEGATE ( d -- -d ) + inv over if L1 drop push inv 1 + pop ; + L1: drop 1 + ; + +\ ---- section 5.3: bytes -------------------------------------------------- +: C@ ( baddr -- c ) + dup 2/ 2/ a! 3 and + if K0 -1 + if K1 -1 + if K2 + drop @ 23 FOR 2/ UNEXT 255 and ; + K2: drop @ 15 FOR 2/ UNEXT 255 and ; + K1: drop @ 7 FOR 2/ UNEXT 255 and ; + K0: drop @ 255 and ; + +: C! ( c baddr -- ) + dup 2/ 2/ a! 3 and push 255 and pop + if K0 -1 + if K1 -1 + if K2 + drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ; + K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ; + K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ; + K0: drop @ -256 and + ! ; + +\ ---- section 5.9: strings ------------------------------------------------ +: CMOVE ( src dst u -- ) + -if OK drop drop drop NODE-ERROR b! -1 !b ; + OK: if DONE push + over C@ over C! 1 + push 1 + pop pop -1 + jump OK + DONE: drop drop drop ; + +\ ---- section 5.10: the console ------------------------------------------- +: EMIT ( c -- ) CONSOLE-TX b! !b ; +: KEY ( -- c ) + L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ; + WAIT: drop jump L + +\ ---- section 5.8: the number base ---------------------------------------- +: (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36 + BASE b! @b dup -2 + -if L1 drop drop 10 ; + L1: drop dup -37 + -if L2 drop ; + L2: drop drop 10 ; diff --git a/v4/capsule/input.v4 b/v4/capsule/input.v4 new file mode 100644 index 00000000..60056019 --- /dev/null +++ b/v4/capsule/input.v4 @@ -0,0 +1,142 @@ +\ input.v4 -- reading a line and splitting it into words and numbers. +\ +\ DECOMPOSITION.md 5.9: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE +\ CONVERT NUMBER, and the comment words ( and \ of 5.15 (named PAREN and +\ BACKSLASH here, since the text assembler reads those two characters as its +\ own comments; the dictionary will give them their names). Part of the compiler +\ capsule: it runs on the host node. Rests on core.v4. +\ +\ Constants the loader supplies: +\ TIB byte address of the text input buffer, #TIB bytes long +\ #TIB 1025: 1024 characters and a terminating zero, as v3 +\ >IN word address of the variable: offset in TIB of the next character +\ SPAN word address of the variable: how many characters the last +\ EXPECT or QUERY read +\ WBUF byte address of WORD's buffer, 64 bytes +\ (P) word address of six cells of scratch for this file +\ TIB >IN SPAN and BL are in-line: written in a definition they are literals. + +macro BL 32 endmacro + +\ ( -- baddr u ) the input buffer and how much of it is in use +: SOURCE TIB SPAN a! @ -if P drop 0 P: ; + +\ ( baddr u -- ) read a line into u bytes at baddr, as v3's fgets did: at +\ most u-1 characters, stopping after a new-line, which is taken but not +\ stored; then a zero. A line of u-1 characters or more leaves what did not +\ fit, its new-line included, to be read next. SPAN is the number of characters stored. With u = 0 +\ nothing is read or stored; u < 0 does nothing and sets NODE-ERROR. +: EXPECT + -if OK drop drop NODE-ERROR b! -1 !b ; + OK: if ZERO + over push \ p n R: start + L: -1 + if END \ room for the zero only + push KEY dup -10 + if NL \ p c x R: start n + drop over C! 1 + pop jump L + NL: drop drop pop + END: drop 0 over C! \ p + pop - SPAN a! ! ; + ZERO: drop drop 0 SPAN a! ! ; + +\ ( -- ) read a line into TIB and start at its beginning +: QUERY TIB #TIB EXPECT 0 >IN a! ! ; + +\ ---- WORD ------------------------------------------------------------------ +\ (P)+0 the delimiter, (P)+1 the length of the text in TIB. +macro (WDELIM) (P) endmacro +macro (WLEN) (P) 1 + endmacro + +: (LEFT) ( i -- i d ) dup (WLEN) a! @ - ; \ d < 0 while i is inside the text +: (CH) ( i -- i x ) dup TIB + C@ (WDELIM) a! @ xor ; \ x = 0 at a delimiter +: (SKIP) ( i -- i' ) \ past delimiters + L: (LEFT) -if E drop (CH) if S drop ; + S: drop 1 + jump L + E: drop ; +: (SCAN) ( i -- i' ) \ up to a delimiter + L: (LEFT) -if E drop (CH) if E drop 1 + jump L + E: drop ; + +\ ( c -- baddr ) the next word of TIB delimited by c, as a counted string +\ in WBUF with a zero after it. Leading delimiters are skipped; so, as in +\ v3, are all those that follow the word. A word longer than 62 characters +\ is cut to 62. At the end of the text the count is 0. +: WORD + 255 and (WDELIM) a! ! + SPAN a! @ -if A drop 0 A: (WLEN) a! ! + >IN a! @ -if B drop 0 B: + (SKIP) dup push (SCAN) \ end R: start + pop over over - \ end start len + dup -63 + -if CAP drop jump FITS CAP: drop drop 62 FITS: + dup WBUF C! + dup push push TIB + WBUF 1 + pop CMOVE \ end R: len + 0 pop WBUF + 1 + C! + (SKIP) >IN a! ! WBUF ; + +\ ---- ENCLOSE --------------------------------------------------------------- +\ (P)+0 the delimiter, (P)+1 the string's address. +: (E?) ( i -- i k ) \ k: 0 at the end of the string, 1 at a delimiter, else 2 + dup (WLEN) a! @ + C@ if END (WDELIM) a! @ xor if DEL drop 2 ; + DEL: drop 1 ; + END: drop 0 ; +: (ESKIP) ( i -- i' ) L: (E?) -1 + if S drop ; S: drop 1 + jump L +: (ESCAN) ( i -- i' ) L: (E?) -2 + if S drop ; S: drop 1 + jump L + +\ ( baddr c -- baddr n1 n2 n3 ) in the zero-terminated string at baddr: +\ n1 the offset of the first character that is not c, n2 the offset of the +\ first c after it, n3 the offset of the first character after that run of c. +: ENCLOSE + 255 and (WDELIM) a! ! dup (WLEN) a! ! + 0 (ESKIP) dup (ESCAN) dup (ESKIP) ; + +\ ---- CONVERT and NUMBER ---------------------------------------------------- +\ ( c -- n ) the value of the digit c, 0 .. 35, in either case; -1 if none +: (DIGIT) + dup -48 + -if GE0 drop drop -1 ; + GE0: drop dup -58 + -if GT9 drop -48 + ; + GT9: drop dup -65 + -if GEA drop drop -1 ; + GEA: drop dup -91 + -if GTZ drop -55 + ; + GTZ: drop dup -97 + -if GEa drop drop -1 ; + GEa: drop dup -123 + -if GTz drop -87 + ; + GTz: drop drop -1 ; + +\ ( d1 baddr1 -- d2 baddr2 ) FORTH-79: the characters from baddr1 + 1 on are +\ taken as digits in the current BASE, each accumulated into the double after +\ it is multiplied by BASE, until one is not a digit; baddr2 is its address. +\ (P)+2 holds the digit while the double is multiplied and (P)+5 the address, +\ so nothing waits on the return stack across the calls. +: CONVERT + L: 1 + dup (P) 5 + a! ! C@ (DIGIT) \ lo hi n + -if DIG drop (P) 5 + a! @ ; + DIG: dup (BASE) - -if BIG + drop (P) 2 + a! ! \ lo hi + (BASE) UM* drop \ lo hi*base + SWAP (BASE) UM* \ hi*base plo phi + push SWAP pop + \ plo hi' + (P) 2 + a! @ 0 D+ + (P) 5 + a! @ jump L + BIG: drop drop (P) 5 + a! @ ; + +\ ( baddr -- d ) FORTH-79: the counted string at baddr as a signed double in +\ the current BASE; it may begin with a minus sign. If it is empty, is only +\ a sign, or holds anything that is not a digit, the result is 0 and +\ NODE-ERROR is set. The character after the string must not be a digit +\ (WORD puts a zero there); if it is, that too is reported as an error. (P)+3 the address of its last character, (P)+4 the sign. +: NUMBER + dup C@ if ERR2 + over + (P) 3 + a! ! \ baddr + dup 1 + C@ -45 + if NEG + drop 0 (P) 4 + a! ! jump GO + NEG: drop -1 (P) 4 + a! ! 1 + + dup (P) 3 + a! @ xor if ERR2 drop + GO: push 0 0 pop CONVERT \ lo hi baddr2 + (P) 3 + a! @ 1 + xor if FINE + drop drop drop jump ERR0 + FINE: drop (P) 4 + a! @ if POS drop jump DNEGATE + POS: drop ; + ERR2: drop drop + ERR0: NODE-ERROR b! -1 !b 0 0 ; + +\ ---- comments (5.15) ------------------------------------------------------- +\ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line. +: PAREN 41 WORD drop ; +: BACKSLASH SPAN a! @ >IN a! ! ; diff --git a/v4/include/v4/text.h b/v4/include/v4/text.h index 9d8aeac8..6cc006b0 100644 --- a/v4/include/v4/text.h +++ b/v4/include/v4/text.h @@ -101,7 +101,7 @@ typedef struct { unsigned line; int failed; - char message[160]; + char message[224]; } v4_text; /* Start assembling at word address `origin` of node `n`. */ @@ -115,6 +115,9 @@ void v4_text_constant(v4_text *t, const char *name, v4_cell value); * has been no error. */ int v4_text_assemble(v4_text *t, const char *source); +/* The same for the text in the file at `path`. Its errors name the file. */ +int v4_text_assemble_file(v4_text *t, const char *path); + /* Finish: every branch must have found its target. Returns 1 if there has * been no error. Assembling may continue afterwards. */ int v4_text_finish(v4_text *t); diff --git a/v4/src/text.c b/v4/src/text.c index 123eb032..c69c8f6c 100644 --- a/v4/src/text.c +++ b/v4/src/text.c @@ -394,6 +394,35 @@ int v4_text_assemble(v4_text *t, const char *source) return !t->failed; } +int v4_text_assemble_file(v4_text *t, const char *path) +{ + const char *base = strrchr(path, '/'); + char *text = NULL, was[sizeof t->message]; + long size = 0; + FILE *f; + + if (t->failed) return 0; + base = base ? base + 1 : path; + f = fopen(path, "rb"); + if (f && fseek(f, 0, SEEK_END) == 0 && (size = ftell(f)) >= 0 && fseek(f, 0, SEEK_SET) == 0) + text = malloc((size_t)size + 1u); + if (!text || fread(text, 1, (size_t)size, f) != (size_t)size) { + if (f) fclose(f); + free(text); + t->line = 0; + fail(t, "cannot read", path); + return 0; + } + fclose(f); + text[size] = 0; + if (!v4_text_assemble(t, text)) { + memcpy(was, t->message, sizeof was); + snprintf(t->message, sizeof t->message, "%.40s, %.170s", base, was); + } + free(text); + return !t->failed; +} + int v4_text_finish(v4_text *t) { if (t->failed) return 0; diff --git a/v4/tests/test_host_input.c b/v4/tests/test_host_input.c new file mode 100644 index 00000000..a7508285 --- /dev/null +++ b/v4/tests/test_host_input.c @@ -0,0 +1,535 @@ +/* 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 +#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) + +/* 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; +}