commit a9d0ce114e134adc0cd250a17dc07e63b8c4f516
parent 372317f468ddec958424588d948a063ce8fac45e
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 10 May 2023 14:56:44 -0400
lib/file: new unit extracted from sys/file
Additionally, make DriveFile use SectorWindow
Diffstat:
10 files changed, 73 insertions(+), 69 deletions(-)
diff --git a/buildpc.fs b/buildpc.fs
@@ -1,3 +1,4 @@
+?f<< /lib/file.fs
f<< /xcomp/i386/pc/build.fs
S" pc.img" mountImage ( drv ) value mydrv
diff --git a/fs/comp/c/lib.fs b/fs/comp/c/lib.fs
@@ -4,6 +4,7 @@
?f<< /lib/str.fs
?f<< /lib/fmt.fs
?f<< /lib/ll.fs
+?f<< /lib/file.fs
\ A few system word proxies
:c void abort();
diff --git a/fs/doc/lib/file.txt b/fs/doc/lib/file.txt
@@ -0,0 +1,30 @@
+# File utilities
+
+Prerequisites: sys/file, lib/drive
+
+The lib/file unit adds extra utilities on top of sys/file.
+
+## MemFile
+
+MemFile is a structure that extends File and provides read/write/seek
+capabilities to a memory buffer. It extends File with those words:
+
+:new ( sz -- hdl )
+ Allocate a new buffer of size "sz" and return it.
+
+## DriveFile
+
+DriveFile is a structure allowing direct access to a Drive through the
+convenience of a File API. It's buffer size is the drive's sector size.
+
+Fields:
+
+drv The Drive being interfaced.
+sec Sector number currently in buffer, -1 if none.
+dirty? Whether the buffer has changed since it was loaded from the drive.
+
+Words:
+
+:new ( drv -- hdl )
+ Create a new DriveFile interfacing Drive "drv".
+
diff --git a/fs/doc/sys/file.txt b/fs/doc/sys/file.txt
@@ -217,30 +217,6 @@ Does it mean that Dusk couldn't read them? No, only that file/dir enumeration
would have to go through FS-specific tools. I think that this inconvenience is
worth it if it means an overall simpler API.
-## MemFile
-
-MemFile is a structure that extends File and provides read/write/seek
-capabilities to a memory buffer. It extends File with those words:
-
-:new ( sz -- hdl )
- Allocate a new buffer of size "sz" and return it.
-
-## DriveFile
-
-DriveFile is a structure allowing direct access to a Drive through the
-convenience of a File API. It's buffer size is the drive's sector size.
-
-Fields:
-
-drv The Drive being interfaced.
-sec Sector number currently in buffer, -1 if none.
-dirty? Whether the buffer has changed since it was loaded from the drive.
-
-Words:
-
-:new ( drv -- hdl )
- Create a new DriveFile interfacing Drive "drv".
-
## File loading shortcuts
Feeding the Forth intepreter with the contents of a file is something you'll
diff --git a/fs/emul/cos/tools/blkpack.fs b/fs/emul/cos/tools/blkpack.fs
@@ -1,3 +1,4 @@
+?f<< /lib/file.fs
?f<< /comp/c/lib.fs
cc<< /emul/cos/tools/blkpack.c
diff --git a/fs/lib/file.fs b/fs/lib/file.fs
@@ -0,0 +1,37 @@
+?f<< /lib/drive.fs
+
+extends File struct[ MemFile
+ : _maxn ( n hdl -- real-n ) >r V1 pos + V1 size min r> pos - ;
+ : _readbuf ( n hdl -- a? read-n )
+ >r V1 _maxn ( read-n ) dup if V1 :ptr swap dup V1 to+ pos then rdrop ;
+ : _writebuf ( a n hdl -- written-n )
+ >r V1 _maxn ( a write-n ) dup if ( a write-n )
+ tuck V1 :ptr swap ( write-n a dst n ) move ( write-n ) dup V1 to+ pos
+ else nip then rdrop ;
+ : _seek ( pos hdl -- ) to pos ;
+ : :new ( sz -- hdl ) here swap ( hdl sz )
+ 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] drop ,
+ 0 ( pos ) , dup ( size ) , over SZ + ( bufptr ) , dup ( bufsz ) ,
+ ['] _seek , ( sz ) allot ;
+]struct
+
+extends File struct[ DriveFile
+ sfield secwin
+ : :secwin [compile] secwin [compile] SectorWindow ; immediate
+ : _flush :secwin :flush ;
+ : _seek ( pos self -- ) to pos ;
+ : _readbuf ( n self -- a? read-n )
+ over if
+ swap >r bi+ pos | :secwin :seek ( self a? n ) r> min
+ dup if rot over swap to+ pos then
+ else drop then ;
+ : _writebuf ( a n self -- written-n )
+ r! _readbuf ( src dst? n ) dup if
+ r! move r> r> :secwin :dirty! else nip rdrop then ;
+ : :new ( drv -- hdl )
+ SectorWindow :new here ( secwin hdl )
+ 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] _flush , ['] drop ,
+ 0 ( pos ) , -1 ( size ) , over SectorWindow :buf( ( bufptr ) ,
+ over SectorWindow :drv secsz ( bufsz ) , ['] _seek , ['] drop ( truncate ) ,
+ swap ( secwin ) , dup 0 -1 rot :secwin :move ;
+]struct
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -124,48 +124,3 @@ Path _curpath structbind Path curpath
: p" [compile] S" curpath :find# ; immediate
: f" [compile] p" Path :open >file ; immediate
-
-extends File struct[ MemFile
- : _maxn ( n hdl -- real-n ) >r V1 pos + V1 size min r> pos - ;
- : _readbuf ( n hdl -- a? read-n )
- >r V1 _maxn ( read-n ) dup if V1 :ptr swap dup V1 to+ pos then rdrop ;
- : _writebuf ( a n hdl -- written-n )
- >r V1 _maxn ( a write-n ) dup if ( a write-n )
- tuck V1 :ptr swap ( write-n a dst n ) move ( write-n ) dup V1 to+ pos
- else nip then rdrop ;
- : _seek ( pos hdl -- ) to pos ;
- : :new ( sz -- hdl ) here swap ( hdl sz )
- 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] drop ,
- 0 ( pos ) , dup ( size ) , over SZ + ( bufptr ) , dup ( bufsz ) ,
- ['] _seek , ( sz ) allot ;
-]struct
-
-extends File struct[ DriveFile
- sfield drv
- sfield sec \ sector in buffer, -1=none
- sfield dirty?
- : _flush 0 over to@! dirty? if >r
- r@ sec r@ :buf( r> drv Drive :sec!
- else drop then ;
- : _seek ( pos self -- ) >r \ V1=self
- dup r@ to pos ( pos )
- r@ bufsz / dup r@ sec <> if ( tgtsec )
- r@ _flush dup r@ to sec
- r@ :buf( r> drv Drive :sec@ else drop rdrop then ;
- : _readbuf ( n self -- a? read-n ) >r \ V1=self
- r@ pos r@ _seek ( n )
- r@ :ptr r@ :)buf over - ( n a nmax )
- rot min ( a n )
- dup r> to+ File pos ( a n ) ;
- : _writebuf ( a n self -- written-n ) >r \ V1=self
- r@ pos r@ _seek 1 r@ to dirty?
- r@ :)buf r@ :ptr - ( src n nmax )
- min ( src n ) r@ :ptr swap ( src dst n )
- dup >r move r> ( n ) r@ pos over + r> _seek ;
- : :new ( drv -- hdl )
- here
- 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] _flush , ['] drop ,
- 0 ( pos ) , -1 ( size ) , dup SZ + ( bufptr ) ,
- over Drive secsz ( bufsz ) , ['] _seek , ['] drop ( truncate ) ,
- swap ( drv ) , -1 ( sec ) , 0 ( dirty? ) , dup bufsz allot ;
-]struct
diff --git a/fs/tests/comp/c/lib.fs b/fs/tests/comp/c/lib.fs
@@ -1,6 +1,7 @@
?f<< tests/harness.fs
?f<< comp/c/cc.fs
?f<< comp/c/lib.fs
+?f<< /lib/file.fs
testbegin
\ Tests for the C library
\ "max" is a forth word defined in the system
diff --git a/fs/tests/harness.fs b/fs/tests/harness.fs
@@ -1,3 +1,4 @@
+?f<< /lib/file.fs
\ # means "assert"
: # ( f -- ) not if abort" assertion failed" then ;
: #eq ( n n -- ) 2dup = if 2drop else swap .x ." != " .x abort then ;
diff --git a/fs/tests/text/ed.fs b/fs/tests/text/ed.fs
@@ -1,5 +1,6 @@
?f<< /tests/harness.fs
?f<< /drv/ramdrive.fs
+?f<< /lib/file.fs
?f<< /text/ed.fs
testbegin
\ Ed tests
