commit abf3c9dd2289b1989d92d8749607c9c9c19dae13
parent da9efb9864fd79a97210aff34295825e3cd637ad
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 21 Aug 2022 09:13:21 -0400
sys/file: add Filesystem :newdir
Diffstat:
6 files changed, 52 insertions(+), 17 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -44,6 +44,11 @@ extends FSInfo struct[ FATInfo
extends FATLO struct[ FAT
$ffff const EOC
+$e5 const DIRFREE
+
+: :ClusterOfSector ( sec self -- cl ) >r
+ r@ FATLO :FirstDataSector 0< if drop 0 else ( sec )
+ r@ FATLO secpercluster / 1+ 1+ then rdrop ;
: writecursector ( self -- )
dup FATLO bufsec over FATLO :buf( rot ( sec dst self ) FATLO :drv :sec! ;
@@ -66,15 +71,21 @@ $ffff const EOC
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 ;
+ 2dup over FATLO :buf( ( self sec self sec buf )
+ rot FATLO :drv :sec! 1+ next 2drop ;
\ find a free cluster in the FAT
: findfreecluster ( self -- cluster )
1 begin ( self cl ) 1+ 2dup swap FATLO :FAT@ not until ( self cl ) nip ;
+\ Find a free cluster, and mark it as EOC.
: allocatecluster ( self -- cluster )
dup findfreecluster ( self cl ) tuck EOC swap rot FAT! ( cl ) ;
+\ Allocate a free cluster and fill its contents with zeroes
+: allocatecluster0 ( self -- cluster )
+ dup allocatecluster tuck swap zerocluster ;
+
\ Get next FAT entry and if it's EOC, allocate a new one
: FAT@+ ( cluster self -- entry ) >r
dup r@ FATLO :FAT@ ( cl ncl ) dup r@ FATLO :EOC? if
@@ -85,7 +96,7 @@ $ffff const EOC
\ try to find in current buffer
: _findinsec ( self -- a-or-0 ) >r
r@ FATLO :buf( begin ( a )
- dup c@ dup $e5 = swap not or if ( free! ) rdrop exit then
+ dup c@ dup DIRFREE = swap not or if ( free! ) rdrop exit then
DirEntry SZ + dup r@ FATLO :)buf >= until rdrop drop 0 ;
\ find free dir entry in current buffer
@@ -94,16 +105,32 @@ $ffff const EOC
dup _findinsec ?dup not while ( self )
dup FATLO :nextsector? while
repeat \ nothing found, we have to extend the chain
- ( self ) dup r> findfreecluster dup r@ zerocluster ( newcl )
- dup r@ FATLO bufcluster r@ FAT! ( newcl ) r@ EOC swap r@ FAT!
+ ( self ) dup r> allocatecluster0 ( newcl )
+ r@ FATLO bufcluster r@ FAT! ( newcl )
r@ FATLO :nextsector? ( has to work ) r> FATLO :buf(
else ( self a ) nip then ;
-: fatnewfile ( dirid name self -- id ) >r
+: _newentry ( dirid name self -- direntry ) >r
fnbuf! ( dirid ) r@ FATLO :getdirentry r@ FATLO :readdir ( )
- r@ findfreedirentry dup DirEntry SZ 0 fill ( direntry )
- fnbuf( over DirEntry NAMESZ move r@ writecursector ( direntry )
- r> FATLO :getid ;
+ r> findfreedirentry dup DirEntry SZ 0 fill ( direntry )
+ fnbuf( over DirEntry NAMESZ move ( direntry ) ;
+
+: fatnewfile ( dirid name self -- id ) >r
+ r@ _newentry ( dirent ) r@ writecursector r> FATLO :getid ;
+
+0 value _self 0 value _dirid 0 value _name 0 value _cluster
+: fatnewdir ( dirid name self -- id ) to _self to _name to _dirid
+ _self allocatecluster0 to _cluster
+ \ Cluster allocated, now let's initialize it with "." and ".."
+ _cluster _self FATLO :FirstSectorOfCluster 1 _self FATLO :readsector
+ _self FATLO :buf( '.' over c! $10 over DirEntry attr! ( buf )
+ _cluster over DirEntry cluster! ( buf ) DirEntry SZ +
+ '.' over c!+ '.' swap c! ( buf ) $10 over DirEntry attr! ( buf )
+ _dirid _self FATLO secsz / _self :ClusterOfSector ( buf parentcl )
+ swap DirEntry cluster! _self writecursector ( )
+ _dirid _name _self _newentry ( dirent ) $10 over DirEntry attr! ( dirent )
+ _cluster over DirEntry cluster! _self writecursector ( dirent )
+ _self FATLO :getid ( id ) ;
0 value self
\ write multiple sectors from buf
@@ -156,11 +183,11 @@ $ffff const EOC
\ TODO: deallocate the chain before clearing the entry
: fatremove ( id self -- ) >r
- r@ FATLO :getdirentry ( dirent ) DirEntry SZ 0 fill r> writecursector ;
+ r@ FATLO :getdirentry ( dirent ) DIRFREE swap c! r> writecursector ;
: _patchFS ( fs -- )
- ['] fatinfo over 12 + ! ['] fatopen over 16 + ! ['] fatnewfile over 20 + !
- ['] fatremove over 32 + ! 1 swap to FATLO flags ;
+ ['] fatinfo over 12 + ! ['] fatopen over 16 + ! ['] fatnewfile over 28 + !
+ ['] fatnewdir over 32 + ! ['] fatremove over 36 + ! 1 swap to FATLO flags ;
: :mountvolume ( drv -- fs ) FATLO :mountvolume dup _patchFS ;
bootfs 12 + @ ' abort = [if] bootfs _patchFS [then]
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -19,6 +19,7 @@ struct[ DirEntry
3 const EXTSZ
: :name[] ( self -- sa sl ) NAMESZ ;
11 &+c@ attr
+ : attr! ( n self -- ) 11 + c! ;
26 &+w@ cluster
: cluster! ( n self -- ) 26 + w! ;
28 field filesize
@@ -256,7 +257,7 @@ extends _FAT struct[ FATLO
: :mountvolume ( drv -- fs )
align4 here >r dup , ( drv R:fs ) 0 ( flags ) ,
['] :child , ['] abort , ['] :fatopen , ['] abort , ['] abort , ['] abort ,
- ['] abort ,
+ ['] abort , ['] abort ,
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
@@ -33,6 +33,8 @@ struct[ Path
dup if r> fs swap :new else rdrop then ;
: :newfile ( name self -- path ) >r
r@ id swap r@ fs Filesystem :newfile ( id ) r> fs swap :new ;
+ : :newdir ( name self -- path ) >r
+ r@ id swap r@ fs Filesystem :newdir ( id ) r> fs swap :new ;
: :iter ( self -- path ) >r
r@ id r@ fs Filesystem :iter ( id ) r> fs swap :new ;
: :next ( self -- path-or-0 ) >r
diff --git a/fs/tests/sys/file.fs b/fs/tests/sys/file.fs
@@ -42,13 +42,16 @@ FSInfo name S" FOO.FS" #s=
myfile FATFile :cluster0 0 #eq \ no cluster allocated yet
S" 42" c@+ myfile File :write myfile File :close
S" /foo.fs" myroot :find# Path :fload 42 #eq
-\ let's copy that file
+\ how about a directory?
+S" bar" myroot :newdir dup # value mydir
+\ let's copy foo.fs in that directory
S" foo.fs" myroot :find# value mysrc
-S" bar.fs" myroot :newfile value mydst
+S" baz.fs" mydir Path :newfile value mydst
+S" /bar/baz.fs" myroot :find #
mydst mysrc Path :copyfile
mydst Path :fload 42 #eq
mysrc Path :remove
mydst Path :remove
S" /foo.fs" myroot :find not #
-S" /bar.fs" myroot :find not #
+S" /bar/baz.fs" myroot :find not #
testend
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -245,9 +245,10 @@ struct[ Filesystem
smethod :child
smethod :info
smethod :open
- smethod :newfile
smethod :iter
smethod :next
+ smethod :newfile
+ smethod :newdir
smethod :remove
: :drv compile drv [compile] Drive ; immediate
: :writeable? flags 1 and ;
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -6,10 +6,11 @@ create _POSIXFS
' _:child ,
' _:info ,
' _:open ,
- ' abort ,
' _:iter ,
' _:next ,
' abort ,
+ ' abort ,
+ ' abort ,
_POSIXFS to bootfs
