\ 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 header SCR inline : SCR' SCR ; header BLK inline : 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. header BUFFER : 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. header BLOCK : 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. header UPDATE : UPDATE UPDATE# (PORT) b! !b jump (B-ERR) \ FORTH-79: write every block that has been UPDATEd. header SAVE-BUFFERS : SAVE-BUFFERS SAVE-BUFFERS# (PORT) b! !b jump (B-ERR) \ As v3: the same. header FLUSH : FLUSH jump SAVE-BUFFERS \ FORTH-79: forget what is in the buffers; nothing is written. header EMPTY-BUFFERS : 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. header LIST : 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. header LOAD : 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). header --> immediate : 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. header THRU : 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