duskos

commit 4bebaabd8745469e415f3e8d30fa52d763ad6b01
parent 5d90b7b0032d6007d475c6e02adae169d3a981f6
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri,  8 Jul 2022 10:01:56 -0400

fs/fat: add fatseek

Adding simple write capabilities is a big chunk to add at once, so here's
another little part of the puzzle.

fatseek is not stricly needed for the immediate goal I have (fatputc), but any
scheme I come up with for dirty buffer management which would work with the
"pos always inc by 1" logic would have to be undone when seek capabilities
would be needed, so we might as well add seek now.

Diffstat:
M
fs/fs/fatlo.fs
 | 
48
++++++++++++++++++++++++++++++++++--------------

1 file changed, 34 insertions(+), 14 deletions(-)
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -4,8 +4,11 @@
 \ embedded in the boot sequence and provide the means to continue bootstrapping
 \ on.
 
-\ Its goal is to provide fopen, fclose and fgetc, nothing more. The rest of the
-\ FAT12/FAT16 implementation is in fs/fat.
+\ Its goal is to provide a read-only access to FAT12/FAT16 volumes. The "write"
+\ part is in fs/fat. This unit is more than strictly necessary to get through
+\ the boot process, but it is organized thus so that we can leverage a maximum
+\ of logic from this unit in fs/fat. All in all, "read and core stucture" is
+\ here, "write" is in fs/fat.
 
 \ This unit has access to a very small set of words, that it, words implemented
 \ by boot.fs as well as (drv@) and drvblksz from the "drive" protocol, which is
@@ -138,7 +141,7 @@ here const )fnbuf
 \ 4b flags. all zeroes = free cursor
 \    b0 = used
 \    b1 = buffer is dirty
-\ 4b current cluster in buf 0=free cursor. the cluster is not actually read
+\ 4b current cluster in buf 0=nothing. the cluster is not actually read
 \    until the first position of the cluster is needed.
 \ 4b offset, on disk, of direntry
 \ 4b cur pos (offset from beginning of file)
@@ -153,11 +156,14 @@ here const )fnbuf
 : FCUR_cluster ( fcur -- n ) 4 + @ ;
 : FCUR_cluster! ( n fcur -- ) 4 + ! ;
 : FCUR_pos ( fcur -- n ) 12 + @ ;
-: FCUR_pos+ ( fcur -- ) 12 + 1 swap +! ;
+: FCUR_pos! ( n fcur -- n ) 12 + ! ;
 : FCUR_size ( fcur -- n ) 16 + @ ;
 : FCUR_size+ ( fcur -- ) 16 + 1 swap +! ;
 : FCUR_buf( ( fcur -- a ) 20 + ;
 : FCUR_bufpos ( fcur -- a ) dup FCUR_pos ClusterSize mod swap FCUR_buf( + ;
+: FCUR_dirent ( fcur -- dirent )
+  8 + @ BPB_BytsPerSec /mod ( offset sec ) 1 readsector ( off ) fatbuf( + ;
+: FCUR_cluster0 ( fcur -- cl ) FCUR_dirent DIR_Cluster ;
 
 create fcursors( FCursorSize FCURSORCNT * allot0
 
@@ -172,26 +178,40 @@ create fcursors( FCursorSize FCURSORCNT * allot0
     A> over (drv@) A+ drvblksz + next ( buf ) drop r>A ;
 
 : readcluster ( cluster dst -- )
+  over 2 - $fff6 > if abort" cluster out of range!" then
   swap FirstSectorOfCluster ( dst sec ) swap BPB_SecPerClus swap readsectors ;
 
 \ Open the specified "direntry" into one of the free cursors and return that
 \ cursor.
 : openfile ( direntry -- fcursor )
   findfreecursor >r
-  dup DIR_Cluster ( dirent cluster )
-  ( dirent cluster ) r@ FCUR_cluster! ( dirent ) 1 r@ FCUR_flags!
+  0 r@ FCUR_cluster! ( dirent ) 1 r@ FCUR_flags!
   dup fatbuf( - bufsec BPB_BytsPerSec * + ( dirent doffset ) r@ 8 + !
-  0 r@ 12 + ! DIR_FileSize r@ 16 + ! ( ) r> ;
+  -1 r@ 12 + ! DIR_FileSize r@ 16 + ! ( ) r> ;
 
 : fatopen ( path -- fcursor ) fatfindpath openfile ;
 
+\ if the cursor is dirty, write its buffer to disk as well as its size to the
+\ direntry on disk. Unsets the dirty flag.
+\ as long as fs/fat is not loaded, we can't write anything to files, so fatflush
+\ will always be a noop.
+alias drop fatflush ( fcursor -- )
+
+\ set fcursor to pos. If new pos crosses cluster boundaries compared to current
+\ pos, flush current buffer and read a new sector from disk.
+: fatseek ( pos fcursor -- )
+  over 0< if abort" can't seek to negative pos" then
+  over ClusterSize / over FCUR_pos ClusterSize / = not if \ cluster change!
+    dup fatflush ( pos fcursor )
+    over ClusterSize / over FCUR_cluster0 ( pos fc clcnt cl )
+    swap ?dup if >r begin ( pos fc cl ) FAT@ next then ( pos fc cl )
+    2dup swap FCUR_buf( readcluster ( pos fc cl )
+    over FCUR_cluster! ( pos fc )
+  then ( pos fcursor ) FCUR_pos! ;
+
 : fatgetc ( fcursor -- c )
-  dup FCUR_pos over FCUR_size = if drop -1 exit then
-  dup FCUR_pos ClusterSize mod not if ( fc ) \ end of cluster, read next
-    dup FCUR_cluster ( fc cluster )
-    dup 2 < if abort" cluster out of range" then
-    2dup swap FCUR_buf( readcluster ( fc cluster )
-    FAT@ over FCUR_cluster! then ( fc )
-  dup FCUR_bufpos c@ swap FCUR_pos+ ;
+  dup FCUR_pos 1+ over FCUR_size over <= if \ EOF!
+    2drop -1 exit then ( fc pos )
+  over fatseek ( fcursor ) FCUR_bufpos c@ ;
 
 : fatclose ( fcursor ) 0 swap w! ;