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 )
: ART-FORMAT ( -- )
  ." Artemis: blank disk -- formatting" CR
  ART-HDR-WRITE FLUSH ;
: ART-RESUME ( -- )
  ." Artemis: LithosAnanke disk -- resuming" CR ;
: 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 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 ;