rajamesandClaude Opus 5.5
a73580e949
The host node starts in its ROM (entry 12), and the boot feeds it the system's source through the console: capsules/v4/sys/map-64.f18, the fourteen .f18 blobs and end.f18, each found, hash-checked and signature-checked as any capsule, then EOT. The ROM assembles the system and starts it at (IDLE); the host reads the image record (v4_image_from_node) for what only the assembled system knows. A ROM error is reported with its blob, line and meaning, then PARITY:FAIL. Deleted: v4/tools/mkimage.c, capsules/v4/nucleus-64.f18, v4/capsule/*.v4, v4/tools/v4tof18.py. The .f18 files are the source now. - text.c speaks the rest of the ROM's language (set, here, store, start; v4_text_value, v4_text_start), so the oracle reads the same source: test_host_rom_nucleus compares the ROM against text.c on the .f18 files, word for word, image record included. Host tests load the .f18 files. - mkmap image writes v4_map_image (the map's description of the system); hosted and the kernel link the ROM and the map instead of v4_image_64.c. - Hera (Captain Bob's ruling, option 1): births stream the system the ROM assembled, as assembled code; hera.4th is unchanged. test_host_unit's host builds the system with the ROM. - New parity lines: PARITY:V4_F18 per blob, PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216. Acceptance: amd64, aarch64, riscv64 boot to ok> with PARITY:V4_POST tests=538 pass=538 fail=0, POST: PASSED, and PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a on all three -- the same hash as the prebuilt nucleus gave. make -C v4 test test-32 hosted-check: all pass. Logs: logs/20261015-141648, -141938, -142350. Startup cost under QEMU TCG, the ROM's assembly (last V4_F18 line to V4_ROM): amd64 26.7 s of 132 s to ok>; aarch64 41.0 s of 195 s; riscv64 20.5 s of 101 s. Hosted native: +0.85 s. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
84 lines
3.9 KiB
Plaintext
84 lines
3.9 KiB
Plaintext
\ acl.f18 -- word-level access control: the fields of an entry.
|
|
\
|
|
\ DECOMPOSITION.md 5.20, as v3: ACL-MODE@ ACL-MODE! ACL-TTL@ ACL-TTL! ACL-ALLOW@
|
|
\ ACL-ALLOW! ACL-PINNED? ACL-PIN ACL-INHERIT ACL-INIT-PRIMITIVES ACL-HEAT@
|
|
\ ACL-WORD-ID. These are all the capsule does itself; the policy -- what is
|
|
\ strict, how long a TTL is, what is pinned -- is FORTH source, ACL.fth, as
|
|
\ it is ACL.4th in v3. The fields and the check are described in
|
|
\ compile.f18. Rests on compile.f18, quit.f18 and system.f18.
|
|
\
|
|
\ An xt of 0 is an error (code 16, "Not a word"). A pinned word's fields are
|
|
\ not changed by the ! words: they do nothing, as in v3.
|
|
\
|
|
\ Constants the loader supplies:
|
|
\ (ACL-HOOK) word address of the variable: the xt of the recheck word, or 0
|
|
|
|
\ ( xt -- xt ) refuse 0
|
|
: (ACL-XT) if NULL ; NULL: drop NODE-ERROR b! 16 !b 0 ;
|
|
\ ( xt -- flag ) non-zero if it is pinned. A holds the flags' address.
|
|
: (PINNED) -3 + a! @ 64 and ;
|
|
|
|
set HDR-NFA here ", ACL-HOOK #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : ACL-HOOK' (ACL-HOOK) ;
|
|
|
|
set HDR-NFA here ", ACL-MODE@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-MODE@ ( xt -- mode ) (ACL-XT) -3 + a! @ 8/ 255 and ;
|
|
set HDR-NFA here ", ACL-TTL@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-TTL@ ( xt -- n ) (ACL-XT) -3 + a! @ 8/ 8/ 65535 and ;
|
|
set HDR-NFA here ", ACL-ALLOW@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-ALLOW@ ( xt -- flag ) (ACL-XT) -3 + a! @ 32 and if YES drop 0 ; YES: drop -1 ;
|
|
set HDR-NFA here ", ACL-PINNED? #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-PINNED? ( xt -- flag ) (ACL-XT) (PINNED) if NO drop -1 ; NO: ;
|
|
set HDR-NFA here ", ACL-PIN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-PIN ( xt -- ) (ACL-XT) -3 + a! @ 64 OR ! ;
|
|
|
|
set HDR-NFA here ", ACL-MODE! #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-MODE! ( mode xt -- )
|
|
(ACL-XT) (PINNED) if FREE drop drop ;
|
|
FREE: drop 255 and 8* @ -65281 and + ! ;
|
|
\ as v3: below 0 is 0. The TTL is sixteen bits here: above 65535 is 65535.
|
|
set HDR-NFA here ", ACL-TTL! #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-TTL! ( n xt -- )
|
|
(ACL-XT) (PINNED) if FREE drop drop ;
|
|
FREE: drop
|
|
-if POS drop 0 jump SET
|
|
POS: dup -65536 and if SMALL drop drop 65535 jump SET
|
|
SMALL: drop
|
|
SET: 8* 8* @ 65535 and + ! ;
|
|
set HDR-NFA here ", ACL-ALLOW! #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-ALLOW! ( flag xt -- )
|
|
(ACL-XT) (PINNED) if FREE drop drop ;
|
|
FREE: drop if DENY drop @ -33 and ! ;
|
|
DENY: drop @ 32 OR ! ;
|
|
|
|
\ ( src dst -- ) as v3: dst takes src's mode; it is not pinned, its TTL
|
|
\ is 0 and it is allowed. This is the one word that unpins.
|
|
set HDR-NFA here ", ACL-INHERIT #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-INHERIT
|
|
(ACL-XT) SWAP (ACL-XT) \ dst src
|
|
-3 + a! @ $FF00 and \ dst mode
|
|
SWAP -3 + a! @ 255 and -97 and + ! ; \ the five flags, nothing else
|
|
|
|
\ ( xt -- ) every entry from xt back that is not pinned: TTL mode, TTL 0,
|
|
\ allowed
|
|
: (ACL-INIT)
|
|
L: if DONE
|
|
dup (PINNED) if FREE drop jump NXT
|
|
FREE: drop @ 31 and !
|
|
NXT: -1 + a! @ jump L
|
|
DONE: drop ;
|
|
\ ( -- ) as v3: do that to every word in the dictionary, in every vocabulary
|
|
set HDR-NFA here ", ACL-INIT-PRIMITIVES #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-INIT-PRIMITIVES
|
|
(LATEST) a! @ (ACL-INIT)
|
|
VOC-LINK a! @
|
|
V: if DONE dup a! @ (ACL-INIT) 1 + a! @ jump V
|
|
DONE: drop ;
|
|
|
|
\ ( xt -- heat ) how often the word has been used. The node's heat
|
|
\ counters are not readable from a programme yet (D-6): 0.
|
|
set HDR-NFA here ", ACL-HEAT@ #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-HEAT@ (ACL-XT) drop 0 ;
|
|
\ ( xt -- n ) a number for the word that never changes: its address
|
|
set HDR-NFA here ", ACL-WORD-ID #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: ACL-WORD-ID (ACL-XT) ;
|