commit 275e538432a025e26838b82a73dae3ae4435e0a0
parent e6c21f63613c8a6bb2d019ff3ed723f7c828c6cf
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 15 Aug 2022 12:52:41 -0400
fs/fat: move things around a bit
Split FATLO in 2, allowing the DirEntry struct to be squeezed between the two
parts. Directory enumeration is coming and I need wiggle room.
Diffstat:
4 files changed, 120 insertions(+), 117 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -21,62 +21,62 @@
\ TODO: in my big FAT refactoring, I broke this section. Fix it.
?f<< fs/fatlo.fs
-extends FAT struct[ FATHI
+extends FATLO struct[ FAT
$ffff const EOC
: writecursector ( self -- )
- dup FAT bufsec over FAT :buf( rot ( sec dst self ) FAT :drv :sec! ;
+ dup FATLO bufsec over FATLO :buf( rot ( sec dst self ) FATLO :drv :sec! ;
: FAT12! ( entry cluster self -- ) >r
- dup r@ FAT :FAT@ ( entry cl old ) over r@ FAT :FAT12' ( entry cl old a )
+ dup r@ FATLO :FAT@ ( entry cl old ) over r@ FATLO :FAT12' ( entry cl old a )
( entry cl a n ) swap rot 1 and if ( entry a old )
$f and rot 4 lshift or ( a n )
else ( entry a old )
$f000 and rot $fff and or then ( a n )
- over w! ( a ) r@ FAT :)buf 1- = if \ end-of-sector cross-over!
- r@ FAT bufsec 1+ r@ FAT :drv :sec@
- r@ FAT :)buf 1+ c@ r@ FAT :buf( c!
- r@ FAT bufsec 1+ r@ FAT :drv :sec! then rdrop ;
-: FAT16! ( entry cluster self -- ) FAT :FAT16' w! ;
+ over w! ( a ) r@ FATLO :)buf 1- = if \ end-of-sector cross-over!
+ r@ FATLO bufsec 1+ r@ FATLO :drv :sec@
+ r@ FATLO :)buf 1+ c@ r@ FATLO :buf( c!
+ r@ FATLO bufsec 1+ r@ FATLO :drv :sec! then rdrop ;
+: FAT16! ( entry cluster self -- ) FATLO :FAT16' w! ;
: FAT! ( entry cluster self -- )
- dup FAT :FAT12? if dup FAT12! else dup FAT16! then writecursector ;
+ dup FATLO :FAT12? if dup FAT12! else dup FAT16! then writecursector ;
: zerocluster ( cluster self -- )
- dup FAT :buf( over FAT secsz 0 fill ( cluster self )
- tuck FAT :FirstSectorOfCluster ( self sec )
- over FAT secpercluster >r begin ( self sec )
- over dup FAT :buf( swap FAT :drv :sec! 1+ next 2drop ;
+ dup FATLO :buf( over FATLO secsz 0 fill ( cluster self )
+ tuck FATLO :FirstSectorOfCluster ( self sec )
+ over FATLO secpercluster >r begin ( self sec )
+ over dup FATLO :buf( swap FATLO :drv :sec! 1+ next 2drop ;
\ find a free cluster in the FAT
: findfreecluster ( self -- cluster )
- 1 begin ( self cl ) 1+ 2dup swap FAT :FAT@ not until ( self cl ) nip ;
+ 1 begin ( self cl ) 1+ 2dup swap FATLO :FAT@ not until ( self cl ) nip ;
\ Get next FAT entry and if it's EOC, allocate a new one
: FAT@+ ( cluster self -- entry ) >r
- dup r@ FAT :FAT@ ( cl ncl ) dup r@ FAT :EOC? if
+ dup r@ FATLO :FAT@ ( cl ncl ) dup r@ FATLO :EOC? if
drop r@ findfreecluster ( cl ncl ) 2dup swap r@ FAT! ( cl ncl )
r@ EOC swap r@ FAT!
else nip then rdrop ;
\ try to find in current buffer
: _findinsec ( self -- a-or-0 ) >r
- r@ FAT :buf( begin ( a )
+ r@ FATLO :buf( begin ( a )
dup c@ dup $e5 = swap not or if ( free! ) rdrop exit then
- DirEntry SZ + dup r@ FAT :)buf >= until rdrop drop 0 ;
+ DirEntry SZ + dup r@ FATLO :)buf >= until rdrop drop 0 ;
\ find free dir entry in current buffer
: findfreedirentry ( self -- direntry )
begin
dup _findinsec ?dup not while ( self )
- dup FAT :nextsector? while
+ dup FATLO :nextsector? while
repeat \ nothing found, we have to extend the chain
( self ) dup r> findfreecluster dup r@ zerocluster ( newcl )
- dup r@ FAT bufcluster r@ FAT! ( newcl ) r@ EOC swap r@ FAT!
- r@ FAT :nextsector? ( has to work ) r> FAT :buf(
+ dup r@ FATLO bufcluster r@ FAT! ( newcl ) r@ EOC swap r@ FAT!
+ r@ FATLO :nextsector? ( has to work ) r> FATLO :buf(
else ( self a ) nip then ;
: fatnewfile ( dirid name self -- direntry ) >r
- fnbuf! ( dirid ) r@ FAT :getdirentry r@ FAT :readdir ( )
+ fnbuf! ( dirid ) r@ FATLO :getdirentry r@ FATLO :readdir ( )
r@ findfreedirentry dup DirEntry SZ 0 fill ( direntry )
fnbuf( over DirEntry NAMESZ move r> writecursector ( direntry ) ;
@@ -84,13 +84,13 @@ $ffff const EOC
\ write multiple sectors from buf
: writesectors ( sec u buf self -- ) to self
A>r swap >r swap >A begin ( buf )
- A> over self FAT :drv :sec! A+ self FAT :drv secsz + next ( buf )
+ A> over self FATLO :drv :sec! A+ self FATLO :drv secsz + next ( buf )
drop r>A ;
: writecluster ( cluster src self -- ) >r
over 2 - $fff6 > if abort" cluster out of range!" then
- swap r@ FAT :FirstSectorOfCluster ( dst sec )
- swap r@ FAT secpercluster swap r> writesectors ;
+ swap r@ FATLO :FirstSectorOfCluster ( dst sec )
+ swap r@ FATLO secpercluster swap r> writesectors ;
: fatflush ( self -- ) >r
r@ FATFile :dirty? not if rdrop exit then ( )
@@ -112,7 +112,7 @@ $ffff const EOC
?dup not if self fat findfreecluster then ( cluster0 )
self :dirent 2dup DirEntry cluster! ( custer0 dirent )
self size swap to DirEntry filesize self fat writecursector ( cluster0 )
- self size self fat FAT :ClusterSize / ?dup if
+ self size self fat FATLO :ClusterSize / ?dup if
>r begin ( cluster ) self fat FAT@+ next then ( cluster ) drop ;
: fatwritebuf ( buf n self -- n )
@@ -125,10 +125,10 @@ $ffff const EOC
dup >r move r> ( n ) ;
: fatopen ( id self -- hdl )
- FATFS:open ['] fatwritebuf over 4 + ! ['] fatflush over 8 + ! ;
+ FATLO :fatopen ['] fatwritebuf over 4 + ! ['] fatflush over 8 + ! ;
-: :mountVolume ( drv -- fs )
- mountFATvolume ['] fatopen over 8 + ! ['] fatnewfile over 12 + ! ;
+: :mountvolume ( drv -- fs )
+ FATLO :mountvolume ['] fatopen over 8 + ! ['] fatnewfile over 12 + ! ;
create _FATTemplate
( jmp ) $eb c, $3c c, $90 c, ( OEMName ) ," DuskFAT " ( BytsPerSec ) 0 c, 0 c,
@@ -167,4 +167,3 @@ create _FATTemplate
$fffff0 here !
( drv ) rsvdsec here rot Drive :sec! ;
]struct
-alias FATHI FAT immediate
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -12,41 +12,19 @@
\ See fs/fat.fs for complete implementation details.
-struct[ DirEntry
- 32 const SZ
- 11 const NAMESZ
- : :name[] ( self -- sa sl ) NAMESZ ;
- 26 &+w@ cluster
- : cluster! ( n self -- ) 26 + w! ;
- 28 field filesize
-]struct
-
\ Just a dummy entry so that we can reference the root directory as a "direntry"
-create rootdirentry( DirEntry SZ allot0
-\ directory entry of currently selected directory. If first byte is 0, this
-\ means that we're on the root dir
-create curdir( DirEntry SZ allot0
-create fnbuf( DirEntry NAMESZ allot
-here const )fnbuf
+create rootdirentry( 32 allot0
-: upcase ( c -- c ) dup 'a' - 26 < if $df and then ;
-: fnbufclr fnbuf( DirEntry NAMESZ SPC fill ;
-: fnbuf! ( name -- )
- fnbufclr dup S" ." s= over S" .." s= or if
- c@+ ( a len ) fnbuf( swap move exit then
- A>r c@+ >r >A fnbuf( begin ( dst )
- Ac@+ dup '.' = if
- 2drop fnbuf( 8 + else
- upcase swap c!+ then ( dst+1 )
- dup )fnbuf = if leave then next drop r>A ;
-
-extends Filesystem struct[ FAT
+\ The FAT struct in this unit is split in 2. The first part contains code needed
+\ by FATFile, and the second part contains the rest of the code for FATLO. This
+\ allows some of the FATLO code to depend on code in FATFile.
+extends Filesystem struct[ _FAT
sfield bufsec \ sector number of current buf
sfield bufseccnt \ number of sectors ahead for sequential read
sfield bufcluster \ cluster number of current buf
sfield lastcursor
-' FAT structsz const SZ
+' _FAT structsz const SZ
SZ &+ :hdr(
SZ $0b + &+w@ secsz \ in bytes
SZ $0d + &+c@ secpercluster
@@ -67,8 +45,6 @@ r@ reservedseccnt r@ FATcnt r@ FATsz * + r> :RootDirSectors + ;
: :FirstSectorOfCluster ( n self -- sec ) >r
dup << r@ secsz r@ FATsz * >= if abort" cluster out of range" then
1- 1- r@ secpercluster * r> :FirstDataSector + ;
-: :FirstRootDirSecNum ( self -- n ) >r
-r@ reservedseccnt r@ FATcnt r> FATsz * + ;
: :ClusterSize dup secpercluster swap secsz * ;
: :DataSec ( self -- n ) >r
r@ seccnt r@ FATsz r@ FATcnt *
@@ -113,38 +89,12 @@ r@ :buf( r> Filesystem :drv :sec@ ;
r@ secpercluster r> :readsector 1 then
then ;
-\ Find current fnbuf( in current dir buffer and return a dir entry.
-: :findindir ( self -- direntry ) >r
- begin
- r@ :buf( begin ( a )
- dup r@ :)buf < while ( a )
- fnbuf( over DirEntry :name[] []= not while ( a ) DirEntry SZ + repeat
- ( success ) else ( not found ) drop 0 then ( a )
- ?dup not while r@ :nextsector? while
- repeat ( not found ) 0 then rdrop ;
-
-\ Read specified "direntry" in :buf(
-: :readdir ( direntry self -- ) >r
- DirEntry cluster ?dup if \ not root entry
- dup r@ :FirstSectorOfCluster r@ secpercluster else \ root entry
- 1 r@ :FirstRootDirSecNum r@ :RootDirSectors then ( cluster sec cnt )
- r@ :readsector ( cluster ) to r> bufcluster ;
-
\ Get DirEntry address from FS ID "id"
: :getdirentry ( id self -- direntry )
over if
dup >r secsz /mod ( offset sec ) 1 r@ :readsector ( off ) r> :buf( +
else 2drop rootdirentry( then ;
-\ Get ID for direntry
-: :getid ( direntry self -- id )
- dup >r :buf( - r@ bufsec r> secsz * + ;
-
-: :child ( dirid name self -- id-or-0 ) >r
- fnbuf! r@ :getdirentry r@ :readdir r@ :findindir
- dup if r@ :getid then rdrop ;
-current value :child'
-
0 value _self
\ read multiple sectors in buf
: :readsectors ( sec u buf self -- ) to _self
@@ -159,6 +109,32 @@ current value :child'
]struct
+struct[ DirEntry
+ 32 const SZ
+ 11 const NAMESZ
+ : :name[] ( self -- sa sl ) NAMESZ ;
+ 26 &+w@ cluster
+ : cluster! ( n self -- ) 26 + w! ;
+ 28 field filesize
+]struct
+
+\ directory entry of currently selected directory. If first byte is 0, this
+\ means that we're on the root dir
+create curdir( DirEntry SZ allot0
+create fnbuf( DirEntry NAMESZ allot
+here const )fnbuf
+
+: upcase ( c -- c ) dup 'a' - 26 < if $df and then ;
+: fnbufclr fnbuf( DirEntry NAMESZ SPC fill ;
+: fnbuf! ( name -- )
+ fnbufclr dup S" ." s= over S" .." s= or if
+ c@+ ( a len ) fnbuf( swap move exit then
+ A>r c@+ >r >A fnbuf( begin ( dst )
+ Ac@+ dup '.' = if
+ 2drop fnbuf( 8 + else
+ upcase swap c!+ then ( dst+1 )
+ dup )fnbuf = if leave then next drop r>A ;
+
\ File cursor
extends File struct[ FATFile
sfield fat
@@ -176,7 +152,7 @@ extends File struct[ FATFile
' FATFile structsz const SZ
\ beginning of a buffer with the size :ClusterSize
SZ &+ :buf(
- : :fat compile fat [compile] FAT ; immediate
+ : :fat compile fat [compile] _FAT ; immediate
: _clustersize ( self -- n ) :fat :ClusterSize ;
: :)buf ( self -- a ) dup :buf( swap _clustersize + ;
: :free? ( self -- f ) flags not ;
@@ -214,7 +190,7 @@ extends File struct[ FATFile
\ these words below are "static" words not called with "self" as an argument,
\ but "fat".
- : :cursorsize ( fat -- sz ) FAT :ClusterSize SZ + ;
+ : :cursorsize ( fat -- sz ) _FAT :ClusterSize SZ + ;
create _EmptyCursor
\ IO handle methods: :readbuf, :writebuf, :flush
@@ -226,41 +202,69 @@ extends File struct[ FATFile
0 ( size ) , 0 ( entryoff ) ,
: :createcursor ( fat -- hdl )
- align4 dup to' FAT lastcursor llinsert ( fat newll )
+ align4 dup to' _FAT lastcursor llinsert ( fat newll )
swap :cursorsize allot ( newll ) CELLSZ + ( hdl )
0 over to flags ( mark as "free" ) ;
: :findfreecursor ( fat -- hdl ) >r
- r@ FAT lastcursor begin ( ll )
+ r@ _FAT lastcursor begin ( ll )
?dup while dup CELLSZ + :free? not while llnext repeat
CELLSZ + else r@ :createcursor then
_EmptyCursor over SZ move
r> over to fat ;
]struct
-\ TODO: support more than one FAT FS at once
-
-0 value _self
-\ This is the "low" part. Complete open is finalized in fs/fat
-: FATFS:open ( id self -- hdl ) to _self
- _self FAT :getdirentry
- _self FATFile :findfreecursor >r ( dirent )
- 1 to r@ FATFile flags \ mark as "used"
- \ write the rest
- dup _self FAT :buf( - _self FAT bufsec _self FAT secsz * + ( dirent doffset )
- r@ to FATFile entryoff DirEntry filesize r@ to FATFile size ( ) r> ;
-
-: mountFATvolume ( drv -- fs )
- align4 here >r dup , ( drv R:fs )
- FAT :child' , ['] FATFS:open , ['] abort , ( drv )
- 0 , 0 , 0 , 0 , ( drv )
- \ At this point, "here" points to the FAT-header-to-be. Read the first sector
- \ directly in "here": we'll have the header right here!
- dup 0 here rot Drive :sec@ ( drv )
- FAT HDRSZ allot ( drv )
- \ Verify that the header makes sense
- r@ FAT secsz swap Drive secsz over = not if
- abort" Drive sector size not matching drive!" then ( secsz )
- \ Allocate buffer. 1+ is for the extra byte for FAT12 cross-sector exception
- 1+ allot r> ( fs ) ;
-
+extends _FAT struct[ FATLO
+ : :FirstRootDirSecNum ( self -- n ) >r
+ r@ _FAT reservedseccnt r@ _FAT FATcnt r> _FAT FATsz * + ;
+
+ \ Find current fnbuf( in current dir buffer and return a dir entry.
+ : :findindir ( self -- direntry ) >r
+ begin
+ r@ _FAT :buf( begin ( a )
+ dup r@ _FAT :)buf < while ( a )
+ fnbuf( over DirEntry :name[] []= not while ( a ) DirEntry SZ + repeat
+ ( success ) else ( not found ) drop 0 then ( a )
+ ?dup not while r@ _FAT :nextsector? while
+ repeat ( not found ) 0 then rdrop ;
+
+ \ Read specified "direntry" in :buf(
+ : :readdir ( direntry self -- ) >r
+ DirEntry cluster ?dup if \ not root entry
+ dup r@ _FAT :FirstSectorOfCluster r@ _FAT secpercluster else \ root entry
+ 1 r@ :FirstRootDirSecNum r@ _FAT :RootDirSectors then ( cluster sec cnt )
+ r@ _FAT :readsector ( cluster ) to r> _FAT bufcluster ;
+
+ \ Get ID for direntry
+ : :getid ( direntry self -- id )
+ dup >r _FAT :buf( - r@ _FAT bufsec r> _FAT secsz * + ;
+
+ : :child ( dirid name self -- id-or-0 ) >r
+ fnbuf! r@ _FAT :getdirentry r@ :readdir r@ :findindir
+ dup if r@ :getid then rdrop ;
+
+ 0 value _self
+ \ This is the "low" part. Complete open is finalized in fs/fat
+ : :fatopen ( id self -- hdl ) to _self
+ _self _FAT :getdirentry
+ _self FATFile :findfreecursor >r ( dirent )
+ 1 to r@ FATFile flags \ mark as "used"
+ \ write the rest
+ dup _self _FAT :buf( -
+ _self _FAT bufsec _self _FAT secsz * + ( dirent doffset )
+ r@ to FATFile entryoff DirEntry filesize r@ to FATFile size ( ) r> ;
+
+ : :mountvolume ( drv -- fs )
+ align4 here >r dup , ( drv R:fs )
+ ['] :child , ['] :fatopen , ['] abort , ( drv )
+ 0 , 0 , 0 , 0 , ( drv )
+ \ At this point, "here" points to the FAT-header-to-be. Read the first sector
+ \ directly in "here": we'll have the header right here!
+ dup 0 here rot Drive :sec@ ( drv )
+ _FAT HDRSZ allot ( drv )
+ \ Verify that the header makes sense
+ r@ _FAT secsz swap Drive secsz over = not if
+ abort" Drive sector size not matching drive!" then ( secsz )
+ \ Allocate buffer. 1+ is for the extra byte for FAT12 cross-sector exception
+ 1+ allot r> ( fs ) ;
+]struct
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -6,7 +6,7 @@ testbegin
100 const TOTSEC
512 TOTSEC RAMDrive :new value mydrv
mydrv 16 1 1 TOTSEC 17 - FAT newFAT12
-mydrv FAT :mountVolume value myfat
+mydrv FAT :mountvolume value myfat
' activefs structbind' @ value oldfs
myfat ' activefs rebind
0 S" newfile" activefs :newfile #
diff --git a/fs/xcomp/pc/glue.fs b/fs/xcomp/pc/glue.fs
@@ -1,5 +1,5 @@
\ Glue code that goes between the filesystem part and boothi
-INT13hDrive mountFATvolume ( fs ) ' activefs rebind
+INT13hDrive FATLO :mountvolume ( fs ) ' activefs rebind
0 S" drv" activefs :child S" pc" activefs :child
S" int13h.fs" activefs :child floaded,
0 S" fs" activefs :child S" fatlo.fs" activefs :child floaded,
