commit 82fd267a3771c45e7c7814d821c1b95d454beceb
parent 506b1603c074d08bd04e8a0c8dc67d76f39a9649
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 11 Aug 2022 07:24:30 -0400
Add IO and File structures
Diffstat:
9 files changed, 24 insertions(+), 28 deletions(-)
diff --git a/buildpc.fs b/buildpc.fs
@@ -3,7 +3,7 @@
: spitfile<<
word findpath# activefs :open begin ( fc )
begin dup getc keepc? until
- dup 0>= while stderr repeat ( fc c ) drop fclose ;
+ dup 0>= while stderr repeat ( fc c ) drop File :close ;
1 to fecho
f<< /xcomp/i386.fs
f<< /xcomp/pc/kernel.fs
diff --git a/fs/doc/file.txt b/fs/doc/file.txt
@@ -50,7 +50,7 @@ refers to a filesystem, a pointer to the structure decribed above.
:open ( id fs -- hdl )
Open file at path and return a handle through which other file-related word
identify the target file. Once a file isn't used anymore, it should be
- closed with fclose. Aborts on error.
+ closed with :close. Aborts on error.
:newfile ( dirid name fs -- id )
Create a new empty file named "name" in "dirid" and return the ID of the new
@@ -63,15 +63,15 @@ a filesystem. It also works with "handles", which we call File handle. Of
course, it starts with the I/O prelude, but then adds its own prelude:
(I/O prelude)
-fseek
-fclose
+:seek
+:close
These words have the following meaning:
-fseek ( pos hdl -- )
+:seek ( pos hdl -- )
Place the handle at offset "pos" (in bytes).
-fclose ( hdl -- )
+:close ( hdl -- )
Close handle and free its resources. When a handle is closed, operations on
it become noops (read return 0, writes/seeks do nothing)
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -223,7 +223,7 @@ create fcursors( FCursorSize FCURSORCNT * allot0
dup FCUR_free? if 2drop exit then ( pos fcursor )
over 0< if abort" can't seek to negative pos" then
over ClusterSize / over FCUR_clusteridx = not if
- dup dup 8 + @ ( 'flush ) execute >r ( pos )
+ dup IO :flush >r ( pos )
dup ClusterSize / dup r@ FCUR_clusteridx! ( pos idx )
r@ FCUR_cluster0 ( pos idx cl )
swap ?dup if >r begin ( pos cl ) FAT@ next then ( pos cl )
@@ -241,14 +241,14 @@ create fcursors( FCursorSize FCURSORCNT * allot0
rot min ( a n )
dup r> FCUR_pos+ ( a n ) ;
-: fatclose ( fcursor ) dup dup 8 + @ ( 'flush ) execute 0 swap FCUR_flags! ;
+: fatclose ( fcursor ) dup IO :flush 0 swap FCUR_flags! ;
\ This is the "low" part. Complete open is finalized in fs/fat
: FATFS:open ( id self -- hdl )
drop getdirentry findfreecursor >r
- \ write IO handle prelude: readbuf, writebuf, flush
+ \ write IO handle methods: :readbuf, :writebuf, :flush
['] fatreadbuf r@ ! ['] abort r@ 4 + ! ['] drop r@ 8 + !
- \ write File handle prelude: fseek fclose
+ \ write File handle methods :seek :close
['] fatseek r@ 12 + ! ['] fatclose r@ 16 + !
\ write the rest
0 r@ FCUR_cluster! ( dirent ) 1 r@ FCUR_flags!
diff --git a/fs/lib/io.fs b/fs/lib/io.fs
@@ -1,9 +1,6 @@
\ Input/Output. See doc/io
-: readbuf ( n hdl -- a? n ) dup @ execute ;
-: writebuf ( a n hdl -- n ) dup 4 + @ execute ;
-: flush ( hdl -- ) dup 8 + @ execute ;
-: getc ( fcursor -- c ) 1 swap readbuf if c@ else -1 ( EOF ) then ;
+: getc ( hdl -- c ) 1 swap IO :readbuf if c@ else -1 ( EOF ) then ;
alias in< stdin ( -- c )
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -33,8 +33,6 @@ create _buf $100 allot
dup while 2dup 4 + @ = if 2drop 1 exit then @ repeat 2drop 0 ;
: ?f<< word findpath# dup floaded? if drop else fload then ;
-12 smethod fseek ( pos hdl -- )
-
?f<< /lib/scratch.fs
\ We need a private scratchpad here because some cursors can be quite
@@ -51,6 +49,6 @@ _filespad structbind Scratchpad filespad
: require word dup findpath# floaded? not if
stype abort" required" else drop then ;
: with-stdin-file ( w str -- )
- to@ stdin >r findpath# activefs :open dup >r ( w fcursor )
+ to@ stdin >r findpath# activefs :open dup >r ( w hdl )
[f<] to stdin execute
- r> fclose r> to stdin ;
+ r> File :close r> to stdin ;
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -2,7 +2,8 @@
?f<< cc/cc.fs
testbegin
\ Tests for the C compiler AST
-S" tests/cc/test.c" findpath# activefs :open dup [f<] to stdin parseast fclose
+S" tests/cc/test.c" findpath# activefs :open dup [f<] to stdin parseast
+File :close
curunit firstchild dup nodeid AST_FUNCTION #eq ( fnode )
dup ast.func.name S" retconst" s= #
diff --git a/fs/tests/fs/fat.fs b/fs/tests/fs/fat.fs
@@ -19,6 +19,6 @@ S" /newfile" findpath# \ found!
\ let's try writing to it
fatopen ( fc )
dup FCUR_cluster0 0 #eq \ no cluster allocated yet
-dup S" 42" c@+ rot fatwritebuf 2 #eq ( fc ) fclose
+dup S" 42" c@+ rot fatwritebuf 2 #eq ( fc ) File :close
f<< /newfile 42 #eq
testend
diff --git a/fs/xcomp/boothi.fs b/fs/xcomp/boothi.fs
@@ -1,14 +1,13 @@
0 value curhdl \ handle of the file currently being read
0 value fecho
-16 smethod fclose ( hdl -- )
-: \s curhdl ?dup if fclose then ;
+: \s curhdl ?dup if File :close then ;
: f< ( -- c )
- 1 curhdl dup @ ( 'freadbuf ) execute if c@ else -1 ( EOF ) then
+ 1 curhdl File :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 fclose r> to curhdl ;
+ r> to in< curhdl File :close r> to curhdl ;
0 S" init.fs" activefs :child fload
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -87,10 +87,6 @@
: &+! ( n -- ) doer , does> @ + ! ;
: _ @ + ;
: field ( off -- ) code compile (to) ['] _ , ['] @ , , exit, ;
-\ A structure method. Called with a strucure as the top argument and will
-\ execute the word pointer at a specific offset with that structure pointer
-\ till on the top of PS.
-: smethod ( off -- ) doer , does> @ over + @ execute ;
\ while..repeat
: while [compile] if swap ; immediate
@@ -204,10 +200,15 @@ alias noop [then]
\ Anticipating lib/drive
3 struct Drive secsz :sec@ :sec!
+\ I/O API
+\ Anticipating lib/io
+3 struct IO :readbuf :writebuf :flush
+
\ File API
\ Anticipating lib/file
4 struct Filesystem :drv :child :open :newfile
alias abort activefs immediate
+extends IO 2 struct File :seek :close
\ Autoloading
0 value floaded \ address of the current "loaded file" structure
