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

§H.12 step 15: FORTH wrappers for BMAPFMT block-ACL fields

Browse Source 
BLK-ACL-ALLOW@/!, BLK-ACL-TTL@/!, BLK-OWNER@ registered in block_words.c.
BLK-OWNER@ packs the 8-byte owner fingerprint into one cell (cell_t is
int64_t). No BLK-OWNER! -- ownership stays a controlled C-only operation.

Live-tested via QMP keystrokes on a running instance: 1 BLK-ACL-ALLOW@
executed cleanly against a real block. Verified 3-arch boot to ok>
(amd64/aarch64/riscv64) plus a hosted sanity build (shared source).

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
2026-09-03 07:36:57 -04:00
co-authored by Claude Opus 5
parent 15e6836ca3
commit 405c713c4a
11 changed files with 27653 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/word_source/block_words.c
+67
View File
@@ -551,6 +551,68 @@ void block_word_next_block(VM *vm) {
}
}
/* --- BMAPFMT block-ACL words (FABRIC-3.md §F.4/§H.6/§H.12 step 15) ----
* Raw C-primitive accessors, matching the word-level ACL system's own
* split: policy is composed in FORTH on top of these (a new capsule,
* §H.12 step 16), not here. block_num validated the same way BLOCK/
* BUFFER above already do. */
/* BLK-ACL-ALLOW@ ( block# -- allow ) */
static void block_word_acl_allow_fetch(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
uint8_t allow;
if (blk_acl_allow_get((uint32_t) blk, &allow) != BLK_OK) { vm->error = 1; return; }
vm_push(vm, (cell_t) allow);
}
/* BLK-ACL-ALLOW! ( allow block# -- ) */
static void block_word_acl_allow_store(VM *vm) {
if (vm->dsp < 1) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
cell_t allow = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
if (blk_acl_allow_set((uint32_t) blk, (uint8_t)(allow ? 1 : 0)) != BLK_OK) {
vm->error = 1;
}
}
/* BLK-ACL-TTL@ ( block# -- ttl ) */
static void block_word_acl_ttl_fetch(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
uint32_t ttl;
if (blk_acl_ttl_get((uint32_t) blk, &ttl) != BLK_OK) { vm->error = 1; return; }
vm_push(vm, (cell_t) ttl);
}
/* BLK-ACL-TTL! ( ttl block# -- ) */
static void block_word_acl_ttl_store(VM *vm) {
if (vm->dsp < 1) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
cell_t ttl = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
if (blk_acl_ttl_set((uint32_t) blk, (uint32_t) ttl) != BLK_OK) { vm->error = 1; }
}
/* BLK-OWNER@ ( block# -- fp ) : 8-byte owner fingerprint packed into one
* cell (cell_t is 8 bytes, int64_t -- see vm.h) -- raw bit reinterpretation,
* not a numeric value. Read-only from FORTH: only step 15's own list, no
* BLK-OWNER! -- setting ownership happens at a more controlled point
* (MINT/birth), in C, not exposed as a general FORTH write. */
static void block_word_owner_fetch(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
uint8_t fp[8];
if (blk_owner_fp_get((uint32_t) blk, fp) != BLK_OK) { vm->error = 1; return; }
cell_t packed;
memcpy(&packed, fp, sizeof(packed));
vm_push(vm, packed);
}
/* --- Registration ----------------------------------------------------- */
/*
@@ -571,4 +633,9 @@ void register_block_words(VM *vm) {
register_word(vm, "THRU", block_word_thru);
register_word(vm, "SCR", block_word_scr);
register_word(vm, "-->", block_word_next_block);
register_word(vm, "BLK-ACL-ALLOW@", block_word_acl_allow_fetch);
register_word(vm, "BLK-ACL-ALLOW!", block_word_acl_allow_store);
register_word(vm, "BLK-ACL-TTL@", block_word_acl_ttl_fetch);
register_word(vm, "BLK-ACL-TTL!", block_word_acl_ttl_store);
register_word(vm, "BLK-OWNER@", block_word_owner_fetch);
}