feat(v4.0.0): block storage, LOAD and LIST (D-19)
- 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>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
0fbe1432b7
commit
c8dc14897c
@@ -0,0 +1,156 @@
|
||||
\ 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
|
||||
@@ -16,6 +16,7 @@
|
||||
\ 7 Control structure mismatch 8 Control structures too deep
|
||||
\ 9 Shift count out of range 10 Protected word
|
||||
\ 11 Division by zero (Q./) 12 Argument out of range
|
||||
\ 13 Block out of range 14 No block is being loaded
|
||||
\ -1 the word has printed its own message
|
||||
|
||||
macro SWAP over push push drop pop pop endmacro
|
||||
|
||||
+21
-5
@@ -13,13 +13,22 @@
|
||||
\ EXPECT or QUERY read
|
||||
\ WBUF byte address of WORD's buffer, 257 bytes
|
||||
\ (P) word address of eight cells of scratch for this file
|
||||
\ (SRC) word address of the variable: the byte address of the text being
|
||||
\ interpreted. QUERY makes it TIB; LOAD (blocks.v4) makes it a
|
||||
\ block buffer. >IN is an offset from it and SPAN its length.
|
||||
\ (SRC-HOOK) word address of a variable: 0, or the address of a word
|
||||
\ that WORD calls before it looks at the text, to make sure (SRC)
|
||||
\ is right. LOAD puts one there: a block buffer can be given to
|
||||
\ another block between one word of the text and the next.
|
||||
\ BLK word address of the variable: the block being interpreted, or
|
||||
\ 0 for the terminal (FORTH-79)
|
||||
\ TIB >IN SPAN and BL are in-line: written in a definition they are literals.
|
||||
|
||||
macro BL 32 endmacro
|
||||
|
||||
\ ( -- baddr u ) the input buffer and how much of it is in use
|
||||
header SOURCE
|
||||
: SOURCE TIB SPAN a! @ -if P drop 0 P: ;
|
||||
: SOURCE (SRC) a! @ SPAN a! @ -if P drop 0 P: ;
|
||||
|
||||
\ ( baddr n -- ) FORTH-79: characters from the terminal are stored from
|
||||
\ baddr upward until a new-line or until n have been received; the new-line
|
||||
@@ -49,7 +58,7 @@ header EXPECT
|
||||
|
||||
\ ( -- ) FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0.
|
||||
header QUERY
|
||||
: QUERY TIB 80 EXPECT 0 >IN a! ! ;
|
||||
: QUERY TIB (SRC) a! ! TIB 80 EXPECT 0 >IN a! ! ;
|
||||
|
||||
\ ---- WORD ------------------------------------------------------------------
|
||||
\ WORD is called from deep inside the interpreter and compiler, with whatever
|
||||
@@ -64,7 +73,7 @@ header QUERY
|
||||
|
||||
\ In line, not called: WORD may have only a few return entries to spare.
|
||||
macro (LEFT) (P)+6 a! @ (P)+1 a! @ - endmacro \ ( -- d ) d < 0 while inside the text
|
||||
macro (CH) (P)+6 a! @ TIB + C@ (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (CH) (P)+6 a! @ (SRC) a! @ + C@ (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
|
||||
macro (STEP) (P)+6 a! @ 1 + ! endmacro
|
||||
|
||||
\ ( c -- baddr ) FORTH-79: characters are taken from TIB until the
|
||||
@@ -78,6 +87,10 @@ macro (STEP) (P)+6 a! @ 1 + ! endmacro
|
||||
\ than if it were written in one piece.
|
||||
: (WORD-SET) ( c -- )
|
||||
255 and (P) a! !
|
||||
(SRC-HOOK) a! @ if NONE push ex \ call it: ex comes back to the next word
|
||||
jump HOOKED
|
||||
NONE: drop
|
||||
HOOKED:
|
||||
SPAN a! @ -if A drop 0 A: (P)+1 a! !
|
||||
>IN a! @ -if B drop 0 B: (P)+6 a! ! ;
|
||||
|
||||
@@ -91,7 +104,7 @@ macro (STEP) (P)+6 a! @ 1 + ! endmacro
|
||||
(P)+2 a! @ WBUF C!
|
||||
\ copy it, last character first
|
||||
CP: (P)+3 a! @ if COPIED -1 + dup ! \ k
|
||||
dup (P)+7 a! @ + TIB + C@ \ k c
|
||||
dup (P)+7 a! @ + (SRC) a! @ + C@ \ k c
|
||||
SWAP WBUF+1 + C!
|
||||
jump CP
|
||||
COPIED: drop
|
||||
@@ -190,4 +203,7 @@ header NUMBER
|
||||
header ( immediate
|
||||
: PAREN 41 WORD drop ;
|
||||
header \ immediate
|
||||
: BACKSLASH SPAN a! @ >IN a! ! ;
|
||||
\ In a block a line is 64 characters: skip to the start of the next.
|
||||
: BACKSLASH
|
||||
BLK a! @ if TERM drop >IN a! @ -64 and 64 + ! ;
|
||||
TERM: drop SPAN a! @ >IN a! ! ;
|
||||
|
||||
+6
-2
@@ -22,7 +22,8 @@
|
||||
\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that.
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ (Q) word address of two cells of scratch for this file
|
||||
\ (Q) word address of four cells of scratch, which system.v4 and
|
||||
\ blocks.v4 use too
|
||||
\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers
|
||||
|
||||
\ ( -- ) empty the return stack. `a` is only something to store: any
|
||||
@@ -46,6 +47,7 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
|
||||
GO: drop
|
||||
READ:
|
||||
$203E6B6F (EMIT4) \ "ok> "
|
||||
0 BLK a! ! \ the terminal, whatever was being loaded
|
||||
QUERY
|
||||
0 NODE-ERROR b! !b
|
||||
INTERPRET
|
||||
@@ -96,7 +98,7 @@ header ABORT
|
||||
-if POS drop 2 jump (REPL)
|
||||
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
||||
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
||||
-1 + if M10 -1 + if M11 -1 + if M12
|
||||
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
||||
drop 2 jump (REPL)
|
||||
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL)
|
||||
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL)
|
||||
@@ -110,6 +112,8 @@ header ABORT
|
||||
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (REPL)
|
||||
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (REPL)
|
||||
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
|
||||
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
|
||||
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
|
||||
|
||||
\ The table the loader gives the node: six words, one for each kind of
|
||||
\ fault in the node's order, each a jump. A jump fills its word, so they
|
||||
|
||||
Reference in New Issue
Block a user