rajamesandClaude Opus 5.5
c8dc14897c
- The golden model's host node gets a block storage device: four memory-mapped registers (number, address, command, status), 1024-byte blocks as 256 cells. tests/test_node.c. - capsule/blocks.v4: BLOCK BUFFER UPDATE SAVE-BUFFERS EMPTY-BUFFERS LIST LOAD SCR BLK (FORTH-79) and v3's FLUSH THRU and -->, over two buffers. - The text being interpreted is at the address in (SRC), which QUERY makes the terminal's buffer and LOAD a block's; LOAD saves and restores it, so blocks nest and the rest of LOAD's line runs afterwards. WORD makes sure a loading block is still in a buffer before it reads. - In a block, \ skips to the next 64-character line. - A block number that does not exist, and --> at the terminal, are errors with messages (D-18). - tests/test_host_quit.c: ten transcripts of the v3 binary; nesting three deep on two buffers; what reaches the device and when. v3's LOAD drops the rest of its line, and v3 has no BLK. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
157 lines
6.2 KiB
Plaintext
157 lines
6.2 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.
|
|
\
|
|
\ THE DEVICE (D-19) is four registers: the block's number, the word address
|
|
\ of 256 cells, a command -- 1 read, 2 write -- and a status that is 0 when
|
|
\ the command worked.
|
|
\
|
|
\ THE BUFFERS. There are two, of 256 cells each, so two blocks can be in
|
|
\ memory at once -- one can be copied to another. A buffer is given to the
|
|
\ block that asks for one, turn about; if it held a block that was UPDATEd,
|
|
\ that block is written first. BLOCK and BUFFER give a byte address, as PAD
|
|
\ and TIB are: what C@ CMOVE and TYPE take.
|
|
\
|
|
\ Constants the loader supplies:
|
|
\ BLOCK-NUMBER BLOCK-ADDRESS BLOCK-COMMAND BLOCK-STATUS the device
|
|
\ BUF0 BUF1 word addresses of the two buffers
|
|
\ (B) word address of six cells: (B)+0 the block in buffer 0, or 0
|
|
\ (B)+1 whether it has been UPDATEd (B)+2 (B)+3 the same for
|
|
\ buffer 1 (B)+4 which buffer was asked for last, 0 or 2
|
|
\ (B)+5 the block number while a buffer is found for it
|
|
\ 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 ;
|
|
|
|
\ ( i -- addr ) the word address of buffer i, where i is 0 or 2
|
|
: (BUF) if Z drop BUF1 ; Z: drop BUF0 ;
|
|
|
|
\ ( command i -- ) read or write buffer i's block. A block the device
|
|
\ does not have is an error (code 13); the buffer is then empty.
|
|
: (DEVICE)
|
|
dup (B) + a! @ BLOCK-NUMBER b! !b \ command i
|
|
dup (BUF) BLOCK-ADDRESS b! !b
|
|
push BLOCK-COMMAND b! !b pop \ i
|
|
BLOCK-STATUS b! @b if FINE
|
|
drop (B) + a! 0 !+ 0 ! \ nothing is in the buffer
|
|
NODE-ERROR b! 13 !b ;
|
|
FINE: drop drop ;
|
|
|
|
\ ( i -- ) if buffer i's block has been UPDATEd, write it
|
|
: (SAVE)
|
|
dup (B) + 1 + a! @ if CLEAN
|
|
drop 0 ! 2 SWAP jump (DEVICE)
|
|
CLEAN: drop drop ;
|
|
|
|
\ ( n -- i flag ) the buffer for block n: the one that has it, flag -1; or
|
|
\ the other of the one asked for last, its old block written if need be and
|
|
\ n's number put on it, flag 0 -- what it holds is not block n yet. A block
|
|
\ number below 1 is an error (code 13).
|
|
: (FIND-BUF)
|
|
-if POS jump BAD
|
|
POS: if BAD
|
|
(B)+5 a! !
|
|
(B) a! @ (B)+5 a! @ xor if HIT0 drop
|
|
(B)+2 a! @ (B)+5 a! @ xor if HIT2 drop
|
|
(B)+4 a! @ 2 xor dup ! \ the other one
|
|
dup (SAVE)
|
|
dup (B) + a! (B)+5 b! @b !+ 0 ! \ its block now, not updated
|
|
0 ;
|
|
HIT0: drop 0 (B)+4 a! ! 0 -1 ;
|
|
HIT2: drop 2 (B)+4 a! ! 2 -1 ;
|
|
BAD: drop NODE-ERROR b! 13 !b 0 -1 ;
|
|
|
|
\ ( 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 (FIND-BUF) drop (BUF) 2* 2* ;
|
|
|
|
\ ( 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
|
|
(FIND-BUF) if READ drop (BUF) 2* 2* ;
|
|
READ: drop drop \ which buffer is in (B)+4: nothing waits on the stack
|
|
1 (B)+4 a! @ (DEVICE) (B)+4 a! @ (BUF) 2* 2* ;
|
|
|
|
\ 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 (B)+4 a! @ (B) + a! @+ if NONE drop -1 ! ; NONE: drop ;
|
|
|
|
\ FORTH-79: write every block that has been UPDATEd.
|
|
header SAVE-BUFFERS
|
|
: SAVE-BUFFERS 0 (SAVE) 2 jump (SAVE)
|
|
\ 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 (B) a! 0 !+ 0 !+ 0 !+ 0 ! ;
|
|
|
|
\ ---- 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
|