@@ 77,7 77,7 @@ $e5 const DIRFREE
: FAT! ( entry cluster self -- ) dup :FAT12? if FAT12! else FAT16! then ;
: zerocluster ( cluster self -- )
- r! :FirstSectorOfCluster V1 secpercluster V1 :dirwin :move \ V1=self
+ r! :clustersec V1 secpercluster V1 :dirwin :move \ V1=self
0 V1 :dirwin :seek 0 fill V1 secpercluster for
V1 :dirwin sec i + V1 :dirwin :buf( V1 :drv :sec! next rdrop ;
@@ 124,24 124,13 @@ $e5 const DIRFREE
V2 over to DirEntry cluster V1 writecursector ( dirent )
V1 :getid ( id ) V1 bufcluster >r \ V3=parentcl
\ Cluster allocated, now let's initialize it with "." and ".."
- V2 V1 :FirstSectorOfCluster 1 V1 :readsector
+ V2 V1 :clustersec 1 V1 :readsector
V1 :dirwin :buf( dup DirEntry NAMESZ SPC fill '.' over c! _makedir ( id buf )
V2 over to DirEntry cluster ( id buf ) DirEntry SZ +
dup DirEntry NAMESZ SPC fill '.' over c!+ '.' swap c! ( id buf )
_makedir ( id buf ) V3 swap to DirEntry cluster
2rdrop r> writecursector ( id ) ;
-\ write multiple sectors from buf
-: writesectors ( sec u buf self -- ) >r \ V1=self
- rot >r swap for ( buf ) \ V2=sec
- V2 over V1 :drv :sec! to1+ V2 V1 :drv secsz + next ( buf )
- drop 2rdrop ;
-
-: writecluster ( cluster src self -- ) >r
- over 2 - $fff6 > if abort" cluster out of range!" then
- swap r@ :FirstSectorOfCluster ( dst sec )
- swap r@ secpercluster swap r> writesectors ;
-
:realias info ( id self -- info ) FATInfo :read ;
\ TODO: deallocate the chain before clearing the entry
@@ 204,15 193,11 @@ create _FATTemplate
]struct
struct+[ FATFile
- :realias 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 ;
+ \ Warning: we *can't* use :realias below because we might be sourcing this
+ \ very file while being on fatlo, which means :flush will be called before
+ \ we're finished compiling it! Debugging this was mind-bending...
+ : _flush ( hdl -- ) :secwin :flush ;
+ current ' flush realias
\ grow fcursor to newsz, if needed
: _grow ( newsz self -- )
@@ 227,16 212,12 @@ struct+[ FATFile
for ( cluster ) V1 :fat FAT@+ next then ( cluster ) drop rdrop ;
:realias writebuf ( buf n self -- n )
- dup :free? if 2drop drop 0 exit then ( buf n self )
+ dup :free? if _ioerr then
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 )
- r! move r> ( n ) r@ pos over + r> :seek ;
-
+ r@ _place r@ _clpos drop ( src n subpos )
+ r@ :secwin :seek dup if ( src n a n )
+ rot min r! move r> dup r@ to+ pos r> :secwin :dirty!
+ else ( src n 0 ) nip nip rdrop then ;
\ TODO: deallocate truncated FATs if appropriate
:realias truncate ( self -- )
dup pos ( self pos )
@@ 79,7 79,7 @@ $18 const HDRSZ
: :FAT12? :CountOfClusters 4085 < ;
: cl# ( n -- ) not if abort" cluster out of range" then ;
-: :FirstSectorOfCluster ( n self -- sec ) >r
+: :clustersec ( n self -- sec ) >r
dup << r@ secsz r@ FATsz * < cl#
2 - r@ secpercluster * r> :FirstDataSector + ;
@@ 98,7 98,7 @@ $18 const HDRSZ
: :nextcluster? ( self -- f )
bi+ bufcluster | :FAT@ swap 2dup :EOC? if 2drop 0 else ( cl self )
- 2dup to bufcluster tuck :FirstSectorOfCluster ( self sec )
+ 2dup to bufcluster tuck :clustersec ( self sec )
over secpercluster rot :readsector 1 then ;
:iterator :iterdirentry ( self -- )
@@ 115,7 115,7 @@ $18 const HDRSZ
\ Read specified "direntry" in :buf(
: :readdir ( direntry self -- ) >r
DirEntry cluster ?dup if \ not root entry
- dup r@ :FirstSectorOfCluster r@ secpercluster else \ root entry
+ dup r@ :clustersec r@ secpercluster else \ root entry
0 r@ :FirstRootDirSecNum r@ :RootDirSectors then ( cluster sec cnt )
r@ :readsector ( cluster ) to r> bufcluster ;
@@ 127,16 127,6 @@ $18 const HDRSZ
: :getid ( direntry self -- id )
r! :dirwin :buf( - r@ :dirwin sec r> secsz * + ;
-\ read multiple sectors in buf
-: :readsectors ( sec u buf self -- ) >r \ V1=self
- rot >r swap for ( buf ) \ V2=sec
- V2 over V1 :drv :sec@ to1+ V2 V1 secsz + next ( buf ) drop 2rdrop ;
-
-: :readcluster ( cluster dst self -- ) >r
- over 2 - $fff6 > if abort" cluster out of range!" then
- swap r@ :FirstSectorOfCluster ( dst sec )
- swap r@ secpercluster swap r> :readsectors ;
-
: child ( dirid name self -- id-or-0 ) >r
fnbuf! r@ :getdirentry r@ :readdir r@ :findindir
dup if r@ :getid then rdrop ;
@@ 145,6 135,7 @@ $18 const HDRSZ
\ File cursor
extends File struct[ FATFile
sfield fat
+ sfield secwin
\ all zeroes = free cursor
\ b0 = used
\ b1 = buffer is dirty
@@ 155,10 146,10 @@ extends File struct[ FATFile
sfield clusteridx \ current cluster index, -1=nothing.
sfield entryoff
: :fat [compile] fat [compile] FAT ; immediate
+ : :secwin [compile] secwin [compile] SectorWindow ; immediate
: :free? ( self -- f ) flags not ;
: :hold ( self -- ) 1 swap to flags ;
: :release ( self -- ) 0 swap to flags ;
- : :dirty? ( self -- f ) flags 2 and bool ;
: :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ;
: :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
@@ 166,26 157,20 @@ extends File struct[ FATFile
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.
- : 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 :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 ;
+ : seek to pos ;
+ : _clpos ( self -- subpos clidx ) bi pos | :fat :ClusterSize /mod ;
+ \ Can't be called with pos >= size
+ : _place ( self -- )
+ dup _clpos nip over clusteridx over = if 2drop else ( self clidx )
+ swap r! :flush dup V1 to clusteridx \ ( clidx ) V1=self
+ V1 :cluster0 swap for ( cl ) V1 :fat :FAT@ next ( cl )
+ V1 :fat :clustersec V1 :fat :ClusterSize r> :secwin :move then ;
: 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@ :seek ( n )
- r@ :ptr r@ :)buf over - ( n a nmax )
- rot min ( a n ) dup r> to+ pos ( a n ) ;
+ bi+ pos | size >= over :free? or if 2drop 0 else
+ r! size V1 pos - min >r \ V1=self V2=n
+ V1 _place V1 _clpos drop ( subpos )
+ V1 :secwin :seek r> min dup r> to+ pos then ;
: close ( self -- ) dup :flush :release ;
: :open ( direntry self -- )
@@ 194,12 179,13 @@ extends File struct[ FATFile
0 to r@ pos -1 to r> clusteridx ;
: :new ( fat -- hdl )
- 0 align4 dup to' FAT lastcursor lladd drop ( fat )
- File :new >r S[ :[methods] ]S c@+ -move, ( fat ) \ V1=hdl
+ dup FAT drv SectorWindow :new
+ over to' FAT lastcursor lladd drop ( fat secwin )
+ File :new >r S[ :[methods] ]S c@+ -move, \ V1=hdl
S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
- dup ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
+ swap ( fat ) , ( secwin ) , 0 ( flags ) , 0 ( cluster ) ,
-1 ( clusteridx ) , 0 ( entryoff ) ,
- here r@ to bufptr FAT :ClusterSize dup allot r@ to bufsz r> ;
+ r@ :secwin :buf( r@ to bufptr r@ :fat :drv secsz r@ to bufsz r> ;
]struct
struct+[ FAT