commit ce95a0ef822e52e0cb01dae88d7f0d4c0b654e00
parent 9370014eb52a8ed33cb00d2643b7fcddbff06009
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 4 Feb 2023 13:09:56 -0500
Change Filesystem :iter semantics
The goal is to make it more :iterator friendly
Diffstat:
6 files changed, 108 insertions(+), 105 deletions(-)
diff --git a/fs/doc/sys/file.txt b/fs/doc/sys/file.txt
@@ -51,10 +51,10 @@ drv -- Drive pointer
identify the target file. Once a file isn't used anymore, it should be
closed with :close. Aborts on error.
-:iter ( w id fs -- )
- Iterate through all children of directory "id", ignoring "." and ".." entries.
- For each child iterated upon, call word "w" which has the signature
- "id fs --", "id" being the ID of the child.
+:iter ( dirid previd fs -- id-or-0 )
+ Given a parent id "dirid", return the child id following "previd" in it. If
+ previd is 0, return the first child. If no child follows "previd", return 0.
+ The iteration process ignores "." and ".." elements.
:newfile ( dirid name fs -- id )
Create a new empty file named "name" in "dirid" and return the ID of the new
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -206,9 +206,23 @@ $e5 const DIRFREE
: fatremove ( id self -- ) >r
r@ :getdirentry ( dirent ) DIRFREE swap c! r> writecursector ;
+\ This approach to iteration is inefficient, but simple. I keep it as-is for now
+\ because I'm planning on replacing the whole of fs/fat.fs with elm-chan's FAT
+\ implementation at some point.
+: _next ( entry self -- entry-or-0 ) >r \ V1=self
+ DirEntry SZ + dup V1 :)buf = if
+ drop V1 :nextsector? if V1 :buf( else rootdirentry( then then ( entry )
+ dup DirEntry :lastentry? if drop 0 else
+ dup DirEntry :iterable? not if V1 _next then then ( entry ) rdrop ;
+
+: fatiter ( dirid previd self -- id-or-0 ) >r >r ( dirid ) \ V1=self V2=previd
+ V1 :getdirentry V1 :readdir V1 :buf( DirEntry SZ - V2 if begin ( entry )
+ V1 _next dup while dup V1 :getid V2 <> while repeat then then ( entry-or-0 )
+ dup if V1 _next dup if V1 :getid then then 2rdrop ;
+
: _patchFS ( fs -- ) >r \ V1=fs
- ['] fatinfo r@ 12 + ! ['] fatnewfile r@ 24 + !
- ['] fatnewdir r@ 28 + ! ['] fatremove r@ 32 + !
+ ['] 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 + !
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -69,7 +69,7 @@ SZ HDRSZ + &+ :buf(
: :)buf dup :buf( swap secsz + ;
: :RootDirSectors ( self -- n )
-dup rootentcnt 32 * swap secsz /mod ( r q ) swap if 1+ then ;
+dup rootentcnt 32 * swap secsz /mod ( r q ) swap bool + ;
: :FirstDataSector ( self -- n ) >r
r@ reservedseccnt r@ FATcnt r@ FATsz * + r> :RootDirSectors + ;
: :FirstSectorOfCluster ( n self -- sec ) >r
@@ -153,18 +153,19 @@ r@ reservedseccnt + r> :RootDirSectors + - ;
: :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
- rot >r swap for ( buf ) \ V1=sec
- V1 over _self :drv :sec@
- 1 to+ V1 _self secsz + next ( buf ) drop rdrop ;
+: :readsectors ( sec u buf self -- ) >r \ V1=self
+ rot >r swap for ( buf ) \ V2=sec
+ V2 over V1 :drv :sec@ 1 to+ 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 ;
]struct
\ File cursor
@@ -185,25 +186,26 @@ extends File struct[ FATFile
: _clustersize ( self -- n ) :fat :ClusterSize ;
: :)buf ( self -- a ) dup :buf( swap _clustersize + ;
: :free? ( self -- f ) flags not ;
- : :dirty? ( self -- f ) flags 2 and ;
+ : :hold ( self -- ) 1 swap to flags ;
+ : :release ( self -- ) 0 swap to flags ;
+ : :dirty? ( self -- f ) flags 2 and bool ;
: :bufpos ( self -- a ) dup File pos over _clustersize mod swap :buf( + ;
: :dirent ( self -- dirent ) dup entryoff swap :fat :getdirentry ;
: :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
- 0 value self
\ 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 -- ) to self
- self :free? if drop exit then ( pos )
+ : :fatseek ( pos self -- ) >r \ V1=self
+ V1 :free? if drop exit then ( pos )
dup 0< if abort" can't seek to negative pos" then
- dup self _clustersize / self clusteridx = not if
- self IO :flush ( pos )
- dup self _clustersize / dup self to clusteridx ( pos idx )
- self :cluster0 ( pos idx cl )
- swap ?dup if for ( pos cl ) self :fat :FAT@ next then ( pos cl )
- dup self :buf( self :fat :readcluster ( pos cl )
- self to cluster ( pos )
- then ( pos ) self to File pos ;
+ dup V1 _clustersize / V1 clusteridx = not if
+ V1 IO :flush ( pos )
+ dup V1 _clustersize / dup V1 to clusteridx ( pos idx )
+ V1 :cluster0 ( pos idx cl )
+ swap ?dup if for ( pos cl ) V1 :fat :FAT@ next then ( pos cl )
+ dup V1 :buf( V1 :fat :readcluster ( pos cl )
+ V1 to cluster ( pos )
+ then ( pos ) r> to File pos ;
: :fatreadbuf ( n self -- a? n )
dup :free? if 2drop 0 exit then ( n self )
@@ -215,25 +217,21 @@ extends File struct[ FATFile
rot min ( a n )
dup r> to+ File pos ( a n ) ;
- : :fatclose ( self -- ) dup IO :flush 0 swap to flags ;
+ : :fatclose ( self -- ) dup IO :flush :release ;
\ these words below are "static" words not called with "self" as an argument,
\ but "fat".
: :cursorsize ( fat -- sz ) FAT :ClusterSize SZ + ;
create EmptyCursor
- \ IO
0 ( putback ) , ' :fatreadbuf , ' abort , ' drop , ' :fatclose ,
- \ File
0 ( pos ) , 0 ( size ) , ' :fatseek , ' abort ( truncate ) ,
- \ FAT fields
0 ( 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 )
- 0 over to flags ( mark as "free" ) ;
+ swap :cursorsize allot ( newll ) CELLSZ + ( hdl ) dup :release ;
: :findfreecursor ( fat -- hdl ) >r
r@ FAT lastcursor begin ( ll )
@@ -244,37 +242,18 @@ extends File struct[ FATFile
]struct
struct+[ FAT
- : :iter ( w dirid self -- id-or-0 ) >r \ V1=self
- V1 :getdirentry V1 :readdir >r ( ) \ V2=w
- V1 :buf( begin ( a )
- dup DirEntry :lastentry? not while ( a )
- dup DirEntry :iterable? if ( a )
- V1 bufseccnt >r V1 bufsec >r
- dup V1 :getid V1 V2 execute
- r> r> V1 :readsector then ( a )
- DirEntry SZ + dup V1 :)buf = if
- drop V1 :nextsector? not if
- rootdirentry( ( parses as "lastentry" ) else V1 :buf( then then
- repeat ( a ) drop 2rdrop ;
-
- : :child ( dirid name self -- id-or-0 ) >r
- fnbuf! r@ :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 :getdirentry
- _self FATFile :findfreecursor >r ( dirent )
- 1 to r@ FATFile flags \ mark as "used"
+ : :fatopen ( id self -- hdl ) >r \ V1=self
+ V1 :getdirentry
+ V1 FATFile :findfreecursor >r ( dirent ) r@ FATFile :hold \ V2=hdl
\ write the rest
- dup _self :buf( -
- _self bufsec _self secsz * + ( dirent doffset )
- r@ to FATFile entryoff DirEntry filesize r@ to FATFile size ( ) r> ;
+ dup V1 :buf( -
+ V1 bufsec V1 secsz * + ( dirent doffset )
+ r@ to FATFile entryoff DirEntry filesize r@ to FATFile size ( ) r> rdrop ;
: :mountvolume ( drv -- fs )
0 align4 here >r dup , ( drv R:fs ) 0 ( flags ) ,
- ['] :child , ['] abort , ['] :fatopen , ['] :iter , ['] abort , ['] abort ,
+ ['] :child , ['] abort , ['] :fatopen , ['] abort , ['] abort , ['] abort ,
['] abort ,
0 ( bufsec ) , 0 ( bufseccnt ) , 0 ( bufcluster ) , 0 ( lastcursor ) ,
\ At this point, "here" points to the FAT-header-to-be. Read the first sector
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -41,17 +41,18 @@ struct[ Path
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 ( w self -- ) >r
- r@ id r> fs Filesystem :iter ( id ) ;
-
+ : :iter ( w self -- ) dup fs >r swap >r ( self ) \ V1=fs V2=w
+ id dup >r 0 V1 Filesystem :iter ( childid ) \ V3=dirid
+ begin ?dup while
+ dup V1 V2 execute ( childid )
+ V3 swap V1 Filesystem :iter repeat
+ 2rdrop rdrop ;
+
+ : _dir? ( id fs -- info f ) 2dup Filesystem :info dup FSInfo dir? ;
alias noop _w ( id fs info -- )
- : _ ( id fs -- )
- 2dup Filesystem :info dup FSInfo dir? if ( id fs info )
- _w else 2drop drop then ;
+ : _ ( id fs -- ) _dir? if _w else 2drop drop then ;
: :iterdirs ( w self -- ) swap ['] _w realias ['] _ swap :iter ;
- : _ ( id fs -- )
- 2dup Filesystem :info dup FSInfo dir? not if ( id fs info )
- _w else 2drop drop then ;
+ : _ ( id fs -- ) _dir? not if _w else 2drop drop then ;
: :iterfiles ( w self -- ) swap ['] _w realias ['] _ swap :iter ;
: :remove ( self -- ) dup id swap fs Filesystem :remove ;
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -1,11 +1,12 @@
: _ doer ' , does> nip @ execute ;
-_ _:child _fchild _ _:open _fopen _ _:info _finfo
+_ _:child _fchild _ _:open _fopen _ _:info _finfo _ _:iter _fiter
+
create _POSIXFS
0 , 0 ,
' _:child ,
' _:info ,
' _:open ,
- ' _fiter ,
+ ' _:iter ,
' abort ,
' abort ,
' abort ,
diff --git a/posix/vm.c b/posix/vm.c
@@ -765,6 +765,10 @@ static void RUNWORD() { // op: 5c
}
}
+static void USLEEP() { // op: 5d
+ usleep(ppop());
+}
+
/* Filesystem
At POSIX level, we don't have access to the underlying FS structure such as
@@ -831,6 +835,13 @@ static char* pathcat(char *p1, dword s) {
return buf2;
}
+static dword _newfsid(char *path) {
+ dword res = 0;
+ while (fsids[++res][0]);
+ strcpy(fsids[res], path);
+ return res;
+}
+
static void FCHILD () { // op: 60
dword s = ppop();
dword parent = ppop();
@@ -847,8 +858,7 @@ static void FCHILD () { // op: 60
ppush(0);
return;
}
- while (fsids[++res][0]);
- strcpy(fsids[res], path);
+ res = _newfsid(path);
}
ppush(res);
}
@@ -934,44 +944,46 @@ static void FINFO() { // op: 64
memcpy(&vm.mem[dst+13], name, strlen(name));
}
-// ( w id self -- )
+static struct dirent* _next(DIR *dirp) {
+ struct dirent *d;
+ do {
+ d = readdir(dirp);
+ } while (d && ((strcmp(d->d_name, ".") == 0) || (strcmp(d->d_name, "..") == 0)));
+ return d;
+}
+
+// ( dirid previd -- id-or-0 )
static void FITER() { // op: 65
DIR *dirp;
struct dirent *d;
- dword self = ppop();
- dword fsid = ppop();
- dword w = ppop();
- int baselen;
char path[MAXPATHSZ] = {0};
- strcpy(path, getpathfromid(fsid));
+ int baselen;
+ dword previd = ppop();
+ dword dirid = ppop();
+ dword curid = 0;
+ int matched = 0;
+ strcpy(path, getpathfromid(dirid));
dirp = opendir(path);
- if (dirp) {
- strcat(path, "/");
- baselen = strlen(path);
- while(1) {
- do {
- d = readdir(dirp);
- } while (d && ((strcmp(d->d_name, ".") == 0) || (strcmp(d->d_name, "..") == 0)));
- if (!d) break;
- strcpy(&path[baselen], d->d_name);
- fsid = findpath(path);
- if (!fsid) {
- while (fsids[++fsid][0]);
- strcpy(fsids[fsid], path);
- }
- ppush(fsid);
- ppush(self);
- callword(w);
- if (vm.PC >= MEMSZ) break;
- }
- closedir(dirp);
- } else {
+ if (!dirp) {
printf("Couldn't open dir %s\n", path);
vm.PC = abortaddr;
+ return;
}
+ strcat(path, "/");
+ baselen = strlen(path);
+ do {
+ if (curid == previd) matched = 1;
+ d = _next(dirp);
+ if (d) {
+ strcpy(&path[baselen], d->d_name);
+ curid = findpath(path);
+ if (!curid) curid = _newfsid(path);
+ } else { curid = 0; }
+ } while (curid && !matched);
+ ppush(curid);
}
-static void FSEEK() { // op: 66
+static void FSEEK() { // op: 67
dword hdl = ppop();
dword pos = ppop();
int res;
@@ -989,10 +1001,6 @@ static void FSEEK() { // op: 66
sd(hdl+FILEPOSOFF, res);
}
-static void USLEEP() { // op: 67
- usleep(ppop());
-}
-
// ( imgname -- )
static void MOUNTDRV() { // op: 68
char buf[64] = {0};
@@ -1050,8 +1058,8 @@ static void (*ops[OPCNT])() = {
OR, XOR, BOOL, NOT, LT, SHLC, SHRC, LSHIFT,
RSHIFT, LITN, EXECUTEWR, EXITWR, MOVE, MOVEWR, FINDMOD, WNF,
STACKCHK, MAYBEWORD, WORD, PARSE, REQ, FIND, APOS, COMPILING,
- ALIASWR, STARTCOMP, STOPCOMP, COMPWORD, RUNWORD, NULL, NULL, NULL,
- FCHILD, FOPEN, FREADBUF, FCLOSE, FINFO, FITER, FSEEK, USLEEP,
+ ALIASWR, STARTCOMP, STOPCOMP, COMPWORD, RUNWORD, USLEEP, NULL, NULL,
+ FCHILD, FOPEN, FREADBUF, FCLOSE, FINFO, FITER, NULL, FSEEK,
MOUNTDRV, UNMOUNTDRV, DRVRD, DRVWR};
static char *opnames[OPCNT] = {
@@ -1066,8 +1074,8 @@ static char *opnames[OPCNT] = {
"or", "xor", "bool", "not", "<", "<<c", ">>c", "lshift",
"rshift", "litn", "execute,", "exit,", "move", "move,", "findmod", "(wnf)",
"stack?", "maybeword", "word", "parse", "[]=", "find", "'", "compiling",
- "alias,", "]", "[", "compword", "runword", NULL, NULL, NULL,
- "_fchild", "_fopen", "_freadbuf", "_fclose", "_finfo", "_fiter", "_fseek", "_usleep",
+ "alias,", "]", "[", "compword", "runword", "_usleep", NULL, NULL,
+ "_fchild", "_fopen", "_freadbuf", "_fclose", "_finfo", "_fiter", NULL, "_fseek",
"_mountdrv", "_unmountdrv", "_drv@", "_drv!"};
static void oprun1() { // run next op
