Robert Allan JamesandClaude Sonnet 5
21bca315ff
Extract the messaging vocabulary (arenas, MSG-*/CH-*/MBR-* words) out of capsules/hermes/init.4th into a new shared capsules/common/messaging.4th that Hermes and Artemis each load at birth, giving every VM its own private MSG-ARENA/CH-ARENA instead of only Hermes having one. Hermes stays the owner of the one real, canonical COMMON-CH; Artemis subscribes into it via VM-EXEC at her own birth, and Hermes proactively subscribes Hera (idx 0) since Hera always exists first. Hera does NOT get her own copy: register_child_vm_words()'s own doc comment explains why the STADIUM-* primitives common:messaging.4th depends on are deliberately never registered in her dictionary (keeps her dict_hash off item 4.1's baseline). Confirmed live by loading it into her dictionary anyway first -- every colon-definition referencing an unregistered Stadium primitive was silently dropped (MSG-HEAT@/!, CH-HEAT@/!, MSG-COOL-ALL, MSG-TICK all missing after boot). Reverted that path; she orchestrates via BIRTH/VM-EXEC/VM-CALL instead. Added capsule_vm_registry_get_by_index() (capsule_birth.c/.h) for registry enumeration by birth-order position, and a pump in repl.c's existing idle hook that walks every live VM once per idle beat and VM-EXECs MSG-TICK into each one except Hera's own entry. Verified clean (no UNKNOWN WORD / VM-EXEC errors after birth) on all three architectures. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_019ZGkimpfyh63EZyRkNbkPD
502 lines
15 KiB
Forth
502 lines
15 KiB
Forth
Block 4110
|
|
( Artemis flat pool disk manager )
|
|
( WARNING: no fs layer -- bugs can destroy disk/artemis.img )
|
|
( Disk: LBN 3072..26073 via virtio-blk = 23002 blocks )
|
|
( Hdr: 3072 Fmap: 3073-3075 Data: 3076..26073 )
|
|
3072 CONSTANT ART-HDR-LBN
|
|
3073 CONSTANT ART-FM-LBN
|
|
3 CONSTANT ART-FM-BLKS
|
|
3076 CONSTANT ART-DATA-LBN
|
|
22998 CONSTANT ART-DATA-BLKS
|
|
65208 CONSTANT Q-DECAY
|
|
Block 4178
|
|
( item 4.6 -- StadiumBehaviour tags, match stadium.h. )
|
|
0 CONSTANT SB-MIGRATE
|
|
1 CONSTANT SB-DELIVER
|
|
2 CONSTANT SB-EXPIRE
|
|
3 CONSTANT SB-COOL
|
|
-1 CONSTANT STADIUM-NONE
|
|
Block 4111
|
|
( Arch-neutral little-endian byte I/O -- 32-bit )
|
|
: LE32! ( u addr -- )
|
|
OVER 255 AND OVER C! 1+
|
|
OVER 256 / 255 AND OVER C! 1+
|
|
OVER 65536 / 255 AND OVER C! 1+
|
|
SWAP 16777216 / 255 AND SWAP C! ;
|
|
: LE32@ ( addr -- u )
|
|
DUP C@
|
|
OVER 1+ C@ 256 * +
|
|
OVER 2+ C@ 65536 * +
|
|
SWAP 3 + C@ 16777216 * + ;
|
|
Block 4128
|
|
( LE64 byte I/O -- depends on LE32!/LE32@ )
|
|
: LE64! ( u addr -- )
|
|
2DUP LE32!
|
|
SWAP 4294967296 / SWAP 4 + LE32! ;
|
|
: LE64@ ( addr -- u )
|
|
DUP LE32@
|
|
SWAP 4 + LE32@
|
|
4294967296 * + ;
|
|
Block 4112
|
|
( Bit ops -- 2*/2/ loops; no LSHIFT/RSHIFT in vocabulary )
|
|
: SHL1N ( u n -- u' ) 0 ?DO 2* LOOP ;
|
|
: SHR1N ( u n -- u' ) 0 ?DO 2/ LOOP ;
|
|
: BIT-TEST ( byte bit# -- flag )
|
|
SHR1N 1 AND ;
|
|
: BIT-SET ( byte bit# -- byte' )
|
|
1 SWAP SHL1N OR ;
|
|
: BIT-CLR ( byte bit# -- byte' )
|
|
1 SWAP SHL1N INVERT AND ;
|
|
Block 4113
|
|
( Free map: bit array across LBN 3073-3075 )
|
|
( n = 0-based data block index; n=0 -> LBN 3076 )
|
|
: FM-ADDR-BIT ( n -- bit# addr )
|
|
DUP 7 AND
|
|
SWAP 8 /
|
|
DUP 1024 / ART-FM-LBN + BLOCK
|
|
SWAP 1024 MOD + ;
|
|
: FM-TEST ( n -- flag )
|
|
FM-ADDR-BIT C@ SWAP BIT-TEST ;
|
|
: FM-SET ( n -- )
|
|
FM-ADDR-BIT DUP C@ ROT BIT-SET SWAP C! UPDATE ;
|
|
: FM-CLR ( n -- )
|
|
FM-ADDR-BIT DUP C@ ROT BIT-CLR SWAP C! UPDATE ;
|
|
Block 4137
|
|
( item 4.6 -- Stadium cell-index arena, not a heat arena. One )
|
|
( slot per possible LBN, holding STADIUM-NONE or a live cell )
|
|
( index -- residency exists only while a block is allocated )
|
|
( (admission-on-allocate, FABRIC-2.md item 4.6's ruling). )
|
|
CREATE BLK-CELL ART-DATA-BLKS CELLS ALLOT
|
|
Block 4138
|
|
( Cell-index accessors and LBN conversion. Heat itself now )
|
|
( lives on the Stadium -- see BLK-ADMIT/STADIUM-HEAT@/! below. )
|
|
: BLK-CELL@ ( n -- cell ) CELLS BLK-CELL + @ ;
|
|
: BLK-CELL! ( cell n -- ) CELLS BLK-CELL + ! ;
|
|
: LBN>IDX ( lbn -- n ) ART-DATA-LBN - ;
|
|
Block 4177
|
|
( item 4.6 -- Stadium admission for index n; see 4179. )
|
|
VARIABLE BLK-ADMIT-IDX
|
|
: BLK-ADMIT ( n -- flag )
|
|
BLK-ADMIT-IDX !
|
|
Q.1 STADIUM-RES-PULL
|
|
BLK-ADMIT-IDX @ SWAP DUP >R
|
|
SB-COOL STADIUM-ADMIT
|
|
DUP STADIUM-NONE = IF
|
|
DROP R> STADIUM-RES-PUSH FALSE EXIT
|
|
THEN
|
|
R> DROP
|
|
BLK-ADMIT-IDX @ BLK-CELL!
|
|
BLK-ADMIT-IDX @ FM-SET
|
|
TRUE ;
|
|
Block 4179
|
|
( item 4.6 -- init BLK-CELL[] all-free (STADIUM-NONE). )
|
|
: BLK-CELL-INIT-FREE ( -- )
|
|
ART-DATA-BLKS 0 DO
|
|
STADIUM-NONE I BLK-CELL!
|
|
LOOP ;
|
|
Block 4122
|
|
( Block allocator -- first-free linear scan )
|
|
( NOTE: Hermes owns 4100-9,4114-21,4142+. Artemis resumes 4122 )
|
|
: FM-FIND-FREE ( -- n|-1 )
|
|
ART-DATA-BLKS 0 DO
|
|
I FM-TEST 0= IF I UNLOOP EXIT THEN
|
|
LOOP -1 ;
|
|
: BLK-ALLOC ( -- lbn|-1 )
|
|
FM-FIND-FREE DUP -1 = IF EXIT THEN
|
|
DUP BLK-ADMIT 0= IF DROP -1 EXIT THEN
|
|
ART-DATA-LBN + ;
|
|
Block 4180
|
|
( item 4.6 -- BLK-FREE evicts the Stadium cell too. )
|
|
: BLK-FREE ( lbn -- )
|
|
ART-DATA-LBN -
|
|
DUP 0 < IF DROP EXIT THEN
|
|
DUP ART-DATA-BLKS >= IF DROP EXIT THEN
|
|
DUP FM-TEST 0= IF DROP EXIT THEN
|
|
DUP FM-CLR
|
|
DUP BLK-CELL@ STADIUM-EVICT DROP
|
|
STADIUM-NONE SWAP BLK-CELL! ;
|
|
Block 4123
|
|
( Artemis magic and blank detection )
|
|
( Magic = "ARTEMIS\0" = 41 52 54 45 4D 49 53 00 )
|
|
: ART-MAGIC! ( addr -- )
|
|
65 OVER C! 1+ 82 OVER C! 1+
|
|
84 OVER C! 1+ 69 OVER C! 1+
|
|
77 OVER C! 1+ 73 OVER C! 1+
|
|
83 OVER C! 1+ 0 SWAP C! ;
|
|
: ART-MAGIC? ( addr -- flag )
|
|
DUP C@ 65 =
|
|
OVER 1+ C@ 82 = AND
|
|
OVER 2+ C@ 84 = AND
|
|
OVER 3 + C@ 69 = AND
|
|
OVER 4 + C@ 77 = AND
|
|
OVER 5 + C@ 73 = AND
|
|
OVER 6 + C@ 83 = AND
|
|
SWAP 7 + C@ 0 = AND ;
|
|
Block 4129
|
|
( Artemis -- readiness handshake, Phase 1 )
|
|
: ARTEMIS-ANNOUNCE-READY ( -- )
|
|
S" 2 ENQUEUE-READY" S" Hermes" VM-EXEC ;
|
|
: ARTEMIS-READY-ACK ( -- ) LOG-INFO" Artemis: ready-ack" ;
|
|
VARIABLE BCAST-GOT
|
|
: BCAST-RECV ( -- ) 1 BCAST-GOT +! ;
|
|
Block 4130
|
|
( Blank block detection )
|
|
: ART-BLANK? ( addr -- flag )
|
|
1024 0 DO
|
|
DUP I + C@ 0<> IF
|
|
DROP FALSE UNLOOP EXIT
|
|
THEN
|
|
LOOP DROP TRUE ;
|
|
Block 4124
|
|
( Boot detection and block I/O )
|
|
0 CONSTANT ART-BLANK-DISK
|
|
1 CONSTANT ART-LITHOS-DISK
|
|
2 CONSTANT ART-UNRECOG-DISK
|
|
: ART-BOOT-DETECT ( -- mode )
|
|
ART-HDR-LBN BLOCK
|
|
DUP ART-MAGIC? IF DROP ART-LITHOS-DISK EXIT THEN
|
|
DUP ART-BLANK? IF DROP ART-BLANK-DISK EXIT THEN
|
|
DROP ART-UNRECOG-DISK ;
|
|
: BLK-FETCH ( lbn -- addr )
|
|
DUP ART-DATA-LBN >= IF
|
|
DUP LBN>IDX BLK-CELL@ Q.1 SWAP STADIUM-HEAT! THEN
|
|
BLOCK ;
|
|
: BLK-PERSIST ( lbn -- ) BLOCK DROP UPDATE ;
|
|
: ART-FLUSH ( -- ) FLUSH ;
|
|
Block 4125
|
|
( Artemis header write -- called on first format )
|
|
( Layout: [0-7] magic [8-11] ver [12-15] fm-blks )
|
|
( [16-23] data-start [24-31] total [32-39] free )
|
|
: ART-HDR-WRITE ( -- )
|
|
ART-HDR-LBN BUFFER
|
|
DUP 1024 0 FILL
|
|
DUP ART-MAGIC!
|
|
DUP 8 + 1 SWAP LE32!
|
|
DUP 12 + ART-FM-BLKS SWAP LE32!
|
|
DUP 16 + ART-DATA-LBN SWAP LE64!
|
|
DUP 24 + ART-DATA-BLKS SWAP LE64!
|
|
DUP 32 + ART-DATA-BLKS SWAP LE64!
|
|
DROP UPDATE ;
|
|
Block 4126
|
|
( Boot sequence -- format/resume/halt words )
|
|
( BLK-CONFIRM-FORMAT commits the disk container -- only on )
|
|
( paths that don't halt, so unrecognized disks stay untouched )
|
|
: ART-FORMAT ( -- )
|
|
." Artemis: blank disk -- formatting" CR
|
|
ART-HDR-LBN BLK-CONFIRM-FORMAT
|
|
ART-HDR-WRITE FLUSH ;
|
|
: ART-RESUME ( -- )
|
|
." Artemis: LithosAnanke disk -- resuming" CR
|
|
ART-HDR-LBN BLK-CONFIRM-FORMAT ;
|
|
: ART-HALT-UNRECOG ( -- )
|
|
." ARTEMIS HALT: unrecognized disk content" CR
|
|
." Disk preserved. Manual intervention required." CR
|
|
ABORT ;
|
|
Block 4131
|
|
( ART-INIT -- boot state machine )
|
|
VARIABLE ART-BOOT-MODE
|
|
: ART-INIT ( -- )
|
|
BLK-CELL-INIT-FREE
|
|
ART-BOOT-DETECT DUP ART-BOOT-MODE !
|
|
CASE
|
|
ART-BLANK-DISK OF ART-FORMAT ENDOF
|
|
ART-LITHOS-DISK OF ART-RESUME ENDOF
|
|
ART-UNRECOG-DISK OF ART-HALT-UNRECOG ENDOF
|
|
ENDCASE ;
|
|
Block 4139
|
|
( item 4.6 -- K total, skips non-resident (STADIUM-NONE). )
|
|
: ART-K-TOTAL ( -- q48 )
|
|
0 ART-DATA-BLKS 0 DO
|
|
I BLK-CELL@ DUP STADIUM-NONE <> IF
|
|
STADIUM-HEAT@ +
|
|
ELSE
|
|
DROP
|
|
THEN
|
|
LOOP ;
|
|
Block 4181
|
|
( item 4.6 -- cooling, routed via Stadium residency. )
|
|
: ART-COOL ( -- )
|
|
ART-DATA-BLKS 0 DO
|
|
I BLK-CELL@ DUP STADIUM-NONE <> IF
|
|
DUP STADIUM-HEAT@ Q-DECAY Q.* SWAP STADIUM-HEAT!
|
|
ELSE
|
|
DROP
|
|
THEN
|
|
LOOP ;
|
|
Block 4140
|
|
( Block reap and compudynamic tick )
|
|
: ART-REAP ( -- )
|
|
ART-DATA-BLKS 0 DO
|
|
I FM-TEST IF
|
|
I BLK-CELL@ STADIUM-HEAT@ 0 = IF
|
|
I ART-DATA-LBN + BLK-FREE
|
|
THEN
|
|
THEN
|
|
LOOP ;
|
|
: ART-TICK ( -- )
|
|
ART-COOL ART-REAP ;
|
|
Block 4127
|
|
( Status. item 4.6: ARTEMIS-K mirrors HERMES-K -- block )
|
|
( heat + reservoir + word-execution residents. )
|
|
: ARTEMIS-K ( -- q48 )
|
|
ART-K-TOTAL STADIUM-RES@ + STADIUM-WORD-HEAT + ;
|
|
: ART-STATUS ( -- )
|
|
." Artemis: " ART-DATA-BLKS . ." data blocks" CR
|
|
." K-total=" ART-K-TOTAL Q.PRINT CR
|
|
." ARTEMIS-K=" ARTEMIS-K Q.PRINT CR ;
|
|
: WELCOME ( -- ) ." Artemis ready" CR ART-STATUS ;
|
|
Block 4132
|
|
( Self-test: alloc/fetch/persist/free round-trip )
|
|
: ART-SELF-TEST ( -- )
|
|
." Artemis self-test..." CR
|
|
BLK-ALLOC DUP -1 = IF
|
|
." FAIL: no free blocks" CR DROP EXIT
|
|
THEN
|
|
DUP . ." allocated" CR
|
|
DUP BLK-FETCH DROP
|
|
DUP BLK-PERSIST
|
|
ART-K-TOTAL Q.PRINT ." K after alloc" CR
|
|
BLK-FREE
|
|
ART-K-TOTAL Q.PRINT ." K after free" CR
|
|
ART-FLUSH
|
|
." PASS" CR ;
|
|
Block 4134
|
|
( Persist write test -- blank disk, no free after alloc )
|
|
( Allocs LBN, fills with 0xA5=165, persists. Stays alloc. )
|
|
: ART-WRITE-TEST ( -- )
|
|
." Artemis: persist-write..." CR
|
|
BLK-ALLOC DUP -1 = IF
|
|
." FAIL: no free block" CR DROP EXIT
|
|
THEN
|
|
DUP BLK-FETCH 1024 165 FILL
|
|
BLK-PERSIST
|
|
ART-FLUSH
|
|
." PASS: persist-write" CR ;
|
|
Block 4135
|
|
( Persist read test -- run on resumed disk )
|
|
( Reads ART-DATA-LBN byte 0; expects 165 = 0xA5 )
|
|
: ART-READ-TEST ( -- )
|
|
." Artemis: persist-read..." CR
|
|
ART-DATA-LBN BLK-FETCH C@ 165 = IF
|
|
." PASS: persist-read" CR
|
|
ELSE
|
|
." FAIL: persist-read" CR
|
|
THEN ;
|
|
Block 4136
|
|
( Boot-mode dispatch -- called from entry block )
|
|
: ART-BOOT-ENTRY ( -- )
|
|
ART-BOOT-MODE @
|
|
DUP ART-BLANK-DISK = IF
|
|
DROP ART-SELF-TEST ART-WRITE-TEST EXIT
|
|
THEN
|
|
ART-LITHOS-DISK = IF ART-READ-TEST THEN ;
|
|
Block 4141
|
|
( Artemis CD-INIT -- Hera calls this at fleet boot )
|
|
: CD-INIT ( -- )
|
|
BLK-CELL-INIT-FREE
|
|
LOG-INFO" Artemis: ready" ;
|
|
Block 4133
|
|
( Artemis entry -- runs at capsule load )
|
|
ART-INIT
|
|
ART-BOOT-ENTRY
|
|
WELCOME
|
|
Block 4160
|
|
( Surface stress test storage. Manual-invoke only -- )
|
|
( never called from the entry sequence above. )
|
|
2000 CONSTANT ART-STRESS-CAP
|
|
CREATE ART-STRESS-LBN ART-STRESS-CAP CELLS ALLOT
|
|
CREATE ART-STRESS-PAT ART-STRESS-CAP CELLS ALLOT
|
|
VARIABLE ART-STRESS-N
|
|
VARIABLE ART-STRESS-PASS
|
|
VARIABLE ART-STRESS-FAIL
|
|
VARIABLE S-I
|
|
VARIABLE S-IDX
|
|
VARIABLE S-STRIDE
|
|
VARIABLE S-CUR
|
|
VARIABLE S-ACTUAL
|
|
VARIABLE ART-STRESS-REP
|
|
Block 4161
|
|
( Trial record accessors )
|
|
: SLBN@ ( i -- lbn ) CELLS ART-STRESS-LBN + @ ;
|
|
: SLBN! ( lbn i -- ) CELLS ART-STRESS-LBN + ! ;
|
|
: SPAT@ ( i -- pat ) CELLS ART-STRESS-PAT + @ ;
|
|
: SPAT! ( pat i -- ) CELLS ART-STRESS-PAT + ! ;
|
|
Block 4172
|
|
( CSV emission part 1 -- one row per trial, tagged )
|
|
( so it can be grepped like the DoE CSVs. Every )
|
|
( trial emits a row, pass or fail -- no silent skips. )
|
|
: SCSV-HEADER ( n -- )
|
|
." [ARTSTRESS] HEADER,rep=" ART-STRESS-REP @ .
|
|
." ,n=" DUP . CR
|
|
." [ARTSTRESS] trial,lbn,pat,result" CR ;
|
|
: SCSV-ROW ( -- )
|
|
." [ARTSTRESS] "
|
|
S-I @ . ." ,"
|
|
S-I @ SLBN@ . ." ,"
|
|
S-I @ SPAT@ . ." ,"
|
|
S-ACTUAL @ S-I @ SPAT@ = IF 1 ELSE 0 THEN . CR ;
|
|
Block 4173
|
|
( CSV emission part 2 -- SUMMARY marker. A run that )
|
|
( got killed/timed out mid-way never prints this -- )
|
|
( its absence means the data is incomplete, full )
|
|
( stop, not "probably fine." )
|
|
: SCSV-SUMMARY ( -- )
|
|
." [ARTSTRESS] SUMMARY,rep=" ART-STRESS-REP @ .
|
|
." ," ART-STRESS-N @ . ." ,"
|
|
ART-STRESS-PASS @ . ." ,"
|
|
ART-STRESS-FAIL @ . CR ;
|
|
Block 4162
|
|
( Coprime-stride walk over the data index space -- )
|
|
( visits every index at most once before repeating, )
|
|
( so no O(n) scan against past picks is needed. )
|
|
( ART-DATA-BLKS = 22998 = 2 * 3 * 3833. )
|
|
: S-COPRIME? ( n -- flag )
|
|
DUP 3 MOD 0= IF DROP 0 EXIT THEN
|
|
3833 MOD 0<> ;
|
|
: S-INIT-WALK ( -- )
|
|
0 ART-DATA-BLKS 1 - RANDOM S-CUR !
|
|
BEGIN
|
|
1 ART-DATA-BLKS 1 - RANDOM 1 OR
|
|
DUP S-COPRIME?
|
|
UNTIL
|
|
S-STRIDE ! ;
|
|
Block 4171
|
|
( Step the walk; skip anything already allocated by )
|
|
( someone else -- never clobbers pre-existing data. )
|
|
: SPICK ( -- idx )
|
|
BEGIN
|
|
S-CUR @ S-STRIDE @ + ART-DATA-BLKS MOD S-CUR !
|
|
S-CUR @ FM-TEST 0=
|
|
UNTIL
|
|
S-CUR @ ;
|
|
Block 4163
|
|
( Write one trial. item 4.6: admission can now be refused )
|
|
( -- sentinel LBN=-1 on refusal, no unreserved write. )
|
|
: SWRITE1 ( -- )
|
|
SPICK S-IDX !
|
|
S-IDX @ BLK-ADMIT 0= IF
|
|
-1 S-I @ SLBN! 0 S-I @ SPAT! EXIT
|
|
THEN
|
|
S-IDX @ ART-DATA-LBN + S-I @ SLBN!
|
|
S-I @ 255 AND S-I @ SPAT!
|
|
S-I @ SLBN@ BLK-FETCH
|
|
1024 S-I @ SPAT@ FILL
|
|
S-I @ SLBN@ BLK-PERSIST ;
|
|
Block 4182
|
|
( item 4.6 -- admit-refused trial: count + log + emit row. )
|
|
: SV-REFUSED ( -- )
|
|
1 ART-STRESS-FAIL +!
|
|
-1 S-ACTUAL !
|
|
." STRESS ADMIT-REFUSED trial=" S-I @ . CR
|
|
SCSV-ROW ;
|
|
Block 4164
|
|
( Verify one trial: by now the 8-slot devblock cache )
|
|
( has likely evicted and reloaded this block many )
|
|
( times over -- a real round trip, not a cache hit. )
|
|
( item 4.6: LBN=-1 means admission was refused; see 4182. )
|
|
: SVERIFY1 ( -- )
|
|
S-I @ SLBN@ -1 = IF SV-REFUSED EXIT THEN
|
|
S-I @ SLBN@ BLK-FETCH C@ S-ACTUAL !
|
|
S-ACTUAL @ S-I @ SPAT@ = IF
|
|
1 ART-STRESS-PASS +!
|
|
ELSE
|
|
1 ART-STRESS-FAIL +!
|
|
." STRESS MISMATCH trial=" S-I @ .
|
|
." lbn=" S-I @ SLBN@ . CR
|
|
THEN
|
|
SCSV-ROW ;
|
|
Block 4166
|
|
( Clamp reps into range, kept in its own block so )
|
|
( SVERIFY1 above has room for CSV emission. )
|
|
: ART-STRESS-CLAMP ( reps -- reps' )
|
|
DUP ART-STRESS-CAP > IF DROP ART-STRESS-CAP THEN
|
|
DUP 1 < IF DROP 1 THEN ;
|
|
Block 4165
|
|
( Driver part 1: banner, then the write+verify loops. )
|
|
( Split across several blocks -- a colon definition )
|
|
( must fit in a single 1024-byte/16-line block here. )
|
|
( This is a data-collection fixture, not a fast/live )
|
|
( check -- same posture as the DoE campaign. K is not )
|
|
( gated on live, it's recorded for offline analysis. )
|
|
: ART-STRESS-BANNER ( n -- )
|
|
DUP SCSV-HEADER
|
|
." Artemis: surface stress test, " . ." trials" CR
|
|
ART-K-TOTAL Q.PRINT ." K before" CR ;
|
|
: ART-STRESS-RUN ( -- )
|
|
ART-STRESS-N @ 0 DO I S-I ! SWRITE1 LOOP
|
|
ART-STRESS-N @ 0 DO I S-I ! SVERIFY1 LOOP ;
|
|
Block 4167
|
|
( Driver part 2: pass/fail summary line )
|
|
: ART-STRESS-REPORT ( -- )
|
|
." Artemis stress: "
|
|
ART-STRESS-PASS @ . ." passed, "
|
|
ART-STRESS-FAIL @ . ." failed" CR ;
|
|
Block 4168
|
|
( Driver part 3: free everything this run touched, )
|
|
( print K after for the record. Only write/verify )
|
|
( mismatches gate PASS/FAIL -- a background heartbeat )
|
|
( decay tick during a long run is expected and is not )
|
|
( itself a failure. )
|
|
: ART-STRESS-CLEANUP ( -- )
|
|
ART-STRESS-N @ 0 DO
|
|
I S-I ! S-I @ SLBN@ BLK-FREE
|
|
LOOP
|
|
ART-K-TOTAL Q.PRINT ." K after (should match)" CR
|
|
SCSV-SUMMARY
|
|
ART-STRESS-FAIL @ 0 = IF
|
|
." PASS: surface stress test" CR
|
|
ELSE
|
|
." FAIL: surface stress test" CR
|
|
THEN ;
|
|
Block 4169
|
|
( Top-level entry points )
|
|
: ART-STRESS-TEST ( seed reps -- )
|
|
ART-STRESS-CLAMP ART-STRESS-N ! SEED
|
|
0 ART-STRESS-PASS ! 0 ART-STRESS-FAIL !
|
|
S-INIT-WALK
|
|
ART-STRESS-N @ ART-STRESS-BANNER
|
|
ART-STRESS-RUN ART-STRESS-REPORT
|
|
ART-STRESS-CLEANUP ;
|
|
: ART-STRESS ( -- ) 424242 50 ART-STRESS-TEST ;
|
|
Block 4174
|
|
( Campaign driver -- N independent replicate runs, )
|
|
( each a distinct seed, for statistical power )
|
|
( (Captain Bob: minimum 30 reps). Emits a CAMPAIGN )
|
|
( marker so analysis can auto-detect N from the log. )
|
|
30 CONSTANT ART-STRESS-NREPS
|
|
: ART-STRESS-SEED ( i -- seed ) 1009 * 424242 + ;
|
|
: ART-STRESS-CAMPAIGN ( -- )
|
|
." [ARTSTRESS] CAMPAIGN,nreps=" ART-STRESS-NREPS . CR
|
|
ART-STRESS-NREPS 0 DO
|
|
I ART-STRESS-REP !
|
|
I ART-STRESS-SEED 50 ART-STRESS-TEST
|
|
LOOP
|
|
." [ARTSTRESS] CAMPAIGN-DONE" CR ;
|
|
Block 4170
|
|
( K-invariant/heartbeat verification run (item 4.6) )
|
|
( completed and closed -- reverted to disabled per this )
|
|
( block's own note. Re-enable ART-STRESS-CAMPAIGN (or )
|
|
( \ ART-STRESS for a quick single-run smoke check) if a )
|
|
( future change needs the full 30-rep campaign again. )
|
|
\ ART-STRESS-CAMPAIGN
|
|
Block 4851
|
|
( Cheap touch target for Phase 3 fleet DoE workload -- O(1), )
|
|
( unlike ART-TICK/ART-STATUS which scan all ART-DATA-BLKS. )
|
|
: ART-PING ( -- ) ;
|
|
Block 4852
|
|
( LOAD-DOE: pulls in doe.4th's word-level DOE-WORK )
|
|
( workload, for doe-campaign.4th's remote VM-EXEC. )
|
|
: LOAD-DOE ( -- ) S" doe.4th" EXEC ;
|
|
Block 4853
|
|
( D.7: CD-INIT ran only via the old self-test; birth needs it. )
|
|
CD-INIT
|
|
S" lib.4th" EXEC
|
|
Block 4854
|
|
( Phase C 2026-08-28: own messaging vocab + subscribe into )
|
|
( Hermes's canonical COMMON-CH (idx 2 = Artemis, VM-NAMES- )
|
|
( INIT). Hermes always exists by Artemis's birth. )
|
|
S" common:messaging.4th" EXEC
|
|
MSG-CD-INIT
|
|
S" 2 COMMON-CH @ CH-ADD-MBR" S" Hermes" VM-EXEC
|
|
STARTUP-BANNER
|