commit 6e8b772498463c844bc64649c09dddb84cf4d89c
parent 3099e1f81508ab4046fac10974731ddee16e60b5
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 18 Aug 2022 14:23:28 -0400
sys/file: introduce Path structure
Diffstat:
10 files changed, 107 insertions(+), 77 deletions(-)
diff --git a/buildpc.fs b/buildpc.fs
@@ -1,7 +1,7 @@
?f<< /xcomp/tools.fs
: spit ( a u -- ) >r begin c@+ stderr next ;
: spitfile<<
- word findpath# activefs :open begin ( fc )
+ word Path :find# Path :open begin ( fc )
begin dup getc keepc? until
dup 0>= while stderr repeat ( fc c ) drop File :close ;
1 to fecho
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -2,11 +2,11 @@
require sys/scratch.fs
require sys/xhere.fs
1 value _debug
-S" /cc/vm" findpath# ( hdl )
-syspad :[ ARCH c@+ dup 3 + c, move, ," .fs" syspad :] ( hdl fname )
-activefs :child dup bool const HASCC ( hdl )
+S" /cc/vm" Path :find# ( path )
+syspad :[ ARCH c@+ dup 3 + c, move, ," .fs" syspad :] ( path fname )
+swap Path :child dup bool const HASCC ( path )
HASCC not [if] drop ." Unsupported arch for CC" nl> \s [then]
-( hdl ) fload
+( path ) Path :fload
?f<< /cc/gen.fs
\ Compiles input coming from the stdin alias and writes the
diff --git a/fs/doc/file.txt b/fs/doc/file.txt
@@ -85,26 +85,38 @@ name -- a pointer to a string
size -- size of the file, 0 if dir
dir? -- whether the element is a Directory
-## Common API
+## Path API
-On top of those words, the File subsystem implements those words:
+The Path structure represents a path among any of the currently mounted
+filesystems. It has 2 fields: "fs", which is a pointer to a Filesystem struct
+and "id", which is the FS ID corresponding to the path. Path allocations is
+managed through a small "rolling" buffer, which means that if you want to hold
+on to a Path reference a little longer, you should copy it elsewhere.
-chdir ( path -- )
+:new ( fs id -- path )
+ Allocate a new Path reference with the specified fields
+
+:find ( str -- path-or-0 )
+ Find FS ID corresponding to path and return Path reference or 0 if not found.
+
+:find# ( str -- path )
+ Like :find, but errors out if not found.
+
+:fload ( self -- )
+ Open specified path and interpret it as Forth source.
+
+:floaded? ( self -- f )
+ Returns whether this particular path has ever been loaded with :fload.
+
+:chdir ( self -- )
Change current directory to path. In subsequent path finds, if the path
doesn't start with "/", the search will start from this directory.
Aborts if path is not found.
-findpathdir ( path -- dirid? name-or-0 )
- Find FS ID corresponding to the directory part of the path.
- Returns the id of the directory as well as the name of the last part of the
- path. If dir is not found, name is 0 and dirid is not on PS.
- "name" becomes invalid on the next findpathdir call.
-
-findpath ( path -- id-or-0 )
- Find FS ID corresponding to path or 0 if not found.
-
-findpath# ( path -- id )
- Like findpath, but errors out if not found.
+:open ( self -- file )
+:info ( self -- file )
+:child ( name self -- path-or-0 )
+ Convenience proxies to the corresponding methods in the Filesystem API.
## activefs, curfs, curdir
@@ -119,7 +131,7 @@ with "chdir".
activefs is a Filesystem bind to the last "used" Filesystem. On boot, it is
initialized to the boot FS, but after the File subsystem is loaded, it is
-changed very often. For example, every time "findpath" is called, "activefs"
+changed very often. For example, every time ":find" is called, "activefs"
changes to the FS that hosts its result.
## Paths
diff --git a/fs/lib/scratch.fs b/fs/lib/scratch.fs
@@ -26,6 +26,8 @@ struct[ Scratchpad
>r dup r@ c!+ swap ( src dst u ) move r> ;
0 value _here
+ \ TODO: a "max used space" argument should be given for the words below to
+ \ allow for a proper reloading of the buffer.
\ Open a scratch area for writing
: :[ ( self -- ) here to _here ptr to here ;
\ Stop writing to the scratch area and restore here
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -15,37 +15,6 @@ activefs :self structbind Filesystem curfs
0 value curdir
create _buf $100 allot
-: findpathdir ( path -- dirid? name-or-0 )
- curfs :self ['] activefs rebind
- A>r 0 _buf c!+ >A c@+ ( a len )
- over c@ '/' = if 1- >r 1+ 0 ( root ) else
- over 1+ c@ ':' = if ( a len )
- over c@ upcase 'A' - CELLSZ * filesystems + @ ( a len 'fs )
- ?dup not if 2drop r>A 0 exit then ['] activefs rebind
- 2 - >r 2 + 0 ( root ) else >r curdir then then ( a dirid )
- swap begin ( dirid a )
- c@+ dup '/' = if ( dirid a c )
- drop swap _buf activefs :child ( a dirid )
- ?dup not if drop 0 rdrop r>A exit then swap ( dirid a )
- 0 _buf c!+ >A
- else ( dirid a c )
- Ac!+ _buf c@ 1+ _buf c! then
- next ( dirid a ) drop _buf r>A ;
-
-: findpath ( path -- id-or-0 )
- findpathdir ?dup if activefs :child else 0 then ;
-
-: findpath# ( path -- id ) findpath ?dup not if abort" path not found" then ;
-
-: chdir ( path -- ) findpath ?dup if to curdir else abort" not found" then ;
-
-: f<< word findpath# fload ;
-: floaded? ( id -- f )
- floaded begin ( id ll )
- ?dup while 2dup CELLSZ + @ = not while llnext repeat
- 2drop 1 else drop 0 then ;
-: ?f<< word findpath# dup floaded? if drop else fload then ;
-
extends FileLo struct[ File
\ TODO implement truncating for when dstfile is larger than self.
0 structbind FileLo _dst
@@ -56,12 +25,65 @@ extends FileLo struct[ File
_self size _self :readbuf ?dup while ( a n ) _dst :self IO :write repeat
_dst :flush ;
]struct
-?f<< /lib/scratch.fs
+struct[ Path
+ sfield fs
+ sfield id
+
+ $10 const BUFSZ
+ create _paths BUFSZ SZ * allot
+ 0 value _pathidx
+
+ \ Static
+ : :new ( fs id -- path )
+ _pathidx 1+ to@! _pathidx BUFSZ mod SZ * _paths + ( fs id path )
+ tuck to id tuck to fs ( path ) ;
+
+ : _findpathdir ( path -- dirid? name-or-0 )
+ curfs :self ['] activefs rebind
+ A>r 0 _buf c!+ >A c@+ ( a len )
+ over c@ '/' = if 1- >r 1+ 0 ( root ) else
+ over 1+ c@ ':' = if ( a len )
+ over c@ upcase 'A' - CELLSZ * filesystems + @ ( a len 'fs )
+ ?dup not if 2drop r>A 0 exit then ['] activefs rebind
+ 2 - >r 2 + 0 ( root ) else >r curdir then then ( a dirid )
+ swap begin ( dirid a )
+ c@+ dup '/' = if ( dirid a c )
+ drop swap _buf activefs :child ( a dirid )
+ ?dup not if drop 0 rdrop r>A exit then swap ( dirid a )
+ 0 _buf c!+ >A
+ else ( dirid a c )
+ Ac!+ _buf c@ 1+ _buf c! then
+ next ( dirid a ) drop _buf r>A ;
+
+ : :find ( str -- path-or-0 )
+ _findpathdir ?dup if activefs :child else 0 then
+ dup if activefs :self swap :new then ;
+ : :find# ( str -- path )
+ :find ?dup not if abort" path not found" then ;
+
+ \ Methods
+ : :floaded? ( self -- f )
+ id floaded begin ( id ll )
+ ?dup while 2dup CELLSZ + @ = not while llnext repeat
+ 2drop 1 else drop 0 then ;
+ : :open ( self -- file ) dup id swap fs Filesystem :open ;
+ : :info ( self -- info ) dup id swap fs Filesystem :info ;
+ : :child ( name self -- path ) >r
+ r@ id swap r@ fs Filesystem :child ( id )
+ dup if r> fs swap :new else rdrop then ;
+ : :chdir ( self -- ) dup id to curdir fs ['] curfs rebind ;
+ : :fload ( self -- ) dup fs ['] activefs rebind id fload ;
+]struct
+
+: f<< word Path :find# Path :fload ;
+: ?f<< word Path :find# dup Path :floaded? if drop else Path :fload then ;
+
+?f<< /lib/scratch.fs
\ We need a private scratchpad here because some cursors can be quite
\ long-lived. If we use the system scratchpad, short-lived data will overwrite
\ our cursors.
-create _filespad $8000 scratchpad$
+create _filespad $200 scratchpad$
_filespad structbind Scratchpad filespad
\ This creates a "f<" reader with the file descriptor embedded in it. This
@@ -69,9 +91,9 @@ _filespad structbind Scratchpad filespad
: [f<] ( curfd -- word )
filespad :[ litn compile getc exit, filespad :] ;
-: require word dup findpath# floaded? not if
+: require word dup Path :find# Path :floaded? not if
stype abort" required" else drop then ;
: with-stdin-file ( w str -- )
- to@ stdin >r findpath# activefs :open dup >r ( w hdl )
+ to@ stdin >r Path :find# Path :open dup >r ( w hdl )
[f<] to stdin execute
r> File :close r> to stdin ;
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -2,7 +2,7 @@
?f<< cc/cc.fs
testbegin
\ Tests for the C compiler AST
-S" tests/cc/test.c" findpath# activefs :open dup [f<] to stdin parseast
+S" tests/cc/test.c" Path :find# Path :open dup [f<] to stdin parseast
File :close
curunit firstchild dup nodeid AST_FUNCTION #eq ( fnode )
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -10,10 +10,10 @@ mydrv FAT :mountvolume value myfat
curfs :self value oldfs
myfat ' curfs rebind
0 S" foo.fs" curfs :newfile #
-S" /foo.fs" findpath# ( fsid ) \ found!
-dup curfs :info ( fsid info )
+S" /foo.fs" Path :find# ( path ) \ found!
+dup Path :info ( path info )
FSInfo name S" FOO.FS" #s=
-curfs :open value myfile
+( path ) Path :open value myfile
myfile FATFile :cluster0 0 #eq \ no cluster allocated yet
S" 42" c@+ myfile File :write myfile File :flush
f<< /foo.fs 42 #eq
diff --git a/fs/tests/harness.fs b/fs/tests/harness.fs
@@ -18,7 +18,7 @@ create _buf $100 allot
: #s= ( s1 s2 -- ) 2dup s= if 2drop else swap stype ." != " stype abort then ;
-: testrequires word dup findpath# floaded? not if
+: testrequires word dup Path :find# Path :floaded? not if
stype ." required for this test. skipping." nl> \s else drop then ;
: testbegin 1 to fecho ;
: testend .S nl> .free nl> 0 to fecho scnt 0 #eq ;
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -90,12 +90,6 @@ ll llcnt 3 #eq
' bar 'emeta lladd 42 , ( ll )
42 ' bar emeta findemeta ( ll ) #eq
-\ autoloading
-floaded #
-
-0 ( file doesn't exist ) floaded? not #
-S" /tests/harness.fs" findpath floaded? #
-
\ Structures
struct[ Foo
sfield bar
diff --git a/fs/tests/sys/file.fs b/fs/tests/sys/file.fs
@@ -3,18 +3,18 @@
testbegin
\ Tests for sys/file
\ test chdir and relative find
-S" lib" chdir
-S" str.fs" findpath # \ found!
-S" /lib/str.fs" findpath # \ found!
+S" lib" Path :find# Path :chdir
+S" str.fs" Path :find # \ found!
+S" /lib/str.fs" Path :find # \ found!
\ can we come back one level?
-S" .." chdir
-S" lib/str.fs" findpath # \ found!
-S" /lib/str.fs" findpath # \ found!
+S" .." Path :find# Path :chdir
+S" lib/str.fs" Path :find # \ found!
+S" /lib/str.fs" Path :find # \ found!
\ test paths with drive letters
-S" a:lib/str.fs" findpath #
-S" A:lib/str.fs" findpath #
-S" b:lib/str.fs" findpath not #
+S" a:lib/str.fs" Path :find #
+S" A:lib/str.fs" Path :find #
+S" b:lib/str.fs" Path :find not #
\ what if it doesn't exist?
-S" lib/nope.fs" findpath not # \ not found!
-S" /nope.fs" findpath not # \ not found!
+S" lib/nope.fs" Path :find not # \ not found!
+S" /nope.fs" Path :find not # \ not found!
testend
