commit b35dd5a2235d21f81d3d513ad164fd00864b9a7c
parent 6e8b772498463c844bc64649c09dddb84cf4d89c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 18 Aug 2022 17:15:41 -0400
sys/file: rewrite Path :find to add a path indirection
Previously, :find was always based on curdir, now it's based on the calling
Path structure. For convenience, a "curpath" Path bind replaces the "curfs"
and "curdir" variables.
Diffstat:
16 files changed, 90 insertions(+), 99 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 Path :find# Path :open begin ( fc )
+ word curpath :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,7 +2,7 @@
require sys/scratch.fs
require sys/xhere.fs
1 value _debug
-S" /cc/vm" Path :find# ( path )
+S" /cc/vm" curpath :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]
diff --git a/fs/doc/arch.txt b/fs/doc/arch.txt
@@ -101,13 +101,13 @@ The filesystem layer depends on the target machine and has the responsibility
to implement :open, :close, :child and :readbuf. In the PC target, this is
sourced from /fs/fatlo.fs.
-The second glue file plugs the Filesystem structure into the "activefs" alias.
+The second glue file plugs the Filesystem structure into the "bootfs" pointer.
It also has the responsibility of adding references of included files in
"floaded" so that they aren't loaded twice in memory. In the PC target, this is
sourced from /xcomp/glue2.fs
The "boothi" part takes all of this and implements "fload", and then loads
-/init.fs. This is sourced from /xcomp/boothi.fs
+/sys/file.fs and then /init.fs. This is sourced from /xcomp/boothi.fs
## Initialization layer (init)
diff --git a/fs/doc/file.txt b/fs/doc/file.txt
@@ -118,21 +118,15 @@ on to a Path reference a little longer, you should copy it elsewhere.
:child ( name self -- path-or-0 )
Convenience proxies to the corresponding methods in the Filesystem API.
-## activefs, curfs, curdir
+## Global variables
-The File subsystem has 3 important global variables that determines how paths
-are found.
+The File subsystem has 2 important global variables:
-curdir is the ID of the current directory, as changed by "chdir". It is
-initialized to 0, the root of the filesystem.
+bootfs is a pointer to the Filesystem structure from which the system was
+booted. It's used only until the File subsystem is initialized.
-curfs is a Filesystem bind to the FS associated with "curdir" it only changes
-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 ":find" is called, "activefs"
-changes to the FS that hosts its result.
+curpath is a Path bind that points to the "current directory". It is initialized
+to the root directory of bootfs but can be changed with Path :chdir.
## Paths
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -8,12 +8,6 @@ $100 value STR_MAXSZ
\ "skip" str, that is, return the address following its last char
: s) ( str -- a ) c@+ + ;
-\\ index of "c" inside range "a u". -1 if not found
-: [c]? ( c a u -- i )
- ?dup not if 2drop -1 exit then A>r over >r >r >A ( c )
- begin dup Ac@+ = if leave then next ( c )
- A- Ac@ = if A> r> - ( i ) else rdrop -1 then r>A ;
-
\\ append character to end of string
: sappend ( c str -- ) tuck s) c! dup c@ 1+ swap c! ;
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -1,5 +1,6 @@
\ File subsystem, see doc/file
-0 S" lib" activefs :child S" io.fs" activefs :child fload
+0 S" lib" bootfs Filesystem :child S" io.fs" bootfs Filesystem :child
+ bootfs swap fload
struct[ FSInfo
sfield name
@@ -9,11 +10,7 @@ struct[ FSInfo
26 const MAXFSCNT
create filesystems MAXFSCNT CELLSZ * allot0
-activefs :self filesystems ! \ record our boot FS in the list
-
-activefs :self structbind Filesystem curfs
-0 value curdir
-create _buf $100 allot
+bootfs filesystems ! \ record our boot FS in the list
extends FileLo struct[ File
\ TODO implement truncating for when dstfile is larger than self.
@@ -30,54 +27,58 @@ struct[ Path
sfield fs
sfield id
+ create _curpath bootfs , 0 ,
+
$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 ;
+ : :open ( self -- file ) dup id swap fs Filesystem :open ;
+ : :info ( self -- info ) dup id swap fs Filesystem :info ;
+ : :child ( name self -- path-or-0 ) >r
+ r@ id swap r@ fs Filesystem :child ( id )
+ dup if r> fs swap :new else rdrop then ;
+
+ : :root ( self -- path ) fs 0 :new ;
+
+ create _buf $100 allot
+ 0 value _idx
+ 0 value _slen
+ : :find ( name self -- path-or-0 )
+ over c@ dup not if nip exit then to _slen ( name self )
+ swap _buf _slen 1+ move ( self )
+ _slen 2 >= _buf 2 + c@ ':' = and if \ drive letter
+ drop _buf 2 + _slen 2 - over c! ( name )
+ _buf 1+ c@ upcase 'A' - CELLSZ * filesystems + @ ( name fs )
+ ?dup if 0 :new :find exit else drop 0 exit then then
+ '/' _buf c@+ [c]? to _idx ( self )
+ _idx 0< if _buf swap :child exit then ( self )
+ _idx if \ not a leading "/"
+ _idx _buf c! _buf swap :child ( path-or-0 )
+ dup not if exit then ( path )
+ else :root then
+ _buf 1+ _idx + _slen _idx - 1- over c! ( path name )
+ swap :find ;
+
: :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 ;
+ : :chdir ( self -- )
+ dup id _curpath CELLSZ + ! fs _curpath ! ;
+ : :fload ( self -- ) dup fs swap id fload ;
]struct
+Path _curpath structbind Path curpath
-: f<< word Path :find# Path :fload ;
-: ?f<< word Path :find# dup Path :floaded? if drop else Path :fload then ;
+: f<< word curpath :find# Path :fload ;
+: ?f<< word curpath :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
@@ -91,9 +92,9 @@ _filespad structbind Scratchpad filespad
: [f<] ( curfd -- word )
filespad :[ litn compile getc exit, filespad :] ;
-: require word dup Path :find# Path :floaded? not if
+: require word dup curpath :find# Path :floaded? not if
stype abort" required" else drop then ;
: with-stdin-file ( w str -- )
- to@ stdin >r Path :find# Path :open dup >r ( w hdl )
+ to@ stdin >r curpath :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" Path :find# Path :open dup [f<] to stdin parseast
+S" tests/cc/test.c" curpath :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
@@ -7,20 +7,18 @@ testbegin
512 TOTSEC RAMDrive :new value mydrv
mydrv 16 1 1 TOTSEC 17 - FAT newFAT12
mydrv FAT :mountvolume value myfat
-curfs :self value oldfs
-myfat ' curfs rebind
-0 S" foo.fs" curfs :newfile #
-S" /foo.fs" Path :find# ( path ) \ found!
+myfat 0 Path :new structbind Path myroot
+0 S" foo.fs" myfat Filesystem :newfile #
+S" /foo.fs" myroot :find# ( path ) \ found!
dup Path :info ( path info )
FSInfo name S" FOO.FS" #s=
( 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
+S" /foo.fs" myroot :find# Path :fload 42 #eq
\ let's copy that file
-0 S" bar.fs" curfs :newfile curfs :open value mydst
+0 S" bar.fs" myfat Filesystem :newfile myfat Filesystem :open value mydst
mydst myfile File :copy mydst File :close
-f<< /bar.fs 42 #eq
+S" /bar.fs" myroot :find# Path :fload 42 #eq
myfile File :close
-oldfs ' curfs rebind
testend
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 Path :find# Path :floaded? not if
+: testrequires word dup curpath :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/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" Path :find# Path :chdir
-S" str.fs" Path :find # \ found!
-S" /lib/str.fs" Path :find # \ found!
+S" lib" curpath :find# Path :chdir
+S" str.fs" curpath :find # \ found!
+S" /lib/str.fs" curpath :find # \ found!
\ can we come back one level?
-S" .." Path :find# Path :chdir
-S" lib/str.fs" Path :find # \ found!
-S" /lib/str.fs" Path :find # \ found!
+S" .." curpath :find# Path :chdir
+S" lib/str.fs" curpath :find # \ found!
+S" /lib/str.fs" curpath :find # \ found!
\ test paths with drive letters
-S" a:lib/str.fs" Path :find #
-S" A:lib/str.fs" Path :find #
-S" b:lib/str.fs" Path :find not #
+S" a:lib/str.fs" curpath :find #
+S" A:lib/str.fs" curpath :find #
+S" b:lib/str.fs" curpath :find not #
\ what if it doesn't exist?
-S" lib/nope.fs" Path :find not # \ not found!
-S" /nope.fs" Path :find not # \ not found!
+S" lib/nope.fs" curpath :find not # \ not found!
+S" /nope.fs" curpath :find not # \ not found!
testend
diff --git a/fs/xcomp/boothi.fs b/fs/xcomp/boothi.fs
@@ -4,10 +4,12 @@
: f< ( -- c )
1 curhdl FileLo :readbuf if c@ else -1 ( EOF ) then
fecho if dup emit then ;
-: fload ( id -- )
+: fload ( fs id -- )
dup floaded, curhdl >r
- activefs :open to curhdl
+ swap Filesystem :open to curhdl
to' in< @ >r ['] f< to in<
begin maybeword ?dup if runword 0 else 1 then until
r> to in< curhdl FileLo :close r> to curhdl ;
-0 S" init.fs" activefs :child fload
+0 S" sys" bootfs Filesystem :child S" file.fs" bootfs Filesystem :child
+ bootfs swap fload
+0 S" init.fs" bootfs Filesystem :child bootfs swap fload
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -69,6 +69,12 @@ code : ] code ] ;
: allot0 ( n -- ) here over 0 fill allot ;
: align4 ( -- ) here 4 mod ?dup if 4 -^ allot0 then ;
: nc, ( n -- ) >r begin word runword c, next ;
+\ index of "c" inside range "a u". -1 if not found
+: [c]? ( c a u -- i )
+ ?dup not if 2drop -1 exit then A>r over >r >r >A ( c )
+ begin dup Ac@+ = if leave then next ( c )
+ A- Ac@ = if A> r> - ( i ) else rdrop -1 then r>A ;
+
\ Compiling words
: create code compile (cell) ;
@@ -241,10 +247,9 @@ struct[ Filesystem
smethod :newfile
: :drv compile drv [compile] Drive ; immediate
]struct
-\ activefs holds a reference to the last "used" fs. It's not the same thing as
-\ "curfs", which goes with "curdir". "activefs" moves a lot more. For example,
-\ it changes after each "findpath" call.
-0 structbind Filesystem activefs \ has to be rebinded before first use
+\ bootfs holds a reference to boot FS. This is used until the full sys/file
+\ subsystem takes over with Path mechanics.
+0 value bootfs \ has to be set before first use
extends IO struct[ FileLo
sfield pos \ offset from beginning of file
sfield size
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 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,
+INT13hDrive FATLO :mountvolume ( fs ) to bootfs
+0 S" drv" bootfs Filesystem :child S" pc" bootfs Filesystem :child
+ S" int13h.fs" bootfs Filesystem :child floaded,
+0 S" fs" bootfs Filesystem :child S" fatlo.fs" bootfs Filesystem :child floaded,
diff --git a/fs/xcomp/pc/init.fs b/fs/xcomp/pc/init.fs
@@ -1,8 +1,6 @@
\ Initialization for PC
: ARCH S" i386" ;
-0 S" sys" activefs :child S" file.fs" activefs :child fload
-\ We now have f<<
f<< /drv/pc/acpi.fs
f<< /drv/pc/com.fs
f<< /drv/pc/vga.fs
@@ -10,7 +8,8 @@ f<< /sys/grid.fs
' (emit) to emit
f<< /drv/pc/ata.fs
-ataidentify $c0 and $40 = [if] atareset drop ATADrive to activefs drv [then]
+ataidentify $c0 and $40 = [if]
+ atareset drop ATADrive bootfs to Filesystem drv [then]
f<< /drv/pc/pci.fs
f<< /drv/pc/ps28042.fs
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -7,7 +7,7 @@ create _POSIXFS
' _:open ,
' abort ,
-_POSIXFS ' activefs rebind
+_POSIXFS to bootfs
: mountImage ( imgname -- drv )
_mountdrv here 512 , ['] _drv@ , ['] _drv! , ;
diff --git a/posix/init.fs b/posix/init.fs
@@ -1,4 +1,2 @@
\ Initialization for POSIX Dusk
: ARCH S" none" ;
-0 S" sys" activefs :child S" file.fs" activefs :child fload
-\ We now have f<<
