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

§H.12 steps 21-22: ELEVATE-REQUEST + ELEVATE-GRANT + SEND-ELEVATE-REQUEST

Browse Source 
Phase 7 complete, closing out §H.12's punch list. MSG-DELIVER turned out
to VM-EXEC payload text directly rather than dispatching by type, so the
"handler" is ELEVATE-GRANT, a word the delivered text calls. New Hera-only
C primitives (ZUSE-ELIGIBLE?, NAME>XT, ELEVATE-PUBKEY-UNPACK) stay plain
and unconditional; capsules/zuse-eligibility.4th composes the actual
eligibility check + ACL-ALLOW!/ACL-TTL! grant in FORTH.
SEND-ELEVATE-REQUEST (common:messaging.4th) builds the payload text and
sends it via the item-20-gated CH-REQUEST.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01QgooKd5hJNtTYqB6CyK5f9
This commit is contained in:
Robert Allan James
2026-09-03 13:15:40 -04:00
co-authored by Claude Sonnet 5
parent cb6e079a73
commit 2b9fa02354
10 changed files with 27815 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files
FABRIC-3.md
+35 -3
View File
@@ -4156,9 +4156,41 @@ work, not new invention.
(amd64/aarch64/riscv64, each in the foreground); confirmed via the amd64 log that both
Hermes's and Artemis's `PARITY:BIRTH` still succeed (their init capsules, including the new
lines, compile and run cleanly).
- [ ] **21.** Define `ELEVATE-REQUEST` and a minimal real handler checking the eligibility
list, granting via `ACL-ALLOW!`/`ACL-TTL!` on match.
- [ ] **22.** Add the FORTH entrypoint a session actually calls to send one.
- [x] **21. DONE 2026-09-03.** Found before writing this: `MSG-DELIVER` doesn't dispatch by
type at all — it takes the payload text and `VM-EXEC`s it directly inside the target VM, so
a "handler" is really just a word the payload text calls once delivered. Since VMs have
separate memory, the pubkey can't cross as a pointer — Captain Bob confirmed embedding it as
4 literal cells in the message text (matching `ZUSE-PUBKEY@`'s own 8-byte-LE-chunk
convention), and that the target word is named by the caller, resolved dynamically. Added
`8 CONSTANT ELEVATE-REQUEST` (`common:messaging.4th`, next to `CONSOLE-CMD-EVENT`) and three
new plain/unconditional C primitives in `mama_forth_words.c` (Hera-only, same "no bespoke
gate" discipline as item 19): `ZUSE-ELIGIBLE? ( c-addr -- flag )` wraps
`zuse_eligibility_is_member()`; `NAME>XT ( c-addr u -- xt|0 )` is a dynamic dictionary
lookup from a data-stack string (distinct from `FIND`/`'`, which parse the live input
stream — `FIND` itself untouched, per the standing rule); `ELEVATE-PUBKEY-UNPACK
( pk0 pk1 pk2 pk3 buf-addr -- )` reconstructs the 32-byte pubkey, byte-exact, as the inverse
of `ZUSE-PUBKEY@`'s packing. New capsule `capsules/zuse-eligibility.4th` (blocks 4021–4022,
next free range after `block-acl.4th`) defines `ELEVATE-GRANT
( waddr wu pk0 pk1 pk2 pk3 -- )`: unpacks the pubkey, checks `ZUSE-ELIGIBLE?`, and on a hit
resolves the named word via `NAME>XT` and grants it `1 ACL-ALLOW!` +
`ACL-BASE-TTL ACL-TTL!` (the existing, already-decided `ACL-TTL` reuse) — silent no-op on
any miss (not eligible, or word not found). Loaded from Hera's own `init.4th` right after
`block-acl.4th`. Passed `mkcapsule --lint` cleanly across all 34 capsule files.
- [x] **22. DONE 2026-09-03.** `SEND-ELEVATE-REQUEST ( pk3 pk2 pk1 pk0 waddr wu -- )` added to
`common:messaging.4th` (new blocks 5039–5040, after a small scratch-buffer text-builder:
`ELEVATE-REQ-RESET`/`-PUTC`/`-APPEND`/`-NUM`, the last using `<# 0 SWAP #S #>` — explicit
double-cell form, not the tolerant single-cell path, which takes an absolute value and would
corrupt exact bit-pattern round-trip for a chunk with its top bit set). Builds the literal
payload text `S" <wordname>" <pk0dec> <pk1dec> <pk2dec> <pk3dec> ELEVATE-GRANT` (args taken
in reverse pk order so top-of-stack processing emits pk0 first) and sends it via
`ELEVATE-REQUEST MY-CH-ID @ 0 ... CH-REQUEST` — `to`=0 (Hera, where `ELEVATE-GRANT` lives),
riding both the item-20 initiator-only gate and H.7's already-real messaging protocol
unmodified. Verified 3-arch boot to `ok>` (amd64/aarch64/riscv64, each in the foreground);
confirmed via each arch's log that Hermes's and Artemis's `PARITY:BIRTH` still succeed with
no `UNKNOWN WORD` errors (their init capsules load `common:messaging.4th`, and Hera's own
boot sequence loads `zuse-eligibility.4th`, both compiling cleanly).
**Phase 7, and with it §H.12's entire punch list, is now complete.**
**Excluded, per H.11's deferred items 10–11**: VM card multi-owner support, live-console
`sudo`-style elevation, pre-signed capability tickets.
capsules/BLOCK_MAP.md
+48 -43
View File
@@ -1,5 +1,5 @@
# Capsule Block Manifest — Auto-generated
<!-- Generated by mkcapsule --manifest 2026-09-03T15:52:36Z -->
<!-- Generated by mkcapsule --manifest 2026-09-03T17:03:38Z -->
<!-- DO NOT EDIT — re-run mkcapsule --manifest to refresh. -->
<!-- Hand-written justifications and immutability notes live -->
<!-- in MANIFEST.md alongside this auto-generated index. -->
@@ -11,7 +11,7 @@
| `ACL.4th` | 4000, 4001, 4002, 4003, 4004, 4005, 4006, 4007, 4015 | `0xd781d22148ff171d` | yes |
| `artemis:init.4th` | 4110, 4111, 4112, 4113, 4122, 4123, 4124, 4125, 4126, 4127, 4128, 4129, 4130, 4131, 4132, 4133, 4134, 4135, 4136, 4137, 4138, 4139, 4140, 4141, 4160, 4161, 4162, 4163, 4164, 4165, 4166, 4167, 4168, 4169, 4170, 4171, 4172, 4173, 4174, 4177, 4178, 4179, 4180, 4181, 4182, 4851, 4852, 4853, 4854 | `0x90208e9ab5ae0070` | yes |
| `block-acl.4th` | 4019, 4020 | `0xf5eab0544b962dfa` | yes |
| `common:messaging.4th` | 5003, 5004, 5005, 5006, 5007, 5008, 5009, 5010, 5011, 5012, 5013, 5014, 5015, 5016, 5017, 5018, 5019, 5020, 5021, 5022, 5023, 5024, 5025, 5026, 5027, 5028, 5029, 5030, 5031, 5032, 5033, 5034, 5035, 5036, 5037, 5038 | `0x000bef369e84a1aa` | yes |
| `common:messaging.4th` | 5003, 5004, 5005, 5006, 5007, 5008, 5009, 5010, 5011, 5012, 5013, 5014, 5015, 5016, 5017, 5018, 5019, 5020, 5021, 5022, 5023, 5024, 5025, 5026, 5027, 5028, 5029, 5030, 5031, 5032, 5033, 5034, 5035, 5036, 5037, 5038, 5039, 5040 | `0x9cb26fa2d67465db` | yes |
| `common:msg.4th` | 4055 | `0x850a0382344ea6c4` | yes |
| `doe-campaign.4th` | 4060, 4061, 4062, 4063, 4064, 4065 | `0x3d4549142d91ec20` | yes |
| `doe.4th` | 2100, 2101, 2102, 2103, 2104, 2105, 2106, 2107 | `0xf154616d248e861f` | yes |
@@ -34,21 +34,22 @@
| `init-l8-temporal.4th` | 4830, 4831 | `0x51abd4c138246651` | yes |
| `init-l8-transition.4th` | 4840, 4841, 4842 | `0xbcc1a81976f0a4c9` | yes |
| `init-l8-volatile.4th` | 4810, 4811, 4812, 4813 | `0x98caabbbd92abac4` | yes |
| `init.4th` | 2049, 2050, 2057 | `0xa94a7b63db15021b` | yes |
| `init.4th` | 2049, 2050, 2057 | `0x5d35c5c6a6eafe04` | yes |
| `lib.4th` | 4050 | `0x4b216635c359ef73` | yes |
| `process.4th` | 4300, 4301 | `0x781afc1dbd0294f7` | yes |
| `sdk.4th` | 5109, 5110, 5111, 5112, 5113, 5114, 5115 | `0x008fdbbb62c94a3a` | yes |
| `turtle.4th` | 5100, 5101, 5102, 5103, 5104, 5105, 5106, 5107, 5108 | `0x4d470418ca543365` | yes |
| `user-font-demo.4th` | 4200, 4201, 4202 | `0xce1fd7d1b581a56d` | yes |
| `zuse-eligibility.4th` | 4021, 4022 | `0x604ddb82c8fa4db0` | yes |
| `zuse.4th` | 4016, 4017, 4018 | `0x490ded9be257a90b` | yes |
## Block Map (sorted by LBN)
| LBN | Capsule | xxHash64 | Status |
|-----|---------|----------|--------|
| 2049 | `init.4th` | `0xa94a7b63db15021b` | ok |
| 2050 | `init.4th` | `0xa94a7b63db15021b` | ok |
| 2057 | `init.4th` | `0xa94a7b63db15021b` | ok |
| 2049 | `init.4th` | `0x5d35c5c6a6eafe04` | ok |
| 2050 | `init.4th` | `0x5d35c5c6a6eafe04` | ok |
| 2057 | `init.4th` | `0x5d35c5c6a6eafe04` | ok |
| 2064 | `init-l8-omni.4th` | `0x5979e314d6452045` | ok |
| 2065 | `init-l8-omni.4th` | `0x5979e314d6452045` | ok |
| 2066 | `init-l8-omni.4th` | `0x5979e314d6452045` | ok |
@@ -110,6 +111,8 @@
| 4018 | `zuse.4th` | `0x490ded9be257a90b` | ok |
| 4019 | `block-acl.4th` | `0xf5eab0544b962dfa` | ok |
| 4020 | `block-acl.4th` | `0xf5eab0544b962dfa` | ok |
| 4021 | `zuse-eligibility.4th` | `0x604ddb82c8fa4db0` | ok |
| 4022 | `zuse-eligibility.4th` | `0x604ddb82c8fa4db0` | ok |
| 4050 | `lib.4th` | `0x4b216635c359ef73` | ok |
| 4055 | `common:msg.4th` | `0x850a0382344ea6c4` | ok |
| 4060 | `doe-campaign.4th` | `0x3d4549142d91ec20` | ok |
@@ -297,42 +300,44 @@
| 5000 | `fabric.4th` | `0x9b1d061339cea98d` | ok |
| 5001 | `fabric.4th` | `0x9b1d061339cea98d` | ok |
| 5002 | `fabric.4th` | `0x9b1d061339cea98d` | ok |
| 5003 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5004 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5005 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5006 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5007 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5008 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5009 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5010 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5011 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5012 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5013 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5014 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5015 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5016 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5017 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5018 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5019 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5020 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5021 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5022 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5023 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5024 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5025 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5026 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5027 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5028 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5029 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5030 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5031 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5032 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5033 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5034 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5035 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5036 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5037 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5038 | `common:messaging.4th` | `0x000bef369e84a1aa` | ok |
| 5003 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5004 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5005 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5006 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5007 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5008 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5009 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5010 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5011 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5012 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5013 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5014 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5015 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5016 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5017 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5018 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5019 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5020 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5021 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5022 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5023 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5024 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5025 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5026 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5027 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5028 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5029 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5030 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5031 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5032 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5033 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5034 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5035 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5036 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5037 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5038 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5039 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5040 | `common:messaging.4th` | `0x9cb26fa2d67465db` | ok |
| 5100 | `turtle.4th` | `0x4d470418ca543365` | ok |
| 5101 | `turtle.4th` | `0x4d470418ca543365` | ok |
| 5102 | `turtle.4th` | `0x4d470418ca543365` | ok |
@@ -356,4 +361,4 @@
None.
---
*33 capsule(s) scanned. Re-run `mkcapsule --manifest <dir>` to refresh.*
*34 capsule(s) scanned. Re-run `mkcapsule --manifest <dir>` to refresh.*
capsules/common/messaging.4th
+37
View File
@@ -19,6 +19,10 @@ Block 5038
( CONSOLE-CMD-EVENT: console-VM -> paired user-VM command )
( relay message type, async MSG-SEND/MSG-DELIVER. )
7 CONSTANT CONSOLE-CMD-EVENT
( ELEVATE-REQUEST: H.5/H.8 -- word-ACL elevation ask, )
( carried to Zuse via CH-REQUEST. See SEND-ELEVATE- )
( REQUEST/ELEVATE-GRANT below and in zuse-eligibility.4th. )
8 CONSTANT ELEVATE-REQUEST
Block 5004
( StadiumBehaviour tags, match stadium.h's enum )
0 CONSTANT SB-MIGRATE
@@ -439,3 +443,36 @@ VARIABLE BC-CH VARIABLE BC-SCAN
BC-PADDR @ BC-PLEN @ BC-CH @ MSG-SEND
BC-SCAN @ MBR-NEXT@ BC-SCAN !
REPEAT ;
Block 5039
( H.8: SEND-ELEVATE-REQUEST payload builder -- )
( scratch text buffer + append primitives. )
CREATE ELEVATE-REQ-BUF 256 ALLOT
VARIABLE ELEVATE-REQ-LEN
: ELEVATE-REQ-RESET ( -- ) 0 ELEVATE-REQ-LEN ! ;
: ELEVATE-REQ-PUTC ( c -- )
ELEVATE-REQ-BUF ELEVATE-REQ-LEN @ + C!
1 ELEVATE-REQ-LEN +! ;
: ELEVATE-REQ-APPEND ( addr u -- )
>R
ELEVATE-REQ-BUF ELEVATE-REQ-LEN @ +
R@ CMOVE
ELEVATE-REQ-LEN @ R> + ELEVATE-REQ-LEN ! ;
: ELEVATE-REQ-NUM ( n -- )
<# 0 SWAP #S #> ELEVATE-REQ-APPEND ;
Block 5040
( SEND-ELEVATE-REQUEST: ask Zuse for word-ACL )
( elevation. pk3..pk0 order so top-down emits )
( pk0 first; waddr/wu = target word name text. )
: SEND-ELEVATE-REQUEST ( pk3 pk2 pk1 pk0 waddr wu -- )
ELEVATE-REQ-RESET
83 ELEVATE-REQ-PUTC 34 ELEVATE-REQ-PUTC
32 ELEVATE-REQ-PUTC
ELEVATE-REQ-APPEND
34 ELEVATE-REQ-PUTC 32 ELEVATE-REQ-PUTC
ELEVATE-REQ-NUM 32 ELEVATE-REQ-PUTC
ELEVATE-REQ-NUM 32 ELEVATE-REQ-PUTC
ELEVATE-REQ-NUM 32 ELEVATE-REQ-PUTC
ELEVATE-REQ-NUM 32 ELEVATE-REQ-PUTC
S" ELEVATE-GRANT" ELEVATE-REQ-APPEND
ELEVATE-REQUEST MY-CH-ID @ 0 ELEVATE-REQ-BUF
ELEVATE-REQ-LEN @ CH-REQUEST ;
capsules/init.4th
+1
View File
@@ -15,6 +15,7 @@ Block 2049
: VM-CHILDREN ( -- ) ." (none)" CR ;
S" ACL.4th" EXEC
S" block-acl.4th" EXEC
S" zuse-eligibility.4th" EXEC
S" lib.4th" EXEC
S" fabric.4th" EXEC
S" font.4th" EXEC
capsules/zuse-eligibility.4th
+26
View File
@@ -0,0 +1,26 @@
Block 4021
( zuse-eligibility.4th - H.5/H.8 elevation grant )
( C prims: ZUSE-ELIGIBILITY-ADD ZUSE-ELIGIBLE? )
( NAME>XT ELEVATE-PUBKEY-UNPACK )
( Policy word this file: ELEVATE-GRANT. Runs in )
( Hera's own dict -- delivered here by messaging.4th's )
( MSG-DELIVER via VM-EXEC when a session calls the )
( common:messaging.4th SEND-ELEVATE-REQUEST entrypoint. )
( FABRIC-3.md H.12 step 21, 2026-09-03. )
CREATE ELEVATE-PK-BUF 32 ALLOT
Block 4022
( ELEVATE-GRANT ( waddr wu pk0 pk1 pk2 pk3 -- ) )
( Reconstructs the caller's pubkey, checks Zuse's )
( eligibility list, and on match grants the named )
( word ACL-ALLOW!/ACL-TTL! via the same reused )
( ACL-TTL mechanism H.5 decided on. No grant, no )
( error, on any mismatch -- silent refusal. )
: ELEVATE-GRANT ( waddr wu pk0 pk1 pk2 pk3 -- )
ELEVATE-PK-BUF ELEVATE-PUBKEY-UNPACK
ELEVATE-PK-BUF ZUSE-ELIGIBLE? IF
NAME>XT DUP IF
1 OVER ACL-ALLOW!
ACL-BASE-TTL SWAP ACL-TTL!
ELSE DROP THEN
ELSE 2DROP THEN ;
disk/artemis.img
BIN
View File
Binary file not shown.
logs/20260903-122212/amd64/qemu-amd64-20260903-122212.log
+9187
View File
File diff suppressed because it is too large Load Diff
logs/20260903-124304/aarch64/qemu-aarch64-20260903-124304.log
+9157
View File
File diff suppressed because it is too large Load Diff
logs/20260903-130417/riscv64/qemu-riscv64-20260903-130417.log
+9229
View File
File diff suppressed because it is too large Load Diff
src/starkernel/capsule/mama_forth_words.c
+95
View File
@@ -935,6 +935,95 @@ static void mama_word_zuse_eligibility_add(VM *vm)
vm_push(vm, 1);
}
/**
* @brief ZUSE-ELIGIBLE? ( c-addr -- flag )
* Membership check over Zuse's elevation eligibility list (FABRIC-3.md
* §H.5/§H.12 item 21). Plain, unconditional wrapper over
* zuse_eligibility_is_member() -- same "no bespoke gate" convention as
* ZUSE-ELIGIBILITY-ADD above; is_member() itself is already fail-closed.
*/
static void mama_word_zuse_eligible_query(VM *vm)
{
if (vm->dsp < 0) {
vm->error = 1;
vm_push(vm, 0);
return;
}
cell_t caddr = vm_pop(vm);
const uint8_t *pubkey = vm_ptr(vm, (vaddr_t)caddr);
if (!pubkey) {
vm->error = 1;
vm_push(vm, 0);
return;
}
vm_push(vm, zuse_eligibility_is_member(pubkey) ? -1 : 0);
}
/**
* @brief NAME>XT ( c-addr u -- xt|0 )
* Dynamic dictionary lookup for a name already sitting in a data buffer
* (e.g. a message payload's argument), as opposed to `FIND`/`'` which
* parse the next word from the live input stream -- FIND itself is never
* modified, per this project's standing rule; this is a separate,
* mechanism-only primitive for the same lookup from a data-stack string.
* Miss (word not found) is not an error: pushes 0, matching FIND's own
* "miss is NOT an error" convention.
*/
static void mama_word_name_to_xt(VM *vm)
{
if (vm->dsp < 1) {
vm->error = 1;
vm_push(vm, 0);
return;
}
cell_t u = vm_pop(vm);
cell_t caddr = vm_pop(vm);
if (u < 0 || u > 127) {
vm_push(vm, 0);
return;
}
const uint8_t *name = vm_ptr(vm, (vaddr_t)caddr);
if (!name) {
vm->error = 1;
vm_push(vm, 0);
return;
}
DictEntry *e = vm_find_word(vm, (const char *)name, (size_t)u);
vm_push(vm, (cell_t)(uintptr_t)e);
}
/**
* @brief ELEVATE-PUBKEY-UNPACK ( pk0 pk1 pk2 pk3 buf-addr -- )
* Reconstructs a 32-byte Ed25519 pubkey from 4 cells into the 32-byte
* buffer at buf-addr, matching ZUSE-PUBKEY@'s own convention exactly:
* chunk i (0..3) is the 8-byte little-endian encoding of pubkey bytes
* [i*8 .. i*8+7] -- this is that packing's inverse, so a pubkey sent as
* 4 cells (see common:messaging.4th's SEND-ELEVATE-REQUEST) round-trips
* byte-exact regardless of any individual chunk's sign bit.
*/
static void mama_word_elevate_pubkey_unpack(VM *vm)
{
if (vm->dsp < 4) {
vm->error = 1;
return;
}
cell_t buf_addr = vm_pop(vm);
cell_t pk[4];
for (int i = 3; i >= 0; i--) pk[i] = vm_pop(vm);
uint8_t *buf = vm_ptr(vm, (vaddr_t)buf_addr);
if (!buf) {
vm->error = 1;
return;
}
for (int i = 0; i < 4; i++) {
uint64_t chunk = (uint64_t)pk[i];
for (int b = 0; b < 8; b++) {
buf[i * 8 + b] = (uint8_t)(chunk >> (8 * b));
}
}
}
/**
* @brief RUNCAP-TEST ( caddr u -- ok? rc )
* Diagnostic-only word (FABRIC-3.md §F.6/§F.18): calls
@@ -1415,6 +1504,9 @@ void register_mama_forth_words(VM *vm)
register_word(vm, "CAPSULE-RUN", mama_word_capsule_run);
register_word(vm, "MINT", mama_word_mint);
register_word(vm, "ZUSE-ELIGIBILITY-ADD", mama_word_zuse_eligibility_add);
register_word(vm, "ZUSE-ELIGIBLE?", mama_word_zuse_eligible_query);
register_word(vm, "NAME>XT", mama_word_name_to_xt);
register_word(vm, "ELEVATE-PUBKEY-UNPACK", mama_word_elevate_pubkey_unpack);
register_word(vm, "RUNCAP-TEST", mama_word_runcap_test);
register_word(vm, "PAIR-TEST", mama_word_pair_test);
register_word(vm, "MAMA-VM-ID", mama_word_mama_vm_id);
@@ -1448,6 +1540,9 @@ void register_mama_forth_words(VM *vm)
register_word(vm, "CAPSULE-RUN", mama_word_capsule_run);
register_word(vm, "MINT", mama_word_mint);
register_word(vm, "ZUSE-ELIGIBILITY-ADD", mama_word_zuse_eligibility_add);
register_word(vm, "ZUSE-ELIGIBLE?", mama_word_zuse_eligible_query);
register_word(vm, "NAME>XT", mama_word_name_to_xt);
register_word(vm, "ELEVATE-PUBKEY-UNPACK", mama_word_elevate_pubkey_unpack);
register_word(vm, "RUNCAP-TEST", mama_word_runcap_test);
register_word(vm, "PAIR-TEST", mama_word_pair_test);
register_word(vm, "MAMA-VM-ID", mama_word_mama_vm_id);