commit e71615287d36ff997d7c6a1693f2183bebff9c5b
parent e59dcc42adf7c18382ebf1b58c516a77122563a6
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 17 Aug 2022 14:33:47 -0400
sys/file: add File :copy
Diffstat:
8 files changed, 55 insertions(+), 25 deletions(-)
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -95,10 +95,11 @@ $ffff const EOC
r@ FATLO :nextsector? ( has to work ) r> FATLO :buf(
else ( self a ) nip then ;
-: fatnewfile ( dirid name self -- direntry ) >r
+: fatnewfile ( dirid name self -- id ) >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 ) ;
+ fnbuf( over DirEntry NAMESZ move r@ writecursector ( direntry )
+ r> FATLO :getid ;
0 value self
\ write multiple sectors from buf
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -159,7 +159,7 @@ r@ :buf( r> Filesystem :drv :sec@ ;
]struct
\ File cursor
-extends File struct[ FATFile
+extends FileLo struct[ FATFile
sfield fat
\ all zeroes = free cursor
\ b0 = used
@@ -169,8 +169,6 @@ extends File struct[ FATFile
\ until the first position of the cluster is needed.
sfield cluster
sfield clusteridx \ current cluster index, -1=nothing.
- sfield pos \ offset from beginning of file
- sfield size
sfield entryoff
' FATFile structsz const SZ
\ beginning of a buffer with the size :ClusterSize
@@ -180,7 +178,7 @@ extends File struct[ FATFile
: :)buf ( self -- a ) dup :buf( swap _clustersize + ;
: :free? ( self -- f ) flags not ;
: :dirty? ( self -- f ) flags 2 and ;
- : :bufpos ( self -- a ) dup pos over _clustersize mod swap :buf( + ;
+ : :bufpos ( self -- a ) dup FileLo pos over _clustersize mod swap :buf( + ;
: :dirent ( self -- dirent ) dup entryoff swap :fat :getdirentry ;
: :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
@@ -197,17 +195,17 @@ extends File struct[ FATFile
swap ?dup if >r begin ( 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 pos ;
+ then ( pos ) self to FileLo pos ;
: :fatreadbuf ( n self -- a? n )
dup :free? if 2drop 0 exit then ( n self )
- dup >r size r@ pos - ( n maxn )
+ dup >r FileLo size r@ FileLo pos - ( n maxn )
dup 1- 0< if ( EOF ) 2drop rdrop 0 exit then
min ( n ) \ make sure that n doesn't go over size
- r@ pos r@ :fatseek ( n )
+ r@ FileLo pos r@ :fatseek ( n )
r@ :bufpos r@ :)buf over - ( n a nmax )
rot min ( a n )
- dup r> to+ pos ( a n ) ;
+ dup r> to+ FileLo pos ( a n ) ;
: :fatclose ( self -- ) dup IO :flush 0 swap to flags ;
@@ -216,13 +214,13 @@ extends File struct[ FATFile
: :cursorsize ( fat -- sz ) _FAT :ClusterSize SZ + ;
create _EmptyCursor
- \ IO handle methods: :readbuf, :writebuf, :flush
+ \ IO
' :fatreadbuf , ' abort , ' drop ,
- \ File handle methods :seek :close
- ' :fatseek , ' :fatclose ,
+ \ FileLo
+ 0 ( pos ) , 0 ( size ) , ' :fatseek , ' :fatclose ,
\ FAT fields
- 0 ( fat ) , 0 ( flags ) , 0 ( cluster ) , -1 ( clusteridx ) , 0 ( pos ) ,
- 0 ( size ) , 0 ( entryoff ) ,
+ 0 ( fat ) , 0 ( flags ) , 0 ( cluster ) , -1 ( clusteridx ) ,
+ 0 ( entryoff ) ,
: :createcursor ( fat -- hdl )
align4 dup to' _FAT lastcursor llinsert ( fat newll )
diff --git a/fs/lib/io.fs b/fs/lib/io.fs
@@ -15,3 +15,10 @@ here value _)buf
A> _)buf = if abort" readline overflow" then
in< dup LF = not while Ac!+ repeat drop
A> _buf( - 1- ( len ) _buf( c! _buf( ( str ) r>A ;
+
+: _iowrite ( a n self -- ) >r begin ( a n ) ?dup while
+ 2dup r@ IO :writebuf ?dup not if abort" error during write" then
+ ( a n written-n ) tuck - ( a written-n new-n ) rot> + swap repeat ( a )
+ drop rdrop ;
+current to IO :write
+
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -46,6 +46,16 @@ create _buf $100 allot
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
+ 0 structbind FileLo _self
+ : :copy ( dstfile self -- ) ['] _self rebind ['] _dst rebind
+ \ TODO _dst :seek is broken for FAT when file is empty. fix.
+ 0 _self :seek begin ( )
+ _self size _self :readbuf ?dup while ( a n ) _dst :self IO :write repeat
+ _dst :flush ;
+]struct
?f<< /lib/scratch.fs
\ We need a private scratchpad here because some cursors can be quite
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -13,9 +13,14 @@ myfat ' curfs rebind
S" /foo.fs" findpath# ( fsid ) \ found!
dup curfs :info ( fsid info )
FSInfo name S" FOO.FS" #s=
-curfs :open ( hdl )
-dup FATFile :cluster0 0 #eq \ no cluster allocated yet
-dup S" 42" c@+ rot File :writebuf 2 #eq ( fc ) File :close
+curfs :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
+\ let's copy that file
+0 S" bar.fs" curfs :newfile curfs :open value mydst
+mydst myfile File :copy mydst File :close
+f<< /bar.fs 42 #eq
+myfile File :close
oldfs ' curfs rebind
testend
diff --git a/fs/xcomp/boothi.fs b/fs/xcomp/boothi.fs
@@ -1,13 +1,13 @@
0 value curhdl \ handle of the file currently being read
0 value fecho
-: \s curhdl ?dup if File :close then ;
+: \s curhdl ?dup if FileLo :close then ;
: f< ( -- c )
- 1 curhdl File :readbuf if c@ else -1 ( EOF ) then
+ 1 curhdl FileLo :readbuf if c@ else -1 ( EOF ) then
fecho if dup emit then ;
: fload ( id -- )
dup floaded, curhdl >r
activefs :open to curhdl
to' in< @ >r ['] f< to in<
begin maybeword ?dup if runword 0 else 1 then until
- r> to in< curhdl File :close r> to curhdl ;
+ r> to in< curhdl FileLo :close r> to curhdl ;
0 S" init.fs" activefs :child fload
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -226,6 +226,8 @@ struct[ IO
smethod :readbuf
smethod :writebuf
smethod :flush
+ \ forward declarations
+ alias abort :write
]struct
\ File API
@@ -242,7 +244,9 @@ struct[ Filesystem
\ "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
-extends IO struct[ File
+extends IO struct[ FileLo
+ sfield pos \ offset from beginning of file
+ sfield size
smethod :seek
smethod :close
]struct
diff --git a/posix/vm.c b/posix/vm.c
@@ -745,7 +745,7 @@ static dword findpath(char *path) {
}
static int getfiledesc(dword hdl) {
- return (int)(gd(hdl+20)|(((int64_t)gd(hdl+24))<<32));
+ return (int)(gd(hdl+28)|(((int64_t)gd(hdl+32))<<32));
}
static void FCHILD () { // op: 5d
@@ -783,6 +783,7 @@ static void FOPEN () { // op: 5e
dword fsid = ppop();
char *path;
int fd;
+ int filesize;
if ((fsid >= FSIDCNT) || !fsids[fsid][0]) {
printf("Out of bounds FSID\n");
vm.PC = gd(ABORT);
@@ -795,10 +796,14 @@ static void FOPEN () { // op: 5e
vm.PC = gd(ABORT);
return;
}
+ filesize = lseek(fd, 0, SEEK_END);
+ lseek(fd, 0, SEEK_SET);
ppush(here()); // File cursor we're about to create
dwrite(find("_freadbuf"));
dwrite(find("abort")); // writebuf
dwrite(find("drop")); // flush
+ dwrite(0); // pos
+ dwrite(filesize);
dwrite(find("2drop")); // seek
dwrite(find("_fclose")); // close
dwrite(fd);
@@ -835,8 +840,8 @@ static void FCLOSE() { // op: 60
int fd = getfiledesc(hdl);
if (fd) {
close(fd);
- sd(hdl+20, 0);
- sd(hdl+24, 0);
+ sd(hdl+28, 0);
+ sd(hdl+32, 0);
}
}
