admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a041b401ea34fbf528a2ce9925ccbc4f89a8dc49
LithosAnanake/v4/tests/test_strings.c
T
rajamesandClaude Opus 5.5 b137678691 fix(v4.0.0): MOVE follows FORTH-79 
MOVE moves n cells, the cell at addr1 first, and nothing for n <= 0.
v3's moved bytes like memmove; CMOVE and CMOVE> do that.

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

718 lines
33 KiB
C
Raw Blame History

/* test_strings.c -- the byte-string words, executed.
*
* DECOMPOSITION.md 5.3 and 5.9: FILL ERASE MOVE, COUNT CMOVE CMOVE> BLANK
* -TRAILING COMPARE SEARCH SCAN SKIP. All are loops over C@ and C!, which
* are assembled again here as they are in test_foundation.c, on a node of
* its own.
*
* Behaviour follows v3 (v3/src/word_source/string_words.c, memory_words.c):
* COUNT ( baddr -- baddr+1 c )
* CMOVE ( src dst u -- ) low byte first
* CMOVE> ( src dst u -- ) high byte first
* MOVE ( addr1 addr2 n -- ) FORTH-79 (ruled 2026-10-04): n cells
* from addr1 to addr2, the cell at addr1
* first; nothing for n <= 0. The addresses
* are word addresses (D-1). v3's MOVE moved
* bytes, either way round, like memmove.
* FILL ( baddr u c -- ) the low byte of c
* BLANK ERASE ( baddr u -- ) FILL with 32, with 0
* -TRAILING ( baddr u -- baddr u' ) without its trailing spaces
* COMPARE ( a1 u1 a2 u2 -- n ) -1, 0 or 1: the first differing
* byte (unsigned), else the shorter is less
* SEARCH ( a1 u1 a2 u2 -- a3 u3 f ) the first place string 2 occurs in
* string 1: the rest of string 1 from there
* and -1, or string 1 and 0; an empty
* string 2 is found at the start
* SCAN ( baddr u c -- baddr' u' ) from the first byte equal to c
* SKIP ( baddr u c -- baddr' u' ) past the leading bytes equal to c
* A negative count reads as 0 in -TRAILING, COMPARE, SEARCH, SCAN and SKIP,
* as in v3. In CMOVE, CMOVE>, MOVE, FILL, BLANK and ERASE it does nothing
* and sets NODE-ERROR, where v3 raised its error flag (or, in FILL, read it
* as a huge unsigned count).
*
* Where v4 parts from v3: v3's -TRAILING, COMPARE, SEARCH, SCAN, SKIP and
* BLANK took a string whose first byte equalled its length to be a counted
* string and stepped over that byte. 5.9 does not keep that for COMPARE and
* SEARCH; it is not kept for the others either. Addresses are not
* range-checked (open, node.h).
*
* Five transcripts of the real v3 binary are recorded below as expected
* results, taken on 2026-10-03 as in test_numout.c.
*/
#include "v4/asm.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
#include <string.h>
static int failures = 0, checks = 0;
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
#define CANARY ((v4_cell)0x0C0FFEE5)
/* The memory map is open (D-4); the test chooses the addresses. */
#define NODE_ERROR ((v4_cell)(V4_NODE_WORDS - 2u))
#define SV ((v4_cell)(V4_NODE_WORDS - 12u)) /* (S): COMPARE's and SEARCH's lengths and addresses, 4 cells */
#define BUFW ((v4_cell)(V4_NODE_WORDS - 96u)) /* 64 cells = 256 bytes of text */
#define BUF ((v4_cell)(BUFW * 4))
#define BUFLEN 256
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_asm as;
static v4_cell w_cfetch, w_cstore, w_count, w_cmove, w_cmoveup, w_move, w_fill,
w_blank, w_erase, w_trailing, w_compare, w_search, w_scan, w_skip;
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
#define CALL(w) v4_asm_branch(&as, V4_OP_CALL, (w))
#define JUMP(w) v4_asm_branch(&as, V4_OP_JUMP, (w))
#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
#define VGET(a) do { LIT(a); O(BANG_B); O(FETCH_B); } while (0)
#define VSET(a) do { LIT(a); O(BANG_B); O(STORE_B); } while (0)
#define SWAP_INLINE() do { O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); } while (0)
#define NROT_INLINE() do { SWAP_INLINE(); O(PUSH); SWAP_INLINE(); O(RPOP); } while (0)
#define SUB_INLINE() do { O(PUSH); O(INV); O(RPOP); O(ADD); O(INV); } while (0)
#define ERROR_EXIT() do { LIT(NODE_ERROR); O(BANG_B); LIT(-1); O(STORE_B); O(SEMI); } while (0)
static void build(void)
{
v4_asm_ref a, b, c;
v4_cell l, l2;
/* C@ and C!, call-free, as in test_foundation.c. */
w_cfetch = v4_asm_label(&as);
{
v4_asm_ref f0, f1, f2;
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f2, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f1, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
}
{
v4_asm_ref k0, k1, k2;
w_cstore = v4_asm_label(&as);
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A);
LIT(3); O(AND); O(PUSH); LIT(255); O(AND); O(RPOP);
k0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT((v4_cell)(v4_ucell)0xFF000000u); O(INV); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k2, v4_asm_label(&as));
O(DROP); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-16711681); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k1, v4_asm_label(&as));
O(DROP); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-65281); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI);
}
/* : COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ; */
w_count = v4_asm_label(&as);
O(DUP); CALL(w_cfetch); O(PUSH); LIT(1); O(ADD); O(RPOP); O(SEMI);
/* : CMOVE ( src dst u -- )
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
* OK: if DONE push src dst R: u
* over C@ over C! 1 + push 1 + pop pop -1 + jump OK
* DONE: drop drop drop ; */
w_cmove = v4_asm_label(&as);
a = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
HERE_(a);
l = v4_asm_label(&as);
b = FWD(IF);
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cstore);
LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(b);
O(DROP); O(DROP); O(DROP); O(SEMI);
/* : CMOVE> ( src dst u -- )
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
* OK: if DONE -1 + push src dst R: i = u - 1
* over pop dup push + C@ src dst c
* over pop dup push + C! src dst
* pop jump OK
* DONE: drop drop drop ; */
w_cmoveup = v4_asm_label(&as);
a = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
HERE_(a);
l = v4_asm_label(&as);
b = FWD(IF);
LIT(-1); O(ADD); O(PUSH);
O(OVER); O(RPOP); O(DUP); O(PUSH); O(ADD); CALL(w_cfetch);
O(OVER); O(RPOP); O(DUP); O(PUSH); O(ADD); CALL(w_cstore);
O(RPOP);
JUMP(l);
HERE_(b);
O(DROP); O(DROP); O(DROP); O(SEMI);
/* : MOVE ( addr1 addr2 n -- ) FORTH-79: cells, low address first
* -if OK drop drop drop ; n < 0
* OK: if DONE push addr1 addr2 R: n
* over a! @ over a! ! 1 + push 1 + pop pop -1 + jump OK
* DONE: drop drop drop ; */
w_move = v4_asm_label(&as);
a = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); O(SEMI);
HERE_(a);
l = v4_asm_label(&as);
b = FWD(IF);
O(PUSH); O(OVER); O(BANG_A); O(FETCH_A); O(OVER); O(BANG_A); O(STORE_A);
LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(b);
O(DROP); O(DROP); O(DROP); O(SEMI);
/* : FILL ( baddr u c -- )
* -ROT c baddr u
* -if OK drop drop drop NODE-ERROR b! -1 !b ; u < 0
* OK: if DONE push over over C! 1 + pop -1 + jump OK
* DONE: drop drop drop ; */
w_fill = v4_asm_label(&as);
NROT_INLINE();
a = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); ERROR_EXIT();
HERE_(a);
l = v4_asm_label(&as);
b = FWD(IF);
O(PUSH); O(OVER); O(OVER); CALL(w_cstore); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(b);
O(DROP); O(DROP); O(DROP); O(SEMI);
/* : BLANK ( baddr u -- ) 32 jump FILL : ERASE ( baddr u -- ) 0 jump FILL */
w_blank = v4_asm_label(&as);
LIT(32); JUMP(w_fill);
w_erase = v4_asm_label(&as);
LIT(0); JUMP(w_fill);
/* : -TRAILING ( baddr u -- baddr u' )
* -if L drop 0 ; u < 0
* L: if DONE over over + -1 + C@ -32 + if SP drop ; not a space
* SP: drop -1 + jump L
* DONE: ; */
w_trailing = v4_asm_label(&as);
a = FWD(MINUS_IF);
O(DROP); LIT(0); O(SEMI);
HERE_(a);
l = v4_asm_label(&as);
b = FWD(IF);
O(OVER); O(OVER); O(ADD); LIT(-1); O(ADD); CALL(w_cfetch); LIT(-32); O(ADD);
c = FWD(IF);
O(DROP); O(SEMI);
HERE_(c);
O(DROP); LIT(-1); O(ADD); JUMP(l);
HERE_(b);
O(SEMI);
/* : COMPARE ( a1 u1 a2 u2 -- n )
* -if A drop 0 A: (S) 1 + b! !b a1 u1 a2
* SWAP -if B drop 0 B: dup (S) b! !b a1 a2 u1
* (S) 1 + b! @b a1 a2 u1 u2
* over over - -if GE drop drop jump M the smaller
* GE: drop push drop pop
* M: a1 a2 m
* L: if EQ push a1 a2 R: m
* over C@ over C@ - if SAME c1 - c2
* -if GT drop drop drop pop drop -1 ;
* GT: drop drop drop pop drop 1 ;
* SAME: drop 1 + push 1 + pop pop -1 + jump L
* EQ: drop drop drop (S) b! @b (S) 1 + b! @b - u1 - u2
* -if NN drop -1 ;
* NN: if ZZ drop 1 ;
* ZZ: ;
* SWAP and the subtractions are in line. The two clamped lengths wait
* in the variable (S). */
w_compare = v4_asm_label(&as);
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
VSET(SV + 1);
SWAP_INLINE();
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
O(DUP); VSET(SV);
VGET(SV + 1);
O(OVER); O(OVER); SUB_INLINE(); a = FWD(MINUS_IF);
O(DROP); O(DROP); b = FWD(JUMP);
HERE_(a);
O(DROP); O(PUSH); O(DROP); O(RPOP);
HERE_(b);
l = v4_asm_label(&as);
a = FWD(IF);
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cfetch); SUB_INLINE();
b = FWD(IF);
c = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP); LIT(-1); O(SEMI);
HERE_(c);
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP); LIT(1); O(SEMI);
HERE_(b);
O(DROP); LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(a);
O(DROP); O(DROP); O(DROP); VGET(SV); VGET(SV + 1); SUB_INLINE();
a = FWD(MINUS_IF);
O(DROP); LIT(-1); O(SEMI);
HERE_(a);
b = FWD(IF);
O(DROP); LIT(1); O(SEMI);
HERE_(b);
O(SEMI);
/* : SEARCH ( a1 u1 a2 u2 -- a3 u3 flag )
* -if A drop 0 A: (S) 1 + b! !b (S) b! !b a1 u1 (S): a2 u2
* -if B drop 0 B: dup (S) 3 + b! !b over (S) 2 + b! !b a u (S)+2: a1 u1
* L: dup (S) 1 + b! @b - -if TRY u - u2
* drop drop drop (S) 2 + b! @b (S) 3 + b! @b 0 ; not found
* TRY: drop over (S) b! @b (S) 1 + b! @b a u p q k
* I: if MATCH push a u p q R: k
* over C@ over C@ xor if SAME
* drop drop drop pop drop push 1 + pop -1 + jump L next place
* SAME: drop 1 + push 1 + pop pop -1 + jump I
* MATCH: drop drop drop -1 ; */
w_search = v4_asm_label(&as);
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
VSET(SV + 1); VSET(SV);
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
O(DUP); VSET(SV + 3); O(OVER); VSET(SV + 2);
l = v4_asm_label(&as);
O(DUP); VGET(SV + 1); SUB_INLINE(); a = FWD(MINUS_IF);
O(DROP); O(DROP); O(DROP); VGET(SV + 2); VGET(SV + 3); LIT(0); O(SEMI);
HERE_(a);
O(DROP); O(OVER); VGET(SV); VGET(SV + 1);
l2 = v4_asm_label(&as);
a = FWD(IF);
O(PUSH); O(OVER); CALL(w_cfetch); O(OVER); CALL(w_cfetch); O(XOR);
b = FWD(IF);
O(DROP); O(DROP); O(DROP); O(RPOP); O(DROP);
O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(b);
O(DROP); LIT(1); O(ADD); O(PUSH); LIT(1); O(ADD); O(RPOP); O(RPOP); LIT(-1); O(ADD);
JUMP(l2);
HERE_(a);
O(DROP); O(DROP); O(DROP); LIT(-1); O(SEMI);
/* : SCAN ( baddr u c -- baddr' u' )
* 255 and push -if L drop 0 baddr u R: c
* L: if DONE over C@ pop dup push xor if FOUND
* drop push 1 + pop -1 + jump L
* FOUND: drop
* DONE: pop drop ; */
w_scan = v4_asm_label(&as);
LIT(255); O(AND); O(PUSH);
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
l = v4_asm_label(&as);
a = FWD(IF);
O(OVER); CALL(w_cfetch); O(RPOP); O(DUP); O(PUSH); O(XOR); b = FWD(IF);
O(DROP); O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(b);
O(DROP);
HERE_(a);
O(RPOP); O(DROP); O(SEMI);
/* : SKIP ( baddr u c -- baddr' u' )
* 255 and push -if L drop 0 baddr u R: c
* L: if DONE over C@ pop dup push xor if SAME drop jump DONE
* SAME: drop push 1 + pop -1 + jump L
* DONE: pop drop ; */
w_skip = v4_asm_label(&as);
LIT(255); O(AND); O(PUSH);
a = FWD(MINUS_IF); O(DROP); LIT(0); HERE_(a);
l = v4_asm_label(&as);
a = FWD(IF);
O(OVER); CALL(w_cfetch); O(RPOP); O(DUP); O(PUSH); O(XOR); b = FWD(IF);
O(DROP); c = FWD(JUMP);
HERE_(b);
O(DROP); O(PUSH); LIT(1); O(ADD); O(RPOP); LIT(-1); O(ADD);
JUMP(l);
HERE_(a); HERE_(c);
O(RPOP); O(DROP); O(SEMI);
}
/* ---- running ---------------------------------------------------------- */
/* The test's own copy of the 256 text bytes; the node's are compared with
* it after every call. */
static unsigned char img[BUFLEN];
static unsigned char node_byte(v4_cell baddr)
{
return (unsigned char)(((v4_ucell)n.mem[baddr >> 2] >> (8u * (unsigned)(baddr & 3))) & 0xFFu);
}
static void load_img(void)
{
unsigned i;
for (i = 0; i < BUFLEN / 4; i++) {
v4_ucell w = (v4_ucell)img[4 * i] | ((v4_ucell)img[4 * i + 1] << 8)
| ((v4_ucell)img[4 * i + 2] << 16) | ((v4_ucell)img[4 * i + 3] << 24);
n.mem[BUFW + (v4_cell)i] = (v4_cell)w;
}
}
static int img_matches(void)
{
unsigned i;
for (i = 0; i < BUFLEN; i++) if (node_byte(BUF + (v4_cell)i) != img[i]) return 0;
for (i = 0; i < BUFLEN / 4; i++) /* nothing above byte 3 of a cell either */
if (((v4_ucell)n.mem[BUFW + (v4_cell)i] >> 16 >> 16) != 0) return 0;
return 1;
}
/* Runs `word` on argc arguments over the current img; true when it returns.
* The results are then popped with res(). */
static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c, v4_cell d)
{
v4_cell args[4];
unsigned i;
args[0] = a; args[1] = b; args[2] = c; args[3] = d;
load_img();
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
v4_heat_reset(&h);
v4_node_store(&n, NODE_ERROR, 0);
v4_dstack_push(&n.ds, CANARY);
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, args[i]);
return v4_test_call(&n, &es, &h, word, 4000000) > 0;
}
static v4_cell res(void) { return v4_dstack_pop(&n.ds); }
static int clean(void) { return v4_dstack_pop(&n.ds) == CANARY; }
static int err(void) { return v4_node_load(&n, NODE_ERROR) != 0; }
/* Stack headroom, as in test_foundation.c: the results and the bytes must
* be what a run with empty stacks gave. */
static int fits(v4_cell word, unsigned argc, const v4_cell *args, unsigned nres, const v4_cell *want,
const unsigned char *img0, const unsigned char *img1, unsigned dfill, unsigned rfill)
{
unsigned i;
memcpy(img, img0, BUFLEN);
load_img();
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
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 (v4_test_call(&n, &es, &h, word, 4000000) <= 0) return 0;
for (i = nres; i-- > 0; ) if (v4_dstack_pop(&n.ds) != want[i]) return 0;
if (v4_dstack_pop(&n.ds) != CANARY) return 0;
for (i = dfill; i-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + i)) return 0;
for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0;
memcpy(img, img1, BUFLEN);
return img_matches();
}
static void headroom(const char *name, v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c, v4_cell d,
unsigned nres, int min_d, int min_r)
{
unsigned char img0[BUFLEN], img1[BUFLEN];
v4_cell args[4], want[4];
unsigned i;
int dh, rh;
args[0] = a; args[1] = b; args[2] = c; args[3] = d;
memcpy(img0, img, BUFLEN);
CHECK(call(word, argc, a, b, c, d), "%s runs", name);
for (i = nres; i-- > 0; ) want[i] = res();
for (i = 0; i < BUFLEN; i++) img1[i] = node_byte(BUF + (v4_cell)i);
for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(word, argc, args, nres, want, img0, img1, (unsigned)dh + 1u, 0)) break;
for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(word, argc, args, nres, want, img0, img1, 0, (unsigned)rh + 1u)) break;
printf(" %s 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);
memcpy(img, img0, BUFLEN);
}
/* ---- the C reference ---------------------------------------------------- */
static uint32_t rng = 0x9E3779B9u;
static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; }
static void random_img(unsigned alphabet)
{
unsigned i;
for (i = 0; i < BUFLEN; i++)
img[i] = (unsigned char)(alphabet ? 'a' + rnd() % alphabet : rnd() & 0xFFu);
}
static void text_at(unsigned off, const char *s) { memcpy(img + off, s, strlen(s)); }
static int ref_compare(unsigned o1, long u1, unsigned o2, long u2)
{
long m, i;
if (u1 < 0) u1 = 0;
if (u2 < 0) u2 = 0;
m = u1 < u2 ? u1 : u2;
for (i = 0; i < m; i++)
if (img[o1 + i] != img[o2 + i]) return img[o1 + i] < img[o2 + i] ? -1 : 1;
return u1 < u2 ? -1 : (u1 > u2 ? 1 : 0);
}
/* Returns the offset of the match in string 1, or -1. */
static long ref_search(unsigned o1, long u1, unsigned o2, long u2)
{
long i;
if (u1 < 0) u1 = 0;
if (u2 < 0) u2 = 0;
for (i = 0; i + u2 <= u1; i++)
if (u2 == 0 || memcmp(img + o1 + i, img + o2, (size_t)u2) == 0) return i;
return -1;
}
int main(void)
{
unsigned char before[BUFLEN];
unsigned i, t;
printf("v4 string tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
v4_node_reset(&n);
v4_asm_begin(&as, &n, 16);
build();
CHECK(v4_asm_ok(&as), "string words assemble");
CHECK(v4_asm_label(&as) < BUFW, "code stays below the text");
printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS);
/* ---- the v3 transcripts ---- */
/* S" abc" S" abd" COMPARE . abc abc abd abc ab abc abc ab -> -1 0 1 -1 1 */
memset(img, 0, BUFLEN);
text_at(0, "abc"); text_at(8, "abd"); text_at(16, "abc"); text_at(24, "ab");
CHECK(call(w_compare, 4, BUF, 3, BUF + 8, 3) && res() == -1 && clean(), "v3: abc abd COMPARE");
CHECK(call(w_compare, 4, BUF, 3, BUF + 16, 3) && res() == 0 && clean(), "v3: abc abc COMPARE");
CHECK(call(w_compare, 4, BUF + 8, 3, BUF, 3) && res() == 1 && clean(), "v3: abd abc COMPARE");
CHECK(call(w_compare, 4, BUF + 24, 2, BUF, 3) && res() == -1 && clean(), "v3: ab abc COMPARE");
CHECK(call(w_compare, 4, BUF, 3, BUF + 24, 2) && res() == 1 && clean(), "v3: abc ab COMPARE");
/* S" hello world" S" o w" SEARCH . . DROP -> -1 7
* S" hello world" S" xyz" SEARCH . . DROP -> 0 11
* S" hello" S" " SEARCH . . DROP -> -1 5 */
memset(img, 0, BUFLEN);
text_at(1, "hello world"); text_at(32, "o w"); text_at(40, "xyz");
CHECK(call(w_search, 4, BUF + 1, 11, BUF + 32, 3) && res() == -1 && res() == 7 && res() == BUF + 5 && clean(),
"v3: hello world / o w SEARCH");
CHECK(call(w_search, 4, BUF + 1, 11, BUF + 40, 3) && res() == 0 && res() == 11 && res() == BUF + 1 && clean(),
"v3: hello world / xyz SEARCH");
CHECK(call(w_search, 4, BUF + 1, 5, BUF + 40, 0) && res() == -1 && res() == 5 && res() == BUF + 1 && clean(),
"v3: hello / empty SEARCH");
/* S" hi " -TRAILING . DROP S" aaab" 97 SKIP . DROP S" hello" 108 SCAN . DROP
* S" hello" 122 SCAN . DROP S" " -TRAILING . DROP -> 2 1 3 0 0 */
memset(img, 0, BUFLEN);
text_at(2, "hi "); text_at(16, "aaab"); text_at(33, "hello"); text_at(48, " ");
CHECK(call(w_trailing, 2, BUF + 2, 5, 0, 0) && res() == 2 && res() == BUF + 2 && clean(), "v3: -TRAILING");
CHECK(call(w_skip, 3, BUF + 16, 4, 97, 0) && res() == 1 && res() == BUF + 19 && clean(), "v3: SKIP");
CHECK(call(w_scan, 3, BUF + 33, 5, 108, 0) && res() == 3 && res() == BUF + 35 && clean(), "v3: SCAN");
CHECK(call(w_scan, 3, BUF + 33, 5, 122, 0) && res() == 0 && res() == BUF + 38 && clean(), "v3: SCAN, absent");
CHECK(call(w_trailing, 2, BUF + 48, 4, 0, 0) && res() == 0 && res() == BUF + 48 && clean(), "v3: -TRAILING, all spaces");
/* CREATE B 16 ALLOT B 16 46 FILL B 4 BLANK B 8 + 3 ERASE B 16 DUMP
* 20 20 20 20 2E 2E 2E 2E 00 00 00 2E 2E 2E 2E 2E
* "ABCDEF" B 6 CMOVE B B 2 + 6 CMOVE> B B 1 + 6 CMOVE B 16 DUMP
* 41 41 41 41 41 41 41 46 00 00 00 2E 2E 2E 2E 2E
* (v3 went on to B 3 + B 5 MOVE, a byte move; MOVE here is FORTH-79's and moves cells.) */
{
static const unsigned char d1[16] = { 0x20,0x20,0x20,0x20,0x2E,0x2E,0x2E,0x2E,0,0,0,0x2E,0x2E,0x2E,0x2E,0x2E };
static const unsigned char d2[16] = { 0x41,0x41,0x41,0x41,0x41,0x41,0x41,0x46,0,0,0,0x2E,0x2E,0x2E,0x2E,0x2E };
const v4_cell B = BUF + 21;
#define STEP(word, argc, a, b, c) do { \
CHECK(call(word, argc, a, b, c, 0) && clean() && !err(), "v3 block-copy step returns"); \
for (i = 0; i < BUFLEN; i++) img[i] = node_byte(BUF + (v4_cell)i); } while (0)
memset(img, 0x77, BUFLEN);
text_at(100, "ABCDEF");
STEP(w_fill, 3, B, 16, 46);
STEP(w_blank, 2, B, 4, 0);
STEP(w_erase, 2, B + 8, 3, 0);
CHECK(memcmp(img + 21, d1, 16) == 0, "v3: FILL, BLANK, ERASE");
STEP(w_cmove, 3, BUF + 100, B, 6);
STEP(w_cmoveup, 3, B, B + 2, 6);
STEP(w_cmove, 3, B, B + 1, 6);
CHECK(memcmp(img + 21, d2, 16) == 0, "v3: CMOVE, CMOVE>, CMOVE");
for (i = 0; i < BUFLEN; i++)
if ((i < 21 || i >= 37) && (i < 100 || i >= 106) && img[i] != 0x77) break;
CHECK(i == BUFLEN, "nothing outside B was written");
}
/* 3 B C! 65 66 67 ... B COUNT . B - . -> 3 1 */
memset(img, 0, BUFLEN);
img[9] = 3; text_at(10, "ABC");
CHECK(call(w_count, 1, BUF + 9, 0, 0, 0) && res() == 3 && res() == BUF + 10 && clean(), "v3: COUNT");
/* ---- against C ---- */
/* COUNT: every byte value, every position in a cell */
random_img(0);
for (i = 0; i < BUFLEN; i++)
CHECK(call(w_count, 1, BUF + (v4_cell)i, 0, 0, 0) && res() == img[i] && res() == BUF + (v4_cell)i + 1
&& clean() && img_matches(), "COUNT [%u]", i);
/* FILL, BLANK, ERASE */
for (t = 0; t < 400; t++) {
unsigned off = rnd() % 200, len = rnd() % 40;
v4_cell ch = (v4_cell)(rnd() % 3 == 0 ? rnd() : rnd() & 0xFFu);
unsigned which = t % 3;
random_img(0);
memcpy(before, img, BUFLEN);
if (which == 0) { CHECK(call(w_fill, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && clean(), "FILL returns"); }
else if (which == 1) { CHECK(call(w_blank, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && clean(), "BLANK returns"); ch = 32; }
else { CHECK(call(w_erase, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && clean(), "ERASE returns"); ch = 0; }
memset(img + off, (int)((v4_ucell)ch & 0xFFu), len);
CHECK(img_matches() && !err(), "FILL/BLANK/ERASE [%u] off %u len %u", t, off, len);
}
/* CMOVE, CMOVE>, MOVE: apart and overlapping both ways */
for (t = 0; t < 900; t++) {
unsigned len = rnd() % 48, src = rnd() % (BUFLEN - 48), dst;
unsigned which = t % 3, k;
if (t % 2) dst = rnd() % (BUFLEN - 48);
else { int d = (int)(rnd() % 17) - 8; dst = (unsigned)((int)src + d < 0 ? 0 : (int)src + d); if (dst > BUFLEN - 48) dst = BUFLEN - 48; }
random_img(0);
if (which == 2) { /* MOVE: cells, not bytes */
len /= 4; src /= 4; dst /= 4;
CHECK(call(w_move, 3, BUFW + (v4_cell)src, BUFW + (v4_cell)dst, (v4_cell)len, 0) && clean(), "MOVE returns [%u]", t);
for (k = 0; k < 4 * len; k++) img[4 * dst + k] = img[4 * src + k];
} else {
CHECK(call(which == 0 ? w_cmove : w_cmoveup, 3,
BUF + (v4_cell)src, BUF + (v4_cell)dst, (v4_cell)len, 0) && clean(), "move returns [%u]", t);
if (which == 0) for (k = 0; k < len; k++) img[dst + k] = img[src + k];
else for (k = len; k-- > 0; ) img[dst + k] = img[src + k];
}
CHECK(img_matches() && !err(), "%s [%u] src %u dst %u len %u",
which == 0 ? "CMOVE" : which == 1 ? "CMOVE>" : "MOVE", t, src, dst, len);
}
/* a negative count: nothing written, NODE-ERROR set */
{
static const v4_cell neg[] = { -1, -7, (v4_cell)V4_MSB };
random_img(0);
for (i = 0; i < 3; i++) {
CHECK(call(w_cmove, 3, BUF, BUF + 50, neg[i], 0) && clean() && img_matches() && err(), "CMOVE negative count [%u]", i);
CHECK(call(w_cmoveup, 3, BUF, BUF + 50, neg[i], 0) && clean() && img_matches() && err(), "CMOVE> negative count [%u]", i);
CHECK(call(w_move, 3, BUFW, BUFW + 12, neg[i], 0) && clean() && img_matches() && !err(), "MOVE moves nothing for n < 0, up [%u]", i);
CHECK(call(w_move, 3, BUFW + 12, BUFW, neg[i], 0) && clean() && img_matches() && !err(), "MOVE moves nothing for n < 0, down [%u]", i);
CHECK(call(w_fill, 3, BUF, neg[i], 65, 0) && clean() && img_matches() && err(), "FILL negative count [%u]", i);
CHECK(call(w_blank, 2, BUF, neg[i], 0, 0) && clean() && img_matches() && err(), "BLANK negative count [%u]", i);
CHECK(call(w_erase, 2, BUF, neg[i], 0, 0) && clean() && img_matches() && err(), "ERASE negative count [%u]", i);
}
}
/* -TRAILING */
for (t = 0; t < 600; t++) {
unsigned off = rnd() % 200, len = rnd() % 40, sp = rnd() % 41, k, want;
random_img(t % 4 == 0 ? 0 : 3);
for (k = 0; k < sp && k < len; k++) img[off + len - 1 - k] = 32;
if (t % 5 == 0 && len) img[off] = (unsigned char)len; /* v3 would have taken this for a counted string */
for (want = len; want > 0 && img[off + want - 1] == 32; want--) { }
CHECK(call(w_trailing, 2, BUF + (v4_cell)off, (v4_cell)len, 0, 0) && res() == (v4_cell)want
&& res() == BUF + (v4_cell)off && clean() && img_matches() && !err(), "-TRAILING [%u] len %u", t, len);
}
CHECK(call(w_trailing, 2, BUF + 5, -3, 0, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(),
"-TRAILING of a negative count is 0");
/* SCAN and SKIP */
for (t = 0; t < 1200; t++) {
unsigned off = rnd() % 200, len = rnd() % 40, k;
v4_cell ch;
random_img(t % 6 == 0 ? 0 : 2 + t % 3);
ch = (v4_cell)(len && t % 3 ? img[off + rnd() % len] : (unsigned char)rnd());
if (t % 7 == 0) ch += 256 * (v4_cell)(1 + rnd() % 100); /* only the low byte counts */
if (t % 2 == 0) {
for (k = 0; k < len && img[off + k] != ((v4_ucell)ch & 0xFFu); k++) { }
CHECK(call(w_scan, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && res() == (v4_cell)(len - k)
&& res() == BUF + (v4_cell)(off + k) && clean() && img_matches() && !err(), "SCAN [%u] len %u", t, len);
} else {
for (k = 0; k < len && img[off + k] == ((v4_ucell)ch & 0xFFu); k++) { }
CHECK(call(w_skip, 3, BUF + (v4_cell)off, (v4_cell)len, ch, 0) && res() == (v4_cell)(len - k)
&& res() == BUF + (v4_cell)(off + k) && clean() && img_matches() && !err(), "SKIP [%u] len %u", t, len);
}
}
CHECK(call(w_scan, 3, BUF + 5, -3, 65, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(), "SCAN of a negative count");
CHECK(call(w_skip, 3, BUF + 5, -3, 65, 0) && res() == 0 && res() == BUF + 5 && clean() && !err(), "SKIP of a negative count");
/* COMPARE */
for (t = 0; t < 3000; t++) {
unsigned o1 = rnd() % 100, o2 = 128 + rnd() % 100;
long u1 = (long)(rnd() % 24), u2 = (long)(rnd() % 24);
int want;
random_img(t % 10 == 0 ? 0 : 2);
if (t % 3 == 0) { unsigned same = rnd() % 24; memcpy(img + o2, img + o1, same); }
if (t % 11 == 0) img[o1 + rnd() % 4] = (unsigned char)(0x80u + rnd() % 128); /* bytes compare unsigned */
if (t % 13 == 0 && u1) img[o1] = (unsigned char)u1; /* not a counted string */
if (t % 50 == 0) u1 = -(long)(1 + rnd() % 5);
if (t % 70 == 0) u2 = -(long)(1 + rnd() % 5);
want = ref_compare(o1, u1, o2, u2);
CHECK(call(w_compare, 4, BUF + (v4_cell)o1, (v4_cell)u1, BUF + (v4_cell)o2, (v4_cell)u2)
&& res() == (v4_cell)want && clean() && img_matches() && !err(),
"COMPARE [%u] u1 %ld u2 %ld want %d", t, u1, u2, want);
}
CHECK(call(w_compare, 4, BUF + 9, 12, BUF + 9, 12) && res() == 0 && clean(), "COMPARE of a string with itself");
/* SEARCH */
for (t = 0; t < 3000; t++) {
unsigned o1 = rnd() % 80, o2 = 160 + rnd() % 60;
long u1 = (long)(rnd() % 40), u2 = (long)(rnd() % 6), at, c1, c2;
v4_cell f, u3, a3;
random_img(t % 10 == 0 ? 0 : 2);
if (t % 3 == 0 && u1 >= u2) memcpy(img + o2, img + o1 + rnd() % (unsigned)(u1 - u2 + 1), (size_t)u2);
if (t % 4 == 0) u2 = (long)(rnd() % 45);
if (t % 50 == 0) u1 = -(long)(1 + rnd() % 5);
if (t % 70 == 0) u2 = -(long)(1 + rnd() % 5);
at = ref_search(o1, u1, o2, u2);
c1 = u1 < 0 ? 0 : u1; c2 = u2;
(void)c2;
CHECK(call(w_search, 4, BUF + (v4_cell)o1, (v4_cell)u1, BUF + (v4_cell)o2, (v4_cell)u2), "SEARCH returns [%u]", t);
f = res(); u3 = res(); a3 = res();
if (at >= 0)
CHECK(f == -1 && u3 == (v4_cell)(c1 - at) && a3 == BUF + (v4_cell)o1 + (v4_cell)at && clean(),
"SEARCH found [%u] u1 %ld u2 %ld at %ld", t, u1, u2, at);
else
CHECK(f == 0 && u3 == (v4_cell)c1 && a3 == BUF + (v4_cell)o1 && clean(),
"SEARCH not found [%u] u1 %ld u2 %ld", t, u1, u2);
CHECK(img_matches() && !err(), "SEARCH writes nothing [%u]", t);
}
/* What they leave their caller (D-2). */
random_img(2);
text_at(40, "needle"); text_at(200, "needle"); text_at(64, "tail ");
headroom("COUNT", w_count, 1, BUF + 3, 0, 0, 0, 2, 6, 6);
headroom("CMOVE", w_cmove, 3, BUF + 3, BUF + 90, 9, 0, 0, 3, 5);
headroom("CMOVE>", w_cmoveup, 3, BUF + 3, BUF + 90, 9, 0, 0, 3, 5);
headroom("MOVE", w_move, 3, BUFW + 1, BUFW + 9, 5, 0, 0, 4, 6);
headroom("FILL", w_fill, 3, BUF + 3, 9, 65, 0, 0, 3, 5);
headroom("BLANK", w_blank, 2, BUF + 3, 9, 0, 0, 0, 3, 5);
headroom("-TRAILING", w_trailing, 2, BUF + 64, 8, 0, 0, 2, 4, 6);
headroom("COMPARE", w_compare, 4, BUF + 40, 6, BUF + 200, 6, 1, 3, 5);
headroom("SEARCH", w_search, 4, BUF + 20, 40, BUF + 200, 6, 3, 2, 5);
headroom("SCAN", w_scan, 3, BUF + 64, 8, 32, 0, 2, 4, 5);
headroom("SKIP", w_skip, 3, BUF + 68, 4, 32, 0, 2, 4, 5);
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