Files
LithosAnanake/v4/tests/test_iword.c
T
rajamesandClaude Opus 5.5 067f317c47 feat(v4.0.0): hosted golden model, single node
First code for StarForth v4 (JUSTIFICATION.md section 10, step 1): one node
of the 32-instruction core as a C99 model, with cell width as a build
parameter.

- Node: P, A, B, F18 circular stacks (10 and 9 deep, D-2), word-addressed
  memory (D-1), 5% guard bands on every bounded list.
- Instruction word: six 5-bit slots in 32 bits at every cell width.
- Executor: all 32 opcodes of DECOMPOSITION.md 1.3. Cell arithmetic wraps
  explicitly; no signed overflow or implementation-defined shift.
- Heat: per-opcode and per-call-target counters and the anti-clock, driven
  by instruction retirement (1.4, D-6 interim).
- Slot packer and runner for tests, and a reference unsigned multiply in
  plain C99 with no 128-bit type.

Tests run at 32- and 64-bit cells, and under ASan and UBSan. They cover
every opcode and execute the first section 4 definitions (NIP SWAP OR
NEGATE ROT 0< 0= 2DUP - U<) against the C operation each stands for.

UM* as written in section 4 is exact only while u1 <= 2^(n-2). Two known
failing cases are pinned in test_foundation.c until it is rewritten.

DECOMPOSITION.md: record D-9, the instruction word is 32 bits at every
cell width (ruled 2026-10-02).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-02 14:38:27 -04:00

401 lines
18 KiB
C

