rajamesandClaude Opus 5.5
067f317c47
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>
111 lines
4.7 KiB
C
111 lines
4.7 KiB
C
/* test_asm.c -- the slot packer lays words out as asm.h says it does. */
|
|
#include "v4/asm.h"
|
|
#include "v4/testcode.h"
|
|
#include <stdio.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)
|
|
|
|
static v4_node n;
|
|
static v4_exec_state es;
|
|
static v4_heat h;
|
|
static v4_asm as;
|
|
|
|
static void fresh(v4_cell origin)
|
|
{
|
|
v4_node_reset(&n);
|
|
v4_exec_reset(&es);
|
|
v4_heat_reset(&h);
|
|
v4_asm_begin(&as, &n, origin);
|
|
}
|
|
|
|
static v4_iword word_at(v4_cell addr) { return (v4_iword)(v4_ucell)n.mem[addr]; }
|
|
|
|
int main(void)
|
|
{
|
|
v4_asm_ref ref;
|
|
v4_cell loop, other;
|
|
|
|
printf("v4 asm tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
|
|
|
|
/* Six opcodes fill a word; the seventh starts the next, padded with nop. */
|
|
fresh(0);
|
|
for (unsigned k = 0; k < 7; k++) v4_asm_op(&as, V4_OP_DUP);
|
|
CHECK(v4_asm_label(&as) == 2, "seven opcodes take two words");
|
|
for (unsigned k = 0; k < 6; k++) CHECK(v4_iword_op(word_at(0), k) == V4_OP_DUP, "word 0 slot %u", k);
|
|
CHECK(v4_iword_op(word_at(1), 0) == V4_OP_DUP, "word 1 slot 0");
|
|
for (unsigned k = 1; k < 6; k++) CHECK(v4_iword_op(word_at(1), k) == V4_OP_NOP, "word 1 pad %u", k);
|
|
|
|
/* `;` closes the word. */
|
|
fresh(0);
|
|
v4_asm_op(&as, V4_OP_DUP); v4_asm_op(&as, V4_OP_SEMI);
|
|
CHECK(v4_asm_label(&as) == 1, "; closes the word");
|
|
|
|
/* Literals follow the instruction word, in order, and the code runs. */
|
|
fresh(0);
|
|
v4_asm_lit(&as, 30); v4_asm_lit(&as, 12); v4_asm_op(&as, V4_OP_ADD); v4_asm_op(&as, V4_OP_SEMI);
|
|
CHECK(v4_asm_ok(&as), "literal program assembles");
|
|
CHECK(n.mem[1] == 30 && n.mem[2] == 12 && v4_asm_label(&as) == 3, "literal layout");
|
|
CHECK(v4_test_call(&n, &es, &h, 0, 10) == 1 && n.ds.t == 42, "30 12 + ;");
|
|
|
|
/* A branch takes the next free slot when that slot is legal. */
|
|
fresh(0);
|
|
v4_asm_op(&as, V4_OP_DUP); v4_asm_op(&as, V4_OP_DROP);
|
|
v4_asm_branch(&as, V4_OP_JUMP, 0x155);
|
|
CHECK(v4_iword_op(word_at(0), 2) == V4_OP_JUMP, "branch in slot 2");
|
|
CHECK(v4_iword_target(word_at(0), 2) == 0x155, "branch target in slot 2");
|
|
CHECK(v4_asm_label(&as) == 1, "a branch closes the word");
|
|
|
|
/* With slots 0-3 used, the branch moves to slot 0 of a new word. */
|
|
fresh(0);
|
|
for (unsigned k = 0; k < 4; k++) v4_asm_op(&as, V4_OP_DUP);
|
|
v4_asm_branch(&as, V4_OP_JUMP, 0x155);
|
|
CHECK(v4_iword_op(word_at(0), 4) == V4_OP_NOP && v4_iword_op(word_at(0), 5) == V4_OP_NOP,
|
|
"word before the branch is padded");
|
|
CHECK(v4_iword_op(word_at(1), 0) == V4_OP_JUMP && v4_iword_target(word_at(1), 0) == 0x155,
|
|
"branch moved to slot 0");
|
|
|
|
/* Forward reference, section 2's IF ... ELSE ... THEN with the flag left
|
|
* on the stack by `if`: if L1 drop 111 ; L1: drop 222 ; */
|
|
fresh(0);
|
|
ref = v4_asm_branch_fwd(&as, V4_OP_IF);
|
|
v4_asm_op(&as, V4_OP_DROP); v4_asm_lit(&as, 111); v4_asm_op(&as, V4_OP_SEMI);
|
|
other = v4_asm_label(&as);
|
|
v4_asm_resolve(&as, ref, other);
|
|
v4_asm_op(&as, V4_OP_DROP); v4_asm_lit(&as, 222); v4_asm_op(&as, V4_OP_SEMI);
|
|
CHECK(v4_asm_ok(&as), "forward branch assembles");
|
|
v4_dstack_push(&n.ds, 5);
|
|
CHECK(v4_test_call(&n, &es, &h, 0, 10) > 0 && n.ds.t == 111, "flag nonzero takes the first arm");
|
|
v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs);
|
|
v4_dstack_push(&n.ds, 0);
|
|
CHECK(v4_test_call(&n, &es, &h, 0, 10) > 0 && n.ds.t == 222, "flag zero takes the second arm");
|
|
|
|
/* Backward reference: 4 FOR 1 + NEXT runs the body n+1 times. */
|
|
fresh(0);
|
|
v4_asm_lit(&as, 4); v4_asm_op(&as, V4_OP_PUSH);
|
|
loop = v4_asm_label(&as);
|
|
v4_asm_lit(&as, 1); v4_asm_op(&as, V4_OP_ADD);
|
|
v4_asm_branch(&as, V4_OP_NEXT, loop);
|
|
v4_asm_op(&as, V4_OP_SEMI);
|
|
CHECK(v4_asm_ok(&as), "loop assembles");
|
|
v4_dstack_push(&n.ds, 0);
|
|
CHECK(v4_test_call(&n, &es, &h, 0, 50) > 0 && n.ds.t == 5, "4 FOR 1 + NEXT");
|
|
|
|
/* Errors are reported, not encoded. */
|
|
fresh(0); v4_asm_op(&as, V4_OP_JUMP);
|
|
CHECK(!v4_asm_ok(&as), "a branch through v4_asm_op is refused");
|
|
fresh(0); v4_asm_op(&as, V4_OPCODE_COUNT);
|
|
CHECK(!v4_asm_ok(&as), "an out-of-range opcode is refused");
|
|
fresh(0);
|
|
for (unsigned k = 0; k < 3; k++) v4_asm_op(&as, V4_OP_DUP);
|
|
v4_asm_branch(&as, V4_OP_JUMP, 5000); /* slot 3 reaches 4096 words */
|
|
CHECK(!v4_asm_ok(&as), "a target outside the page is refused");
|
|
fresh((v4_cell)(V4_NODE_WORDS - 1u));
|
|
v4_asm_lit(&as, 1); v4_asm_op(&as, V4_OP_SEMI);
|
|
CHECK(!v4_asm_ok(&as), "running off the end of memory is refused");
|
|
CHECK(v4_node_guards_intact(&n), "and does not touch the guard band");
|
|
|
|
printf(" %d checks, %d failures\n", checks, failures);
|
|
return failures ? 1 : 0;
|
|
}
|