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 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 ( Block heat arena -- Q48.16 heat per data block slot ) CREATE BLK-HEAT ART-DATA-BLKS CELLS ALLOT Block 4138 ( Block heat accessors and LBN conversion ) : BLK-HEAT@ ( n -- q48 ) CELLS BLK-HEAT + @ ; : BLK-HEAT! ( q48 n -- ) CELLS BLK-HEAT + ! ; : LBN>IDX ( lbn -- n ) ART-DATA-LBN - ; 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 FM-SET Q.1 OVER BLK-HEAT! ART-DATA-LBN + ; : 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 0 SWAP BLK-HEAT! ; 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 Q.1 SWAP BLK-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-HEAT ART-DATA-BLKS CELLS 0 FILL 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 ( Fleet K total and block cooling ) : ART-K-TOTAL ( -- q48 ) 0 ART-DATA-BLKS 0 DO I BLK-HEAT@ + LOOP ; : ART-COOL ( -- ) ART-DATA-BLKS 0 DO I BLK-HEAT@ DUP 0 > IF Q-DECAY Q.* I BLK-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-HEAT@ 0 = IF I ART-DATA-LBN + BLK-FREE THEN THEN LOOP ; : ART-TICK ( -- ) ART-COOL ART-REAP ; Block 4127 ( Status ) : ART-STATUS ( -- ) ." Artemis: " ART-DATA-BLKS . ." data blocks" CR ." K-total=" ART-K-TOTAL 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-HEAT ART-DATA-BLKS CELLS 0 FILL 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: alloc a fresh random free block, ) ( tag it with a trial-derived pattern, and persist ) ( it through the real BLK-ALLOC-style path. ) : SWRITE1 ( -- ) SPICK S-IDX ! S-IDX @ FM-SET Q.1 S-IDX @ BLK-HEAT! 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 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. ) : SVERIFY1 ( -- ) 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 ( TEMP: 30-replicate campaign enabled for the ) ( K-invariant/heartbeat verification run. Revert to ) ( "\ ART-STRESS" (disabled) once that run is done. ) 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 ;