commit 693a08ac9610a5e34e03592de960cba425596111
parent 620a31659e9f880cbf5f1cefa88649909a8cd21a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 13 May 2023 21:35:19 -0400
fs/fat: consolidate
Diffstat:
| M | fs/fs/fat.fs | | | 90 | ++++++++++++++++++++++++++++++++++++++++---------------------------------------- |
| M | fs/fs/fatlo.fs | | | 41 | ++++++++++++++++++----------------------- |
2 files changed, 63 insertions(+), 68 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -142,47 +142,6 @@ $e5 const DIRFREE
swap r@ :FirstSectorOfCluster ( dst sec )
swap r@ secpercluster swap r> writesectors ;
-: fatflush ( hdl -- ) >r
- r@ FATFile :dirty? not if rdrop exit then ( )
- \ save buffer
- r@ FATFile cluster r@ FATFile :buf( r@ FATFile fat writecluster ( )
- \ save size to direntry
- r@ FATFile :dirent r@ FATFile size swap to DirEntry filesize ( )
- r@ FATFile fat writecursector
- \ undirty the cursor
- r@ FATFile flags $fffffffd and to r> FATFile flags ;
-
-0 structbind FATFile self
-\ grow fcursor to newsz, if needed
-: fatgrow ( newsz self -- ) ['] self rebind
- dup self size <= if drop exit then ( newsz )
- to self size self :cluster0 ( cluster0 )
- \ special case: if :cluster0 is zero, we have an empty file. We need to
- \ update its direntry to record the file's first cluster.
- ?dup not if self fat allocatecluster then ( cluster0 )
- self :dirent 2dup to DirEntry cluster ( custer0 dirent )
- self size swap to DirEntry filesize self fat writecursector ( cluster0 )
- self size self fat :ClusterSize / ?dup if
- for ( cluster ) self fat FAT@+ next then ( cluster ) drop ;
-
-: fatwritebuf ( buf n self -- n )
- dup FATFile :free? if 2drop drop 0 exit then ( buf n self )
- dup >r File pos over + r@ fatgrow ( src n )
- \ TODO: this seek below doesn't seem right. The buffer should be at all times
- \ positioned properly w.r.t. pos.
- r@ File pos r@ FATFile :seek
- r@ FATFile flags 2 or ( dirty ) r@ to FATFile flags
- r@ FATFile :)buf r@ FATFile :ptr - ( src n nmax )
- min ( src n ) r@ FATFile :ptr swap ( src dst n )
- dup >r move r> ( n ) r@ File pos over + r> File :seek ;
-
-\ TODO: deallocate truncated FATs if appropriate
-: fattruncate ( self -- )
- dup FATFile pos ( self pos )
- 2dup swap to FATFile size ( self pos )
- over FATFile :dirent to DirEntry filesize ( self )
- FATFile fat writecursector ;
-
: fatinfo ( id self -- info ) FATInfo :read ;
\ TODO: deallocate the chain before clearing the entry
@@ -208,10 +167,6 @@ $e5 const DIRFREE
: :patchlo ( fs -- ) >r \ V1=fs
['] fatinfo r@ 12 + ! ['] fatiter r@ 20 + !
['] fatnewfile r@ 24 + ! ['] fatnewdir r@ 28 + ! ['] fatremove r@ 32 + !
- ['] fatwritebuf FATFile EmptyCursor 8 + !
- ['] fatflush FATFile EmptyCursor 12 + !
- ['] fatflush FATFile EmptyCursor 12 + !
- ['] fattruncate FATFile EmptyCursor 40 + !
1 r> to flags ;
: :mountvolume ( drv -- fs ) FAT :mountvolume dup :patchlo ;
@@ -250,3 +205,48 @@ create _FATTemplate
$fffff0 here !
( drv ) fatopts rsvdsec here rot Drive :sec! 2rdrop ;
]struct
+
+struct+[ FATFile
+ : _flush ( hdl -- )
+ r! :dirty? not if rdrop exit then ( )
+ \ save buffer
+ r@ cluster r@ :buf( r@ :fat writecluster ( )
+ \ save size to direntry
+ r@ :dirent r@ size swap to DirEntry filesize ( )
+ r@ :fat writecursector
+ \ undirty the cursor
+ r@ flags $fffffffd and to r> flags ;
+ current ' :flush realias
+
+ \ grow fcursor to newsz, if needed
+ : _grow ( newsz self -- )
+ 2dup size <= if 2drop exit then
+ r! to size V1 :cluster0 ( cluster0 ) \ V1=self
+ \ special case: if :cluster0 is zero, we have an empty file. We need to
+ \ update its direntry to record the file's first cluster.
+ ?dup not if V1 :fat allocatecluster then ( cluster0 )
+ V1 :dirent 2dup to DirEntry cluster ( custer0 dirent )
+ V1 size swap to DirEntry filesize V1 :fat writecursector ( cluster0 )
+ V1 size V1 :fat :ClusterSize / ?dup if
+ for ( cluster ) V1 :fat FAT@+ next then ( cluster ) drop rdrop ;
+
+ : _writebuf ( buf n self -- n )
+ dup :free? if 2drop drop 0 exit then ( buf n self )
+ dup >r pos over + r@ _grow ( src n )
+ \ TODO: this seek below doesn't seem right. The buffer should be at all times
+ \ positioned properly w.r.t. pos.
+ r@ pos r@ :seek
+ r@ flags 2 or ( dirty ) r@ to flags
+ r@ :)buf r@ :ptr - ( src n nmax )
+ min ( src n ) r@ :ptr swap ( src dst n )
+ dup >r move r> ( n ) r@ pos over + r> :seek ;
+ current ' :writebuf realias
+
+ \ TODO: deallocate truncated FATs if appropriate
+ : _truncate ( self -- )
+ dup pos ( self pos )
+ 2dup swap to size ( self pos )
+ over :dirent to DirEntry filesize ( self )
+ :fat writecursector ;
+ current ' :truncate realias
+]struct
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -162,51 +162,46 @@ extends File struct[ FATFile
: :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ;
: :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
+ alias abort :writebuf
+ alias drop :flush
+ alias abort :truncate
+
: _poscluster ( self -- idx ) bi pos | bufsz / ;
: _inbounds? ( self -- f ) bi _poscluster | clusteridx = ;
\ set self to pos. If new pos crosses cluster boundaries compared to current
\ pos, flush current buffer and read a new sector from disk.
- : :fatseek ( pos self -- )
+ : :seek ( pos self -- )
dup :free? if 2drop exit then >r ( pos ) \ V1=self
dup 0< if abort" can't seek to negative pos" then
V1 to pos V1 _inbounds? not if
- V1 IO :flush V1 _poscluster dup V1 to clusteridx ( idx )
+ V1 :flush V1 _poscluster dup V1 to clusteridx ( idx )
V1 :cluster0 ( idx cl ) swap for ( cl ) V1 :fat :FAT@ next ( cl )
dup V1 :buf( V1 :fat :readcluster ( cl ) V1 to cluster then rdrop ;
- : :fatreadbuf ( n self -- a? n )
+ : :readbuf ( n self -- a? n )
dup :free? if 2drop 0 exit then ( n self )
bi+ size | pos - ( n self maxn )
dup 1- 0< if ( EOF ) 2drop drop 0 exit then swap >r ( n maxn ) \ V1=self
min ( n ) \ make sure that n doesn't go over size
- r@ pos r@ :fatseek ( n )
+ r@ pos r@ :seek ( n )
r@ :ptr r@ :)buf over - ( n a nmax )
rot min ( a n ) dup r> to+ pos ( a n ) ;
- : :fatclose ( self -- ) dup :flush :release ;
-
- \ these words below are "static" words not called with "self" as an argument,
- \ but "fat".
- : :cursorsize ( fat -- sz ) FAT :ClusterSize SZ + ;
+ : :close ( self -- ) dup :flush :release ;
- create EmptyCursor
- 0 ( putback ) , ' :fatreadbuf , ' abort , ' drop , ' :fatclose ,
- 0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , 0 ( bufsz ) , ' :fatseek ,
- ' abort ( truncate ) , 0 ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
+ : :new ( fat -- hdl )
+ 0 align4 dup to' FAT lastcursor lladd ( fat newll ) drop here >r
+ 0 ( putback ) , ['] :readbuf , ['] :writebuf , ['] :flush , ['] :close ,
+ 0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , dup FAT :ClusterSize ( bufsz ) ,
+ ['] :seek , ['] :truncate , ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
-1 ( clusteridx ) , 0 ( entryoff ) ,
-
- : :createcursor ( fat -- hdl )
- 0 align4 dup to' FAT lastcursor lladd ( fat newll )
- swap :cursorsize allot ( newll ) CELLSZ + ( hdl ) dup :release ;
+ here r@ to bufptr r@ bufsz allot r> ;
: :findfreecursor ( fat -- hdl )
- r! FAT lastcursor begin ( ll ) \ V1=fat
+ dup FAT lastcursor begin ( fat ll )
?dup while dup CELLSZ + :free? not while llnext repeat
- CELLSZ + else r@ :createcursor then
- EmptyCursor over SZ move ( hdl )
- r@ FAT :ClusterSize over to bufsz
- dup SZ + over to bufptr
- r> over to fat ;
+ nip CELLSZ + else :new then
+ 0 over to pos -1 over to clusteridx ;
]struct
struct+[ FAT
