rajamesandClaude Opus 5.5
1bf19d6224
capsules/v4/sys: the nucleus's fourteen sources as .f18 blobs (made once by v4/tools/v4tof18.py: header becomes the ROM's directives, every other token and line kept), the memory map as map-<width>.f18 (mkmap sys, from one table in host_map.h that host_load reads too), and end.f18, the switch-on state mkimage.c set in C, the image record, and start (IDLE). test_host_rom_nucleus.c: the ROM, fed those blobs through the console, builds RAM identical word for word to mkimage.c's, outside its own state and the image record, and starts at (IDLE), at both widths. The cost: 60.7 million instructions, 1.5 s on the C model. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
128 lines
5.9 KiB
Plaintext
128 lines
5.9 KiB
Plaintext
\ blocks.v4 -- mass storage: blocks of 1024 characters, and text loaded from them.
|
|
\
|
|
\ DECOMPOSITION.md 5.11, FORTH-79: BLOCK BUFFER UPDATE SAVE-BUFFERS
|
|
\ EMPTY-BUFFERS LIST LOAD SCR BLK, and v3's FLUSH THRU and --> . Part of the
|
|
\ compiler capsule; rests on everything before it.
|
|
\
|
|
\ STORAGE IS THE KERNEL'S (docs/v4.0.0/MESH.md section 8, ENGINE.md 3.3), as
|
|
\ it is for a v3 VM. A node only ever asks for a block by number, and it
|
|
\ asks its kernel: it writes a request to port 0, where its kernel is, and
|
|
\ when the write has been served the answer is on the data stack. The
|
|
\ node has a window in its memory, four slots of 256 cells; the kernel
|
|
\ keeps the record of which block is in which slot, does the copying, and
|
|
\ decides when a block is written. The requests (v4/include/v4/blocks.h):
|
|
\ BLOCK# ( n -- waddr status ) the slot holding block n
|
|
\ BUFFER# ( n -- waddr status ) a slot for block n, not read
|
|
\ UPDATE# ( -- status ) the block last asked for is changed
|
|
\ SAVE-BUFFERS# ( -- status ) every changed block is written
|
|
\ EMPTY-BUFFERS# ( -- ) every slot is let go
|
|
\ The status is 0, or 2 storage refused (error 17), or 3 there is no such
|
|
\ block (error 13). BLOCK and BUFFER give a byte address, as PAD and TIB
|
|
\ are: what C@ CMOVE and TYPE take.
|
|
\
|
|
\ Constants the loader supplies:
|
|
\ BLOCK# BUFFER# UPDATE# SAVE-BUFFERS# EMPTY-BUFFERS# the requests' numbers
|
|
\ SCR word address of the variable: the block LIST showed last
|
|
\ BLK (SRC) (SRC-HOOK) see input.v4
|
|
|
|
set HDR-NFA here ", SCR #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : SCR' SCR ;
|
|
set HDR-NFA here ", BLK #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : BLK' BLK ;
|
|
|
|
\ ( status -- ) a request that did not work is an error
|
|
: (B-ERR)
|
|
if FINE -2 + if E17 drop NODE-ERROR b! 13 !b ;
|
|
E17: drop NODE-ERROR b! 17 !b ;
|
|
FINE: drop ;
|
|
|
|
\ ( waddr status -- baddr ) the slot's byte address, or the error
|
|
: (B-GOT)
|
|
if OK SWAP drop jump (B-ERR)
|
|
OK: drop 2* 2* ;
|
|
|
|
\ ( n -- baddr ) FORTH-79: the address of a buffer assigned to block n.
|
|
\ What the buffer holds is not read from storage.
|
|
set HDR-NFA here ", BUFFER #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: BUFFER BUFFER# (PORT) b! !b jump (B-GOT)
|
|
|
|
\ ( n -- baddr ) FORTH-79: the address of a buffer that holds block n,
|
|
\ read from storage if it is not already in one.
|
|
set HDR-NFA here ", BLOCK #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: BLOCK BLOCK# (PORT) b! !b jump (B-GOT)
|
|
|
|
\ FORTH-79: mark the block most recently asked for as changed, so that it is
|
|
\ written before its buffer is used for another.
|
|
set HDR-NFA here ", UPDATE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: UPDATE UPDATE# (PORT) b! !b jump (B-ERR)
|
|
|
|
\ FORTH-79: write every block that has been UPDATEd.
|
|
set HDR-NFA here ", SAVE-BUFFERS #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: SAVE-BUFFERS SAVE-BUFFERS# (PORT) b! !b jump (B-ERR)
|
|
\ As v3: the same.
|
|
set HDR-NFA here ", FLUSH #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: FLUSH jump SAVE-BUFFERS
|
|
\ FORTH-79: forget what is in the buffers; nothing is written.
|
|
set HDR-NFA here ", EMPTY-BUFFERS #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: EMPTY-BUFFERS EMPTY-BUFFERS# (PORT) b! !b ;
|
|
|
|
\ ---- LIST ----------------------------------------------------------------------
|
|
\ ( n -- ) as v3: a new line, "Block n", then sixteen lines of 64
|
|
\ characters, each after its number, and an empty line. SCR is left holding n. A character
|
|
\ that is not printable is shown as a blank. (Q)+0 is the line, (Q)+1 the
|
|
\ column, (Q)+2 the block's number.
|
|
set HDR-NFA here ", LIST #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: LIST
|
|
dup (Q)+2 a! ! BLOCK drop \ an error here leaves nothing behind
|
|
(Q)+2 a! @ dup SCR a! !
|
|
CR $636F6C42 (EMIT4) $206B (EMIT4) 0 DOT-R CR \ "Block "
|
|
0 (Q) a! !
|
|
LN: (Q) a! @ 0 <# # # #> TYPE 58 EMIT SPACE
|
|
0 (Q)+1 a! !
|
|
CH: SCR a! @ BLOCK (Q) a! @ 2* 2* 2* 2* 2* 2* + (Q)+1 a! @ + C@
|
|
dup -32 + -if GE drop drop 32 jump EM
|
|
GE: drop dup -127 + -if BIG drop jump EM
|
|
BIG: drop drop 32
|
|
EM: EMIT
|
|
(Q)+1 a! @ 1 + dup ! -64 + if EOL drop jump CH
|
|
EOL: drop CR
|
|
(Q) a! @ 1 + dup ! -16 + if DONE drop jump LN
|
|
DONE: drop jump CR
|
|
|
|
\ ---- LOAD ----------------------------------------------------------------------
|
|
\ The text being interpreted is at (SRC), SPAN characters of it, >IN the
|
|
\ place in it. LOAD saves those and BLK on the return stack, points them at
|
|
\ the block, interprets it, and puts them back; so a block may LOAD another,
|
|
\ and the rest of the line LOAD was on is interpreted afterwards. (v3's
|
|
\ LOAD loses the rest of its line.)
|
|
|
|
\ ( -- ) what WORD calls before it reads: while a block is being loaded,
|
|
\ make sure it is in a buffer and (SRC) is that buffer.
|
|
: (BLK-SRC)
|
|
BLK a! @ if TERM BLOCK (SRC) a! ! ;
|
|
TERM: drop ;
|
|
|
|
\ ( n -- ) FORTH-79: interpret block n, then go on with what follows.
|
|
set HDR-NFA here ", LOAD #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: LOAD
|
|
-if POS jump BAD
|
|
POS: if BAD
|
|
BLK a! @ push >IN a! @ push SPAN a! @ push (SRC) a! @ push
|
|
BLK a! ! 0 >IN a! ! 1024 SPAN a! !
|
|
&(BLK-SRC) (SRC-HOOK) a! !
|
|
INTERPRET
|
|
pop (SRC) a! ! pop SPAN a! ! pop >IN a! ! pop BLK a! ! ;
|
|
BAD: drop NODE-ERROR b! 13 !b ;
|
|
|
|
\ ( -- ) go on with the next block. Only in a block being loaded: at the
|
|
\ terminal it is an error (code 14).
|
|
set HDR-NFA here ", --> #, 1 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: NEXT-BLOCK
|
|
BLK a! @ if TERM 1 + ! 0 >IN a! ! ;
|
|
TERM: drop NODE-ERROR b! 14 !b ;
|
|
|
|
\ ( first last -- ) as v3: LOAD each block from first to last.
|
|
set HDR-NFA here ", THRU #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here
|
|
: THRU
|
|
push
|
|
L: dup inv pop dup push + 1 + -if GO drop drop pop drop ; \ last - first
|
|
GO: drop dup push LOAD pop 1 + jump L
|