commit 0c9a2b553c59f74be6b0e158b41249edb0e7276c
parent f7c3ef6cfa9d36c5b80a434981d1082757a80e20
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 1 Jul 2022 19:48:24 -0400
getc now returns -1 when EOF is reached
This whole "c-or-0" pattern works as long as we don't deal with binary files.
But otherwise, this pattern doesn't work.
Diffstat:
8 files changed, 41 insertions(+), 24 deletions(-)
diff --git a/dusk.asm b/dusk.asm
@@ -656,8 +656,8 @@ defword 'maybeword', 9, word_maybeword
_word_loop1:
call [inrd] ; ( -- c )
pspop eax
- cmp eax, 0x05 ; is EOF?
- jc _word_eof
+ test eax, eax
+ js _word_eof
cmp eax, 0x21 ; is ws?
jc _word_loop1
mov ebx, curword+1
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -53,7 +53,7 @@ create _ 10 c, ," 09AZaz__$$"
\ advance to the next non-whitespace and return the char encountered.
\ if end of stream is reached, c is 0
: tonws ( -- c ) begin ( )
- _cc< dup EOF > while dup ws? while drop repeat
+ _cc< dup 0>= while dup ws? while drop repeat
( c ) else ( EOF ) drop 0 then ;
: _writesym ( c3? c2? c1 len -- str )
diff --git a/fs/fs/boot.fs b/fs/fs/boot.fs
@@ -135,8 +135,8 @@ create fcursors( FCursorSize FCURSORCNT * allot0
: fat16open ( path -- fcursor ) findpath openfile ;
-: fat16getc ( fcursor -- c-or-0 )
- dup FCUR_pos over FCUR_size = if drop 0 exit then
+: fat16getc ( fcursor -- c )
+ dup FCUR_pos over FCUR_size = if drop -1 exit then
dup FCUR_pos+ ClusterSize mod over FCUR_buf( + c@ ( fc c )
over FCUR_pos ClusterSize mod not if ( fc c ) \ end of cluster, read next
over FCUR_cluster nextcluster ( fc c cluster )
diff --git a/fs/init.fs b/fs/init.fs
@@ -10,7 +10,7 @@ RAMDRVSECSZ to drvblksz
fatfs( to ramdrv(
' ramdrv@ to (drv@)
' ramdrv! to (drv!)
-f<< lib/file.fs
+f<< sys/file.fs
f<< lib/nfmt.fs
f<< lib/diag.fs
f<< sys/xhere.fs
diff --git a/fs/lib/file.fs b/fs/lib/file.fs
@@ -1,15 +0,0 @@
-\ File I/O
-\ requires sys/scratch
-\ This creates a "f<" reader with the file descriptor embedded in it. This
-\ allows for a straightforward override of input/output words.
-: [f<] ( curfd -- word )
- scratch[ litn compile fgetc exit, ]scratch ;
-
-\ Autoloading
-
-: floaded? ( str -- f )
- floaded begin dup while 2dup 4 +
- s= if 2drop 1 exit then @ repeat 2drop 0 ;
-: .floaded floaded begin dup while dup 4 + stype nl> @ repeat drop ;
-: ?f<< word dup floaded? if drop else fload then ;
-: require word dup floaded? not if stype abort" required" else drop then ;
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -0,0 +1,33 @@
+\ File subsystem
+\ requires sys/scratch
+
+\ This subsystems defines a "filesystem" protocol and upon it defines
+\ convenience word around files. This subsystem is a bit weird because the
+\ boot sequence has already defined 3 of those words from the protocol. They
+\ are:
+
+\ fopen ( path -- fcursor )
+\ Open file at path and return a cursor 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.
+
+\ fclose ( fcursor -- )
+\ Close cursor fcursor and free its ressources.
+
+\ fgetc ( fcursor -- c )
+\ Read a single character from fcursor. If the end of file (EOF) is reached,
+\ returns -1.
+
+\ This creates a "f<" reader with the file descriptor embedded in it. This
+\ allows for a straightforward override of input/output words.
+: [f<] ( curfd -- word )
+ scratch[ litn compile fgetc exit, ]scratch ;
+
+\ Autoloading
+
+: floaded? ( str -- f )
+ floaded begin dup while 2dup 4 +
+ s= if 2drop 1 exit then @ repeat 2drop 0 ;
+: .floaded floaded begin dup while dup 4 + stype nl> @ repeat drop ;
+: ?f<< word dup floaded? if drop else fload then ;
+: require word dup floaded? not if stype abort" required" else drop then ;
diff --git a/fs/tests/fs/boot.fs b/fs/tests/fs/boot.fs
@@ -18,6 +18,6 @@ dup $fd readN ( fcursor )
dup fat16getc 'b' #eq
dup $dfc readN ( fcursor )
dup fat16getc 'E' #eq dup fat16getc 'O' #eq dup fat16getc 'F' #eq
-dup fat16getc 0 #eq
+dup fat16getc -1 #eq
fat16close
testend
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -59,8 +59,7 @@
: =><= ( n l h -- f ) over - rot> ( h n l ) - >= ;
\ Emitting
-$20 const SPC $0d const CR $0a const LF
-$08 const BS $04 const EOF
+$20 const SPC $0d const CR $0a const LF $08 const BS
: nl> CR emit LF emit ; : spc> SPC emit ;
\ emit all chars of "str"
: stype ( str -- ) c@+ rtype ;