/* test_iword.c -- the instruction-word format.
*
* The properties pinned here are the ones the rest of the machine is built on
* and the ones most likely to be got wrong by a plausible-looking edit:
*
* - the six slots occupy the bit ranges the diagram in section 1.2 gives
* them, with slot 0 highest;
* - the reach column (27 / 22 / 17 / 12 for slots 0-3) is what the layout
* actually produces, rather than four independently-entered constants;
* - branches are illegal in slots 4 and 5;
* - the two spare bits are inert, so a word that differs only in them
* decodes identically;
* - a branch is page-relative: it replaces the low bits of P and preserves
* the rest;
* - no opcode name collides with a FORTH-79 word name, which is the stated
* reason for the `inv` and `xor` renames in section 1.3.
*/
#include "v4/iword.h"
#include <stdio.h>
#include <string.h>
static int failures = 0;
static int checks = 0;
#define CHECK(cond, ...) \
do { \
checks++; \
if (!(cond)) { \
failures++; \
printf(" FAIL %s:%d: ", __FILE__, __LINE__); \
printf(__VA_ARGS__); \
printf("\n"); \
} \
} while (0)
static v4_iword word_of(const unsigned op[6], unsigned spare)
{
return v4_iword_assemble(op, spare);
}
static void test_slot_bit_ranges(void)
{
/* The diagram's own boundaries, entered independently of the macros so the
* macros are checked rather than merely used. */
static const unsigned want_high[6] = { 31, 26, 21, 16, 11, 6 };
static const unsigned want_low[6] = { 27, 22, 17, 12, 7, 2 };
for (unsigned k = 0; k < 6; k++) {
CHECK(V4_SLOT_HIGH_BIT(k) == want_high[k],
"slot %u high bit: macro says %u, diagram says %u", k,
V4_SLOT_HIGH_BIT(k), want_high[k]);
CHECK(V4_SLOT_LOW_BIT(k) == want_low[k],
"slot %u low bit: macro says %u, diagram says %u", k,
V4_SLOT_LOW_BIT(k), want_low[k]);
}
/* Each slot is 5 bits, and the six slots do not overlap. */
for (unsigned k = 0; k < 6; k++) {
CHECK(V4_SLOT_HIGH_BIT(k) - V4_SLOT_LOW_BIT(k) == 4u,
"slot %u is not 5 bits wide", k);
}
CHECK(V4_SLOT_LOW_BIT(5) - V4_SPARE_BITS == 0u,
"slot 5 does not end just above the spare bits");
}
static void test_roundtrip_all_opcodes(void)
{
/* Every one of the 32 opcodes, in every slot, survives assemble+decode. */
for (unsigned op = 0; op < 32u; op++) {
for (unsigned k = 0; k < 6; k++) {
unsigned o[6];
for (unsigned j = 0; j < 6; j++) o[j] = 0x1Du; /* distinct filler */
o[k] = op;
v4_iword w = word_of(o, 0u);
CHECK(w != 0xFFFFFFFFu, "assemble rejected opcode %u", op);
CHECK(v4_iword_op(w, k) == op,
"opcode %u in slot %u decoded as %u", op, k,
v4_iword_op(w, k));
/* And the other slots are undisturbed. */
for (unsigned j = 0; j < 6; j++) {
if (j == k) continue;
CHECK(v4_iword_op(w, j) == 0x1Du,
"assembling %u into slot %u disturbed slot %u", op, k, j);
}
}
}
}
static void test_slots_are_independent(void)
{
/* All 32^6 words cannot be enumerated, but the packing is linear, so
* checking that each slot's bits land only in its own range is enough. */
for (unsigned k = 0; k < 6; k++) {
unsigned o[6] = { 0, 0, 0, 0, 0, 0 };
o[k] = 0x1Fu; /* all five bits set */
v4_iword w = word_of(o, 0u);
v4_iword expect = (v4_iword)0x1Fu << V4_SLOT_LOW_BIT(k);
CHECK(w == expect,
"slot %u: word is %08lX, expected %08lX", k,
(unsigned long)w, (unsigned long)expect);
}
}
static void test_spare_bits_are_inert_for_decode(void)
{
/* The two spare low bits sit below every slot, so they are never executed.
* A word that differs only in them must decode to the same six opcodes --
* otherwise the spare bits would have acquired decode meaning. */
unsigned o[6] = { 2, 3, 5, 6, 7, 1 };
v4_iword a = word_of(o, 0u);
v4_iword b = word_of(o, 3u); /* both spare patterns */
for (unsigned k = 0; k < 6; k++) {
CHECK(v4_iword_op(a, k) == v4_iword_op(b, k),
"spare bits changed the opcode in slot %u", k);
}
CHECK(v4_iword_spare(a) == 0u, "spare bits of word a");
CHECK(v4_iword_spare(b) == 3u, "spare bits of word b");
}
static void test_spare_bits_are_branch_address_bits(void)
{
/* The opposite property, and the one that is easy to get wrong: the spare
* bits are BELOW every slot, so "all bits to the right of its slot" -- the
* branch target, per section 1.2 -- includes them. They are the low bits
* of a branch address, not padding. Pinned here so that a later "cleanup"
* that treats them as unusable address bits fails a test instead of costing
* two bits of reach off every branch in the machine. */
/* Only slot 0 is set, so every bit below it -- all 27 of them, spare bits
* included -- is zero and the branch target is the spare field alone. */
unsigned o[6] = { 2, 0, 0, 0, 0, 0 };
v4_iword a = word_of(o, 0u);
v4_iword b = word_of(o, 3u); /* both spare patterns */
CHECK(v4_iword_op(a, 0) == V4_OP_JUMP, "slot 0 should be jump");
CHECK(v4_iword_target(a, 0u) == 0u,
"word a (spare 0) should have a zero low target field, got %u",
v4_iword_target(a, 0u));
CHECK(v4_iword_target(b, 0u) == 3u,
"word b (spare 3) should carry 3 in the low address bits, got %u",
v4_iword_target(b, 0u));
CHECK(v4_iword_branch((v4_cell)0, a, 0u) == 0, "branch with spare 0");
CHECK(v4_iword_branch((v4_cell)0, b, 0u) == 3,
"branch with spare 3 should land on address 3, got %lld",
(long long)v4_iword_branch((v4_cell)0, b, 0u));
/* Every legal branch slot reaches bit 0, so the spare bits are address in
* all four of them. */
for (unsigned k = 0; k < 4; k++) {
CHECK((v4_iword_slot_mask(k) & 3u) == 3u,
"slot %u branch target does not reach the spare bits", k);
}
}
static void test_reach_column(void)
{
/* The reach table from section 1.2, entered as literals. The
* implementation derives these from the layout; this asserts the two
* agree, which is the whole reason to derive rather than hard-code. */
static const unsigned want_bits[4] = { 27, 22, 17, 12 };
static const unsigned want_reach[4] = {
0x8000000u, /* 2^27 words = whole address space */
0x400000u, /* 2^22 words = 4M words */
0x20000u, /* 2^17 words = 128K words */
0x1000u /* 2^12 words = 4K words */
};
for (unsigned k = 0; k < 4; k++) {
CHECK(V4_BRANCH_ADDR_BITS(k) == want_bits[k],
"slot %u address bits: %u, spec says %u", k,
V4_BRANCH_ADDR_BITS(k), want_bits[k]);
CHECK(v4_iword_slot_mask(k) + 1u == want_reach[k],
"slot %u reach: %u words, spec table implies %u", k,
v4_iword_slot_mask(k) + 1u, want_reach[k]);
}
}
static void test_branch_targets_take_all_low_bits(void)
{
/* A target is every bit to the right of the slot, not just the low 5 or the
* low 12. Set a pattern of all-ones in the low region and confirm each
* slot recovers exactly its own low bits. */
for (unsigned k = 0; k < 4; k++) {
v4_iword w = 0xFFFFFFFFu; /* every slot and spare bit set */
uint32_t t = v4_iword_target(w, k);
uint32_t mask = v4_iword_slot_mask(k);
CHECK(t == mask,
"slot %u target from all-ones word is %08lX, expected %08lX", k,
(unsigned long)t, (unsigned long)mask);
/* And the slot's own five bits must be excluded from its target. */
unsigned op_in_slot = v4_iword_op(w, k);
CHECK(op_in_slot == 0x1Fu, "slot %u opcode from all-ones", k);
}
}
static void test_branch_legality(void)
{
for (unsigned k = 0; k < 4; k++) {
CHECK(v4_iword_branch_legal(k), "slot %u should allow branches", k);
}
for (unsigned k = 4; k < 6; k++) {
CHECK(!v4_iword_branch_legal(k),
"slot %u must not allow branches (section 1.2)", k);
}
}
static void test_page_relative_branch(void)
{
/* "That target replaces the same low bits of P (page-relative, as in the
* F18)." A branch inside one page must not disturb the bits above it, and
* must be able to reach every address in its page. */
for (unsigned k = 0; k < 4; k++) {
uint32_t mask = v4_iword_slot_mask(k);
v4_ucell page = ~(v4_ucell)mask; /* a high value, low bits zero */
v4_cell p = (v4_cell)page;
for (uint32_t target = 0; target <= mask; target = target * 2u + 1u) {
v4_iword w = target; /* target lives in the low bits */
v4_cell got = v4_iword_branch(p, w, k);
v4_ucell want = ((v4_ucell)page & ~(v4_ucell)mask)
| (v4_ucell)target;
CHECK((v4_ucell)got == want,
"slot %u: P=%lld target=%u gave %lld, expected %llu", k,
(long long)p, target, (long long)got,
(unsigned long long)want);
CHECK((v4_ucell)got == (v4_ucell)(page ^ target),
"slot %u: branch is not page-relative", k);
if (target > mask / 2u && target != mask) break;
}
}
}
static void test_page_relative_branch_preserves_high_page(void)
{
/* Same, from several distinct pages, to be sure nothing is hard-wired to
* page zero. */
static const v4_ucell pages[] = {
(v4_ucell)0,
(v4_ucell)1,
(v4_ucell)0x80000000ull,
~(v4_ucell)0
};
for (unsigned k = 0; k < 4; k++) {
uint32_t mask = v4_iword_slot_mask(k);
for (unsigned i = 0; i < sizeof(pages) / sizeof(pages[0]); i++) {
v4_cell p = (v4_cell)pages[i];
v4_cell got = v4_iword_branch(p, 0u, k);
v4_ucell want = (pages[i] & ~(v4_ucell)mask);
CHECK((v4_ucell)got == want,
"slot %u: P=%llX with target 0 gave %llX, expected %llX", k,
(unsigned long long)pages[i], (unsigned long long)got,
(unsigned long long)want);
}
}
}
static void test_branch_opcode_set(void)
{
/* Exactly five opcodes take a target, and they are the five section 1.2
* names. Everything else must not, so that a non-branch slot's low bits
* stay available to the compiler. */
static const int want[32] = {
/* 0 */ 0, /* 1 */ 0, /* 2 jump */ 1, /* 3 call */ 1, /* 4 */ 0,
/* 5 next */ 1, /* 6 if */ 1, /* 7 -if */ 1, /* 8 */ 0, /* 9 */ 0,
/* A */ 0, /* B */ 0, /* C */ 0, /* D */ 0, /* E */ 0, /* F */ 0,
/* 10 */ 0, /* 11 */ 0, /* 12 */ 0, /* 13 */ 0, /* 14 */ 0, /* 15 */ 0,
/* 16 */ 0, /* 17 */ 0, /* 18 */ 0, /* 19 */ 0, /* 1A */ 0,
/* 1B */ 0, /* 1C */ 0, /* 1D */ 0, /* 1E */ 0, /* 1F */ 0
};
unsigned nbranch = 0;
for (unsigned op = 0; op < 32u; op++) {
int got = v4_op_is_branch(op);
CHECK(got == want[op], "opcode %02X: is_branch=%d, expected %d", op,
got, want[op]);
nbranch += (unsigned)got;
}
CHECK(nbranch == 5u, "expected exactly 5 branch opcodes, found %u", nbranch);
}
static void test_opcode_enum_matches_spec_numbering(void)
{
/* Each named opcode must carry the number section 1.3 gives it. Transposed
* or off-by-one enum entries are the classic way a 32-entry table rots. */
CHECK(V4_OP_SEMI == 0x00, "opcode ;"); CHECK(V4_OP_EX == 0x01, "opcode ex");
CHECK(V4_OP_JUMP == 0x02, "opcode jump"); CHECK(V4_OP_CALL == 0x03, "opcode call");
CHECK(V4_OP_UNEXT == 0x04, "opcode unext"); CHECK(V4_OP_NEXT == 0x05, "opcode next");
CHECK(V4_OP_IF == 0x06, "opcode if"); CHECK(V4_OP_MINUS_IF == 0x07, "opcode -if");
CHECK(V4_OP_FETCH_P == 0x08, "opcode @p"); CHECK(V4_OP_FETCH_INC == 0x09, "opcode @+");
CHECK(V4_OP_FETCH_B == 0x0A, "opcode @b"); CHECK(V4_OP_FETCH_A == 0x0B, "opcode @");
CHECK(V4_OP_STORE_P == 0x0C, "opcode !p"); CHECK(V4_OP_STORE_INC == 0x0D, "opcode !+");
CHECK(V4_OP_STORE_B == 0x0E, "opcode !b"); CHECK(V4_OP_STORE_A == 0x0F, "opcode !");
CHECK(V4_OP_MUL_STEP == 0x10, "opcode +*"); CHECK(V4_OP_TWO_STAR == 0x11, "opcode 2*");
CHECK(V4_OP_TWO_SLASH == 0x12, "opcode 2/"); CHECK(V4_OP_INV == 0x13, "opcode inv");
CHECK(V4_OP_ADD == 0x14, "opcode +"); CHECK(V4_OP_AND == 0x15, "opcode and");
CHECK(V4_OP_XOR == 0x16, "opcode xor"); CHECK(V4_OP_DROP == 0x17, "opcode drop");
CHECK(V4_OP_DUP == 0x18, "opcode dup"); CHECK(V4_OP_RPOP == 0x19, "opcode pop");
CHECK(V4_OP_OVER == 0x1A, "opcode over"); CHECK(V4_OP_PUSH_A == 0x1B, "opcode a");
CHECK(V4_OP_NOP == 0x1C, "opcode nop"); CHECK(V4_OP_PUSH == 0x1D, "opcode push");
CHECK(V4_OP_BANG_B == 0x1E, "opcode b!"); CHECK(V4_OP_BANG_A == 0x1F, "opcode a!");
CHECK(V4_OPCODE_COUNT == 0x20, "opcode count");
}
static void test_ambiguous_f18_names_were_renamed(void)
{
/* Section 1.3 says: "Opcode numbering follows the F18. Two names differ
* from Moore's: F18 `-` is renamed `inv` and F18 `or` (which is
* exclusive-or) is renamed `xor`, so instruction names never collide with
* FORTH-79 word names."
*
* The renames are the part that carries weight, and they are asserted here.
* `-` and `or` are exactly the dangerous case: Moore's F18 uses them with
* meanings that differ from the FORTH-79 words of the same name, so an
* instruction table containing either would be ambiguous rather than merely
* duplicated. `and` and `xor` are also FORTH-79 words, but `and` agrees
* with FORTH and `xor` is F18's spelling, so neither is ambiguous.
*
* NOTE: the trailing clause of that sentence is an overclaim, and the test
* deliberately does not assert it. `dup`, `drop`, `over`, `and`, `if` and
* `+` are all instruction names in section 1.3 and all FORTH-79 words,
* spelled identically and meaning the same thing. They coincide; they do
* not collide. What the renames prevent is a *divergent* meaning under a
* shared name, which is the property asserted above. Raised for the spec
* text rather than silently encoded here as if it were true. */
static const char *opnames[32] = {
";", "ex", "jump", "call", "unext", "next", "if", "-if",
"@p", "@+", "@b", "@", "!p", "!+", "!b", "!",
"+*", "2*", "2/", "inv", "+", "and", "xor", "drop",
"dup", "pop", "over", "a", "nop", "push", "b!", "a!"
};
CHECK(strcmp(opnames[V4_OP_INV], "inv") == 0,
"opcode 13 must be named inv, got \"%s\"", opnames[V4_OP_INV]);
CHECK(strcmp(opnames[V4_OP_XOR], "xor") == 0,
"opcode 16 must be named xor, got \"%s\"", opnames[V4_OP_XOR]);
/* The two names the renames exist to remove must appear nowhere. */
for (unsigned i = 0; i < 32u; i++) {
CHECK(strcmp(opnames[i], "-") != 0,
"F18 `-` must not survive as an instruction name (slot %u)", i);
CHECK(strcmp(opnames[i], "or") != 0,
"F18 `or` must not survive as an instruction name (slot %u)", i);
CHECK(strcmp(opnames[i], "OR") != 0,
"F18 `or` must not survive as an instruction name (slot %u)", i);
}
/* The five branch opcodes, by the names section 1.2 lists. */
CHECK(strcmp(opnames[V4_OP_JUMP], "jump") == 0, "opcode 2 name");
CHECK(strcmp(opnames[V4_OP_CALL], "call") == 0, "opcode 3 name");
CHECK(strcmp(opnames[V4_OP_NEXT], "next") == 0, "opcode 5 name");
CHECK(strcmp(opnames[V4_OP_IF], "if") == 0, "opcode 6 name");
CHECK(strcmp(opnames[V4_OP_MINUS_IF], "-if") == 0, "opcode 7 name");
}
static void test_assemble_rejects_out_of_range(void)
{
unsigned o[6] = { 0, 0, 0, 0, 0, 0 };
o[3] = 32u; /* will not fit in 5 bits */
CHECK(v4_iword_assemble(o, 0u) == 0xFFFFFFFFu,
"assemble must reject a 6-bit opcode");
o[3] = 0;
CHECK(v4_iword_assemble(o, 4u) == 0xFFFFFFFFu,
"assemble must reject spare bits above 3");
}
static void test_out_of_range_slots_are_inert(void)
{
/* Slots past 5 do not exist. The decode must answer deterministically
* rather than shift by a nonsense amount. */
v4_iword w = 0xFFFFFFFFu;
CHECK(v4_iword_op(w, 6u) == 0u, "op in slot 6 must be 0");
CHECK(v4_iword_target(w, 6u) == 0u, "target in slot 6 must be 0");
CHECK(v4_iword_slot_mask(6u) == 0u, "mask in slot 6 must be 0");
CHECK(!v4_iword_branch_legal(6u), "slot 6 must not allow branches");
}
int main(void)
{
printf("v4 iword tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
test_slot_bit_ranges();
test_roundtrip_all_opcodes();
test_slots_are_independent();
test_spare_bits_are_inert_for_decode();
test_spare_bits_are_branch_address_bits();
test_reach_column();
test_branch_targets_take_all_low_bits();
test_branch_legality();
test_page_relative_branch();
test_page_relative_branch_preserves_high_page();
test_branch_opcode_set();
test_opcode_enum_matches_spec_numbering();
test_ambiguous_f18_names_were_renamed();
test_assemble_rejects_out_of_range();
test_out_of_range_slots_are_inert();
printf(" %d checks, %d failures\n", checks, failures);
return failures ? 1 : 0;
}