commit 30ca2438e12b1ab413d0b65cd2f7ea4640c7e002
parent 62c101abd49e86491a9349069ccd233c51d9e48f
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 10 Jul 2022 07:14:05 -0400
fs/fat: implement fatputc!
We're rolling!
Diffstat:
3 files changed, 58 insertions(+), 3 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -23,7 +23,7 @@ $ffff const EOC
$f000 and rot $fff and or then ( a n )
swap w! ;
: FAT16! ( entry cluster -- ) FAT16' w! ;
-: FAT! ( entry cluster ) FAT12? if FAT12! else FAT16! then ;
+: FAT! ( entry cluster ) FAT12? if FAT12! else FAT16! then writecursector ;
: zerocluster ( cluster -- )
fatbuf( BPB_BytsPerSec 0 fill
@@ -34,6 +34,13 @@ $ffff const EOC
: findfreecluster ( -- cluster )
1 begin ( cl ) 1+ dup FAT@ not until ( cluster ) ;
+\ Get next FAT entry and if it's EOC, allocate a new one
+: FAT@+ ( cluster -- entry )
+ dup FAT@ ( cl ncl ) dup EOC? if
+ drop findfreecluster ( cl ncl ) 2dup swap FAT! ( cl ncl )
+ EOC swap FAT!
+ else nip then ;
+
\ try to find in current buffer
: _findinsec ( -- a-or-0 )
fatbuf( begin ( a )
@@ -57,3 +64,43 @@ $ffff const EOC
fatfindpathdir findfreedirentry
dup DIRENTRYSZ 0 fill ( direntry )
fnbuf( swap FNAMESZ move writecursector ;
+
+\ write multiple sectors from buf
+: writesectors ( sec u buf -- )
+ A>r swap >r swap >A begin ( buf )
+ A> over (drv!) A+ drvblksz + next ( buf ) drop r>A ;
+
+: writecluster ( cluster src -- )
+ over 2 - $fff6 > if abort" cluster out of range!" then
+ swap FirstSectorOfCluster ( dst sec ) swap BPB_SecPerClus swap writesectors ;
+
+: _ ( fcursor -- ) \ fatflush
+ dup FCUR_dirty? not if drop exit then ( fcursor )
+ \ save buffer
+ dup FCUR_cluster over FCUR_buf( writecluster ( fcursor )
+ \ save size to direntry
+ dup FCUR_dirent over FCUR_size swap DIR_FileSize! ( fcursor )
+ writecursector
+ \ undirty the cursor
+ dup FCUR_flags $fffffffd and swap FCUR_flags! ;
+current to fatflush
+
+\ grow fcursor to newsz, if needed
+: fatgrow ( newsz fcursor -- )
+ 2dup FCUR_size <= if 2drop exit then ( newsz fc )
+ dup >r FCUR_size! r@ FCUR_cluster0 ( cluster0 )
+ \ special case: if FCUR_cluster0 is zero, we have an empty file. We need to
+ \ update its direntry to record the file's first cluster.
+ ?dup not if findfreecluster then ( cluster0 )
+ r@ FCUR_dirent 2dup DIR_Cluster! ( custer0 dirent )
+ r@ FCUR_size swap DIR_FileSize! writecursector ( cluster0 )
+ r> FCUR_size ClusterSize / ?dup if
+ >r begin ( cluster ) FAT@+ next then ( cluster ) drop ;
+
+\ Write c to fcursor and advance the position by one, growing the file if
+\ needed.
+: fatputc ( c fcursor -- )
+ dup >r FCUR_pos 1+ dup 1+ r@ fatgrow ( c newpos R:fcursor )
+ r@ fatseek
+ r@ FCUR_flags 2 or ( dirty ) r@ FCUR_flags! ( c R:fcursor )
+ r> FCUR_bufpos c! ;
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -79,7 +79,9 @@ here const )fatbuf
11 const FNAMESZ
: DIR_Name ( direntry -- sa sl ) FNAMESZ ;
: DIR_Cluster ( direntry -- cluster ) 26 + w@ ;
+: DIR_Cluster! ( cluster direntry -- ) 26 + w! ;
: DIR_FileSize ( direntry -- sz ) 28 + @ ;
+: DIR_FileSize! ( sz direntry -- sz ) 28 + ! ;
\ Just a dummy entry so that we can reference the root directory as a "direntry"
create rootdirentry( DIRENTRYSZ allot0
@@ -158,7 +160,7 @@ here const )fnbuf
: FCUR_pos ( fcur -- n ) 12 + @ ;
: FCUR_pos! ( n fcur -- n ) 12 + ! ;
: FCUR_size ( fcur -- n ) 16 + @ ;
-: FCUR_size+ ( fcur -- ) 16 + 1 swap +! ;
+: FCUR_size! ( n fcur -- ) 16 + ! ;
: FCUR_buf( ( fcur -- a ) 20 + ;
: FCUR_bufpos ( fcur -- a ) dup FCUR_pos ClusterSize mod swap FCUR_buf( + ;
: FCUR_dirent ( fcur -- dirent )
@@ -214,4 +216,4 @@ alias drop fatflush ( fcursor -- )
2drop -1 exit then ( fc pos )
over fatseek ( fcursor ) FCUR_bufpos c@ ;
-: fatclose ( fcursor ) 0 swap w! ;
+: fatclose ( fcursor ) dup fatflush 0 swap FCUR_flags! ;
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -29,4 +29,10 @@ S" /lib/str.fs" fatfindpath # \ found!
\ can we create a new file?
S" newfile" fatnewfile #
S" /newfile" fatfindpath # \ found!
+\ let's try writing to it
+S" /newfile" fatfindpath openfile ( fc )
+dup FCUR_cluster0 0 #eq \ no cluster allocated yet
+\ TODO: that SPC shouldn't be required
+'4' over fatputc '2' over fatputc SPC over fatputc fclose
+f<< /newfile 42 #eq
testend
