commit d3bd3445140e5d38127e8442c36d4ea5b63bbb32
parent 275e538432a025e26838b82a73dae3ae4435e0a0
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 15 Aug 2022 14:14:49 -0400
fs/fat: add :info
Diffstat:
7 files changed, 109 insertions(+), 68 deletions(-)
diff --git a/fs/doc/file.txt b/fs/doc/file.txt
@@ -33,20 +33,17 @@ bar.fs file "bar.fs" in active directory
When the code refers to a filesystem, it does so through a definite structure:
-4b Drive pointer (see doc/drive)
-4b :child
-4b :open
-4b :newfile
-( whatever data the FS implementation needs )
-
-The word pointers have the specifications below. For each of these words, "fs"
-refers to a filesystem, a pointer to the structure decribed above.
+drv -- Drive pointer (see doc/drive)
:child ( dirid name fs -- id )
Enumerate the contents of directory "dirid" and look for name "name". If
found, returns the ID of the child (either a file or directory), otherwise,
return 0. See below for the concept of "ID".
+:info ( id fs -- info )
+ Returns a FSInfo structure (described below) corresponding to the specified
+ ID. This structure is a singleton and is only valid until the next :info call.
+
:open ( id fs -- hdl )
Open file at path and return a handle through which other file-related word
identify the target file. Once a file isn't used anymore, it should be
@@ -56,6 +53,11 @@ refers to a filesystem, a pointer to the structure decribed above.
Create a new empty file named "name" in "dirid" and return the ID of the new
file. Aborts on error.
+... followed by whatever data the FS implementation needs.
+
+In each method, "fs" refers to a filesystem, a pointer to the structure decribed
+above.
+
## File API
The File API is a specialization of the I/O API (doc/io) for accessing files in
@@ -75,6 +77,13 @@ These words have the following meaning:
Close handle and free its resources. When a handle is closed, operations on
it become noops (read return 0, writes/seeks do nothing)
+## FSInfo API
+
+The structure retured by ":info" above goes as follow:
+
+name -- a pointer to a string
+size -- size of the file, 0 if dir
+dir? -- whether the element is a Directory
## Common API
On top of those words, the File subsystem implements those words:
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -19,7 +19,27 @@
\ DirEntry.
\ TODO: in my big FAT refactoring, I broke this section. Fix it.
-?f<< fs/fatlo.fs
+?f<< /fs/fatlo.fs
+?f<< /lib/str.fs
+
+extends FSInfo struct[ FATInfo
+ create _buf DirEntry NAMESZ 1+ 1+ allot
+ create _struct _buf ( name ) , 0 ( size ) , 0 ( dir? ) ,
+ create _rootname 6 c, ," (root)"
+ create _root _rootname , 0 , 1 ,
+ : spcidx ( name -- idx ) SPC swap DirEntry NAMESZ [c]? ;
+ : :read ( id fat -- info )
+ over not if 2drop _root exit then
+ _buf DirEntry NAMESZ 1+ SPC fill
+ _FAT :getdirentry dup _buf 1+ DirEntry EXTIDX move ( dirent )
+ _buf 1+ spcidx ( dirent namelen )
+ over DirEntry EXTIDX + c@ SPC = not if ( dirent namelen )
+ over DirEntry EXTIDX + swap _buf + 1+ '.' swap c!+ ( dir src dst )
+ DirEntry EXTSZ move else drop then ( dirent )
+ _buf 1+ spcidx ( dirent len ) _buf c! ( dirent )
+ \ TODO: read size and dir?
+ drop _struct ;
+]struct
extends FATLO struct[ FAT
$ffff const EOC
@@ -127,8 +147,11 @@ $ffff const EOC
: fatopen ( id self -- hdl )
FATLO :fatopen ['] fatwritebuf over 4 + ! ['] fatflush over 8 + ! ;
+: fatinfo ( id self -- info ) FATInfo :read ;
+
: :mountvolume ( drv -- fs )
- FATLO :mountvolume ['] fatopen over 8 + ! ['] fatnewfile over 12 + ! ;
+ FATLO :mountvolume ['] fatinfo over 8 + ! ['] fatopen over 12 + !
+ ['] fatnewfile over 16 + ! ;
create _FATTemplate
( jmp ) $eb c, $3c c, $90 c, ( OEMName ) ," DuskFAT " ( BytsPerSec ) 0 c, 0 c,
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -12,8 +12,35 @@
\ See fs/fat.fs for complete implementation details.
+struct[ DirEntry
+ 32 const SZ
+ 11 const NAMESZ
+ 8 const EXTIDX
+ 3 const EXTSZ
+ : :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( 32 allot0
+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
+
+: 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( DirEntry EXTIDX + else
+ upcase swap c!+ then ( dst+1 )
+ dup )fnbuf = if leave then next drop r>A ;
\ 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
@@ -45,6 +72,8 @@ 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 *
@@ -89,12 +118,33 @@ 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 * + ;
+
0 value _self
\ read multiple sectors in buf
: :readsectors ( sec u buf self -- ) to _self
@@ -109,32 +159,6 @@ r@ :buf( r> Filesystem :drv :sec@ ;
]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
@@ -215,33 +239,9 @@ extends File struct[ FATFile
]struct
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 ;
+ fnbuf! r@ _FAT :getdirentry r@ _FAT :readdir r@ _FAT :findindir
+ dup if r@ _FAT :getid then rdrop ;
0 value _self
\ This is the "low" part. Complete open is finalized in fs/fat
@@ -256,7 +256,7 @@ extends _FAT struct[ FATLO
: :mountvolume ( drv -- fs )
align4 here >r dup , ( drv R:fs )
- ['] :child , ['] :fatopen , ['] abort , ( drv )
+ ['] :child , ['] abort , ['] :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!
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -1,6 +1,12 @@
\ File subsystem, see doc/file
0 S" lib" activefs :child S" io.fs" activefs :child fload
+struct[ FSInfo
+ sfield name
+ sfield size
+ sfield dir?
+]struct
+
26 const MAXFSCNT
create filesystems MAXFSCNT CELLSZ * allot0
' activefs structbind' filesystems ! \ record our boot FS in the list
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -9,12 +9,13 @@ mydrv 16 1 1 TOTSEC 17 - FAT newFAT12
mydrv FAT :mountvolume value myfat
' activefs structbind' @ value oldfs
myfat ' activefs rebind
-0 S" newfile" activefs :newfile #
-S" /newfile" findpath# ( fsid ) \ found!
+0 S" foo.fs" activefs :newfile #
+S" /foo.fs" findpath# ( fsid ) \ found!
+dup activefs :info ( fsid info )
+FSInfo name S" FOO.FS" #s=
activefs :open ( hdl )
dup FATFile :cluster0 0 #eq \ no cluster allocated yet
dup S" 42" c@+ rot File :writebuf 2 #eq ( fc ) File :close
-f<< /newfile 42 #eq
+f<< /foo.fs 42 #eq
oldfs ' activefs rebind
testend
-
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -230,6 +230,7 @@ struct[ IO
struct[ Filesystem
sfield drv
smethod :child
+ smethod :info
smethod :open
smethod :newfile
: :drv compile drv [compile] Drive ; immediate
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -3,6 +3,7 @@
create _POSIXFS
' abort ,
' _:child ,
+ ' abort ,
' _:open ,
' abort ,
