admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4): the ROM's slot packer, word for word with asm.c

Browse Source 
(OP) (LIT) (BRANCH) (BRANCH>) (RESOLVE) (LABEL), entries 6-11: the code
generator of any language built on the machine (MACHINE.md 2.1).  asm.c's
layout rules with text.c's branch placement; 400 random sequences agree
word for word with asm.c at both widths, memory-full and out-of-reach are
refused on both sides, and a ref with no branch is refused, not looped on.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-15 11:58:47 -04:00
co-authored by Claude Opus 5.5
parent 07911dcf91
commit c233cb6536
5 changed files with 327 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
capsules/v4/rom/main.f18
+6
View File
@@ -13,3 +13,9 @@
jump (FIND) \ 3 ( -- rec | 0 )
jump (DEFINE) \ 4 ( value kind -- )
jump (OPCODE) \ 5 ( -- op | -1 )
jump (OP) \ 6 ( op -- )
jump (LIT) \ 7 ( v -- )
jump (BRANCH) \ 8 ( op target -- )
jump (BRANCH>) \ 9 ( op -- ref )
jump (RESOLVE) \ 10 ( ref target -- )
jump (LABEL) \ 11 ( -- addr )
capsules/v4/rom/pack.f18
+140
View File
@@ -0,0 +1,140 @@
\ pack.f18 -- the ROM's slot packer: how code is laid down.
\
\ The rules are v4/src/asm.c's, with text.c's branch placement
\ (DATASHEET-F18.md section 6):
\ - opcodes fill slots 0 .. 5 left to right; a full word is written out and
\ a new one begun, unused slots padded with nop
\ - a literal is @p in a slot and its value in the word after the
\ instruction word, several in the order they were given
\ - ; and ex end the word: nothing after them executes
\ - a branch ends the word, the bits to its right being its address; it is
\ put only in a slot that reaches the whole address space (ADDR-TOP),
\ otherwise in a new word; a target it cannot reach is "does not fit"
\ This is the code generator of whatever language is built on the machine
\ (MACHINE.md 2.1). State, in the ROM's area: (HERE) the next word address,
\ (CUR) the word being built, (SLOT) its next slot, (LITS) the (NLIT)
\ literals it owes. (PI) (RS) (RN) are working cells. Uses A and B.
\ ( op -- f ) 1 if op is a branch: jump call next if -if
: (BRANCH-OP?)
dup -2 + if Y drop dup -3 + if Y drop dup -5 + if Y drop
dup -6 + if Y drop dup -7 + if Y drop drop 0 ;
Y: drop drop 1 ;
\ ( s -- m ) the address bits a branch in slot s replaces
: (MASK)
if S0 -1 + if S1 -1 + if S2 -1 + if S3 -1 + if S4 drop 3 ;
S0: drop $7FFFFFF ;
S1: drop $3FFFFF ;
S2: drop $1FFFF ;
S3: drop $FFF ;
S4: drop $7F ;
\ ( w s -- op ) the opcode in slot s of the instruction word w
: (SLOT-OP)
dup 2* 2* + inv 1 + 27 +
S: if SD push 2/ pop -1 + jump S
SD: drop 31 and ;
\ ( op -- ) op into the next slot
: (PUT-OP)
(SLOT) a! @ dup 2* 2* + inv 1 + 27 +
S: if SD push 2* pop -1 + jump S
SD: drop (CUR) a! @ xor !
(SLOT) a! @ 1 + ! ;
\ ( v -- ) v at (HERE), which then moves on; past RAM, "does not fit"
: (EMIT)
(HERE) a! @ dup RAM-WORDS inv 1 + + -if FULL
drop b! !b (HERE) a! @ 1 + ! ;
FULL: drop drop drop ERR-FIT jump (FAIL)
\ ( -- ) write out the word being built, padded with nop, then its literals
: (FLUSH)
(SLOT) a! @ if NONE drop
P: (SLOT) a! @ 6 xor if PADDED drop 28 (PUT-OP) jump P
PADDED: drop
(CUR) a! @ (EMIT)
0 (PI) a! !
L: (PI) a! @ (NLIT) a! @ xor if LD drop
(PI) a! @ (LITS) + a! @ (EMIT)
(PI) a! @ 1 + ! jump L
LD: drop
0 (CUR) a! ! 0 (SLOT) a! ! 0 (NLIT) a! ! ;
NONE: drop ;
\ ( op -- ) an opcode that is neither a branch nor @p
: (OP)
dup -32 + -if BAD
drop dup 8 xor if BAD
drop dup (BRANCH-OP?) if GOOD
BAD: drop drop ERR-OPCODE jump (FAIL)
GOOD: drop
dup (PUT-OP)
if CLOSE
-1 + if CLOSE
drop (SLOT) a! @ 6 xor if CLOSE drop ;
CLOSE: drop jump (FLUSH)
\ ( v -- ) @p and its value
: (LIT)
(NLIT) a! @ (LITS) + b! !b
(NLIT) a! @ 1 + !
8 (PUT-OP)
(SLOT) a! @ 6 xor if FL drop ;
FL: drop jump (FLUSH)
\ ( -- ) text.c's place_branch: begin a new word unless the next slot
\ reaches the whole address space
: (PLACE)
(SLOT) a! @ if NONE
dup -4 + -if NEW drop
(MASK) ADDR-TOP inv 1 + + -if KEEP drop jump (FLUSH)
KEEP: drop ;
NEW: drop drop jump (FLUSH)
NONE: drop ;
\ ( -- addr ) end the word being built; the next word address
: (LABEL) (FLUSH) (HERE) a! @ ;
\ ( op -- ref ) a branch whose target comes later: ref is the word it is in
: (BRANCH>)
dup (BRANCH-OP?) if BAD drop
(PLACE)
(SLOT) a! @ -4 + -if FL drop jump GO
FL: drop (FLUSH)
GO: (HERE) a! @ push
(PUT-OP)
6 (SLOT) a! !
(FLUSH) pop ;
BAD: drop drop ERR-OPCODE (FAIL) 0 ;
\ ( ref target -- ) give the branch in the word at ref its target. The
\ branch is the first branch opcode in the word; the literals before it are
\ what P has passed when it executes. A word with no branch in slots
\ 0 .. 3 is not a ref, and is refused.
: (RESOLVE)
(FAILED) a! @ if GO drop drop drop ;
GO: drop
0 (RS) a! ! 0 (RN) a! !
L: (RS) a! @ -4 + -if BADREF drop
over a! @ (RS) a! @ (SLOT-OP)
dup (BRANCH-OP?) if NB drop drop jump FOUND
NB: drop 8 xor if ISLIT drop jump NXT
ISLIT: drop (RN) a! @ 1 + !
NXT: (RS) a! @ 1 + ! jump L
BADREF: jump (NOB)
FOUND:
over 1 + (RN) a! @ +
over xor (RS) a! @ (MASK) inv and
if OKR drop drop drop ERR-FIT jump (FAIL)
OKR: drop
(RS) a! @ (MASK) and
over a! @ (RS) a! @ (MASK) inv and
xor over a! ! drop ;
\ (a word with no branch in slots 0 .. 3 is not a ref: refused)
: (NOB) drop drop drop ERR-FIT jump (FAIL)
\ ( op target -- ) a branch to a known target
: (BRANCH) push (BRANCH>) pop jump (RESOLVE)
v4/tests/host_map.h
+13 -1
View File
@@ -105,7 +105,16 @@
#define SEND_PTR (BUF0_W - 101) /* where the next word of a text being made ready to send goes */
#define OUT_TEXT (OUT_W - 64) /* what was printed, four characters to a cell, as it goes on the wire: 64 cells */
#define SEND_TEXT (OUT_W - 400) /* the text of a message SEND is putting, four characters to a cell: 256 cells */
/* FREE, plain memory: BUF0_W - 32 .. - 21; - 122 .. - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after
/* The ROM's slot packer (MACHINE.md 2.1), in what was free: BUF0_W - 32 .. - 23 and - 122 .. - 120. */
#define ROM_HERE (BUF0_W - 32) /* the next word address code goes to */
#define ROM_CUR (BUF0_W - 31) /* the instruction word being built */
#define ROM_SLOT (BUF0_W - 30) /* its next free slot, 0 .. 6 */
#define ROM_NLIT (BUF0_W - 29) /* how many literals it owes */
#define ROM_LITS (BUF0_W - 28) /* the literals, 6 cells */
#define ROM_PI (BUF0_W - 122) /* working cells */
#define ROM_RS (BUF0_W - 121)
#define ROM_RN (BUF0_W - 120)
/* FREE, plain memory: BUF0_W - 22 .. - 21; - 119 .. - 113; BUF0_W - 144 .. - 141 (what a flush makes zero after
* a full output buffer); and OUT_W - 144 .. OUT_W - 65. They and
* the cells above held the messages waiting, the refusals owed and what went with them (MESH.md 7a, 7b), which a
* node no longer keeps. */
@@ -159,6 +168,9 @@
#define ROM_ERR_BAD_NAME 3 /* an opcode, a reserved word, a label, a number or &...: "cannot be used as a name" */
#define ROM_ERR_DEFINED 4 /* "already defined" */
#define ROM_ERR_NAMES 5 /* the symbol table is full: "too many names" */
#define ROM_ERR_FIT 6 /* memory is full, or a branch cannot reach: "does not fit" */
#define ROM_ERR_OPCODE 7 /* not an opcode the packer takes there */
#define ROM_ADDR_TOP ((v4_cell)(V4_NODE_WORDS + V4_ROM_WORDS - 1u)) /* the top of the address space */
#define WORD_DEFINED (BUF0_W - 11) /* the xt of the word that is told of each new entry, or 0 */
#define WORD_FORGOTTEN (BUF0_W - 12) /* the xt of the word that is told when entries go, or 0 */
#define LOG_LEVEL (BUF0_W - 5) /* the level at or below which a message is printed */
v4/tests/test_host_rom_pack.c
+156
View File
@@ -0,0 +1,156 @@
/* test_host_rom_pack.c -- the ROM's slot packer, word for word with asm.c.
*
* Plan Task 5. (OP) ( op -- ), (LIT) ( v -- ), (BRANCH) ( op target -- ),
* (BRANCH>) ( op -- ref ), (RESOLVE) ( ref target -- ) and (LABEL)
* ( -- addr ) lay code down exactly as v4/src/asm.c does, with text.c's
* branch placement: a branch goes in a slot only if that slot reaches the
* whole address space. Random sequences are applied both ways -- asm.c on
* node A, the ROM on node B -- and memory is compared word for word; a
* sequence that is an error on one side must be an error on the other.
*/
#include "rom_harness.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 a, b;
static v4_asm as;
static unsigned long long seed = 20261015u;
static unsigned rnd(unsigned n) { seed = seed * 6364136223846793005ull + 1442695040888963407ull; return (unsigned)((seed >> 33) % n); }
/* text.c's place_branch, for the asm.c side */
static void place_branch(void)
{
if (as.slot == 0) return;
if (!v4_iword_branch_legal(as.slot) || (v4_ucell)v4_iword_slot_mask(as.slot) < (v4_ucell)ROM_ADDR_TOP)
(void)v4_asm_label(&as);
}
/* call a ROM routine with up to two arguments; 1 if it returned */
static int rom(const char *name, int argc, v4_cell x, v4_cell y)
{
if (argc > 0) v4_dstack_push(&b.ds, x);
if (argc > 1) v4_dstack_push(&b.ds, y);
if (rom_call(&b, name, 1000000)) return 1;
printf(" %s did not return: P %ld, stopped %d, fault kind %u at %ld\n", name, (long)b.p, b.stopped, b.fault_kind, (long)b.fault_addr);
return 0;
}
static int rom_failed(void) { return b.mem[ROM_FAILED] != 0; }
static const unsigned branch_ops[5] = { V4_OP_JUMP, V4_OP_CALL, V4_OP_NEXT, V4_OP_IF, V4_OP_MINUS_IF };
/* one random sequence from `origin`; 1 if both sides agree throughout */
static int trial(v4_cell origin, unsigned steps)
{
v4_asm_ref aref[64];
v4_cell bref[64], labels[64], ha, hb, w;
unsigned nref = 0, nlab = 0, i, k;
v4_node_reset(&a);
v4_asm_begin(&as, &a, origin);
rom_boot(&b);
v4_node_console_input_attach(&b, -1, -1); /* the packer reads no input: near the top of RAM, those are words */
b.mem[ROM_HERE] = origin;
for (i = 0; i < steps; i++) {
unsigned what = rnd(100);
int ea, eb;
if (what < 45) { /* an ordinary opcode */
unsigned op;
do op = rnd(32); while (v4_op_is_branch(op) || op == V4_OP_FETCH_P);
v4_asm_op(&as, op);
if (!rom("(OP)", 1, (v4_cell)op, 0)) return 0;
} else if (what < 70) { /* a literal */
v4_cell v = (v4_cell)rnd(2000) - 1000;
if (rnd(4) == 0) v = (v4_cell)((v4_ucell)0 - (v4_ucell)rnd(5)) ;
v4_asm_lit(&as, v);
if (!rom("(LIT)", 1, v, 0)) return 0;
} else if (what < 80) { /* a branch back, or anywhere */
unsigned op = branch_ops[rnd(5)];
v4_cell t = nlab && rnd(3) ? labels[rnd(nlab)] : (v4_cell)rnd((unsigned)ROM_ADDR_TOP + 1u);
if (rnd(40) == 0) t = 200000; /* out of reach of any slot but 0 */
place_branch();
v4_asm_branch(&as, op, t);
if (!rom("(BRANCH)", 2, (v4_cell)op, t)) return 0;
} else if (what < 90 && nref < 64) { /* a branch forward */
unsigned op = branch_ops[rnd(5)];
place_branch();
aref[nref] = v4_asm_branch_fwd(&as, op);
if (!rom("(BRANCH>)", 1, (v4_cell)op, 0)) return 0;
bref[nref] = v4_dstack_pop(&b.ds);
nref++;
} else if (nlab < 64) { /* a label, and some forward branches resolved to it */
v4_cell la = v4_asm_label(&as), lb;
if (!rom("(LABEL)", 0, 0, 0)) return 0;
lb = v4_dstack_pop(&b.ds);
if (la != lb) { printf(" label: asm %ld, ROM %ld\n", (long)la, (long)lb); return 0; }
labels[nlab++] = la;
for (k = 0; k < nref; ) {
if (rnd(2)) { k++; continue; }
v4_asm_resolve(&as, aref[k], la);
if (!rom("(RESOLVE)", 2, bref[k], la)) return 0;
aref[k] = aref[nref - 1]; bref[k] = bref[nref - 1]; nref--;
}
}
ea = as.error != 0;
eb = rom_failed();
if (ea != eb) { printf(" step %u: asm error %d, ROM error %d (code %ld)\n", i, ea, eb, (long)b.mem[ROM_FAILED]); return 0; }
if (ea) return 1; /* both refused: the sequence ends there */
if (b.ds.depth != 0) { printf(" step %u: the ROM left %u on the stack\n", i, b.ds.depth); return 0; }
}
ha = v4_asm_label(&as);
if (!rom("(LABEL)", 0, 0, 0)) return 0;
hb = v4_dstack_pop(&b.ds);
if (as.error || rom_failed()) return (as.error != 0) == rom_failed();
if (ha != hb) { printf(" end: asm here %ld, ROM %ld\n", (long)ha, (long)hb); return 0; }
for (w = origin; w < ha; w++)
if (a.mem[w] != b.mem[w]) { printf(" word %ld: asm %lx, ROM %lx\n", (long)w, (unsigned long)a.mem[w], (unsigned long)b.mem[w]); return 0; }
return 1;
}
int main(void)
{
unsigned t, good = 0;
for (t = 0; t < 400; t++) if (trial(16, 120 + rnd(200))) good++; else { CHECK(0, "trial %u disagrees", t); break; }
CHECK(good == 400, "400 random sequences agree word for word: %u", good);
/* memory runs out: a sequence that starts near the top of RAM */
CHECK(trial((v4_cell)V4_NODE_WORDS - 20, 200), "memory full is an error on both sides");
/* a forward branch that cannot reach (Review Focus 2) */
{
v4_asm_ref ar; v4_cell br;
v4_node_reset(&a); v4_asm_begin(&as, &a, 16);
rom_boot(&b); b.mem[ROM_HERE] = 16;
v4_asm_op(&as, V4_OP_DUP); v4_asm_op(&as, V4_OP_DUP);
rom("(OP)", 1, V4_OP_DUP, 0); rom("(OP)", 1, V4_OP_DUP, 0);
place_branch();
ar = v4_asm_branch_fwd(&as, V4_OP_JUMP);
rom("(BRANCH>)", 1, V4_OP_JUMP, 0); br = v4_dstack_pop(&b.ds);
v4_asm_resolve(&as, ar, 400000);
rom("(RESOLVE)", 2, br, 400000);
CHECK(as.error && b.mem[ROM_FAILED] == ROM_ERR_FIT, "out of reach: refused by both, ROM code %ld", (long)b.mem[ROM_FAILED]);
}
/* a ref to a word with no branch in it is refused, not looped on */
rom_boot(&b); b.mem[ROM_HERE] = 16;
rom("(OP)", 1, V4_OP_DUP, 0);
rom("(LABEL)", 0, 0, 0); (void)v4_dstack_pop(&b.ds);
CHECK(rom("(RESOLVE)", 2, 16, 40) && b.mem[ROM_FAILED] == ROM_ERR_FIT, "no branch at the ref: does not fit, code %ld", (long)b.mem[ROM_FAILED]);
/* opcodes the packer does not take as ordinary ones */
rom_boot(&b); b.mem[ROM_HERE] = 16;
rom("(OP)", 1, V4_OP_FETCH_P, 0);
CHECK(b.mem[ROM_FAILED] == ROM_ERR_OPCODE, "@p is written as a literal, not an opcode");
rom_boot(&b); b.mem[ROM_HERE] = 16;
rom("(OP)", 1, V4_OP_CALL, 0);
CHECK(b.mem[ROM_FAILED] == ROM_ERR_OPCODE, "a branch is not an ordinary opcode");
rom_boot(&b); b.mem[ROM_HERE] = 16;
rom("(OP)", 1, 32, 0);
CHECK(b.mem[ROM_FAILED] == ROM_ERR_OPCODE, "32 is not an opcode");
printf("test_host_rom_pack: %d checks, %d failures\n", checks, failures);
return failures != 0;
}
v4/tools/mkmap.c
+12
View File
@@ -49,6 +49,18 @@ int main(void)
constant("ERR-BAD-NAME", (long)ROM_ERR_BAD_NAME);
constant("ERR-DEFINED", (long)ROM_ERR_DEFINED);
constant("ERR-NAMES", (long)ROM_ERR_NAMES);
constant("(HERE)", (long)ROM_HERE);
constant("(CUR)", (long)ROM_CUR);
constant("(SLOT)", (long)ROM_SLOT);
constant("(NLIT)", (long)ROM_NLIT);
constant("(LITS)", (long)ROM_LITS);
constant("(PI)", (long)ROM_PI);
constant("(RS)", (long)ROM_RS);
constant("(RN)", (long)ROM_RN);
constant("RAM-WORDS", (long)V4_NODE_WORDS);
constant("ADDR-TOP", (long)ROM_ADDR_TOP);
constant("ERR-FIT", (long)ROM_ERR_FIT);
constant("ERR-OPCODE", (long)ROM_ERR_OPCODE);
/* the cell width's constants (NUMBER) needs, written as signed cells */
constant("MSB", (long)(v4_cell)V4_MSB);
constant("DEC-LIMIT", (long)(v4_cell)(~(v4_ucell)0 / 10u));