Implement FILE-STATUS

This implements FILE-STATUS on top of OPEN-FILE:  FILE-STATUS succeeds
if we can open the file in read-only mode.  This way we avoid adding
yet another primitive.

* fth/file.fth (FILE-STATUS): New
* fth/t_file.fth (FILE-STATUS): Delete stub

diff --git a/fth/file.fth b/fth/file.fth
index 8fe0810..0017942 100644 (file)
--- a/fth/file.fth
+++ b/fth/file.fth
@@ -127,4 +127,18 @@ create (LINE-TERMINATOR) \n c,
     ENDCASE
 ; immediate
 
     ENDCASE
 ; immediate
 

+\ We basically try to open the file in read-only mode.  That seems to
+\ be the best that we can do with ANSI C.  If we ever want to do
+\ something more sophisticated, like calling access(2), we must create
+\ a proper primitive.  (OTOH, portable programs can't assume much
+\ about FILE-STATUS and non-portable programs could create a custom
+\ function for access(2).)
+: FILE-STATUS ( c-addr u -- x ior )
+    r/o bin open-file           ( fileid ior1 )
+    ?dup
+    IF                          ( fileid ior1 )
+    ELSE close-file 0 swap      ( 0 ior2 )
+    THEN
+;
+

 privatize
 privatize

diff --git a/fth/t_file.fth b/fth/t_file.fth
index 388008c..018ca58 100644 (file)
--- a/fth/t_file.fth
+++ b/fth/t_file.fth
@@ -60,7 +60,7 @@ include? }T{  t_tools.fth
 
 true fp-require-e !
 
 
 true fp-require-e !
 

-true value verbose
+false value verbose

 
 : testing
     verbose IF
 
 : testing
     verbose IF


@@ -73,9 +73,6 @@ true value verbose
 : s= compare 0= ;
 : $" state IF postpone s" else ['] s" execute THEN ; immediate
 
 : s= compare 0= ;
 : $" state IF postpone s" else ['] s" execute THEN ; immediate
 

-\ FIXME: stubs for missing definitions
-: file-status 2drop 0 -1 ;
-

 TESTING File Access word set
 
 DECIMAL
 TESTING File Access word set
 
 DECIMAL