X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/3f863e2896ed0418e1ad202e233b5a036f989ee2..f1994bf609c5b053c5c0d7db2062b570fa9f5ead:/fth/file.fth

diff --git a/fth/file.fth b/fth/file.fth
index 8fe0810..59303f0 100644
--- a/fth/file.fth
+++ b/fth/file.fth
@@ -117,6 +117,22 @@ create (LINE-TERMINATOR) \n c,
     THEN
 ;
 
+\ A limit used to perform a sanity check on the size argument for
+\ RESIZE-FILE.
+2variable RESIZE-FILE-LIMIT
+10000000 0 resize-file-limit 2!  \ 10MB is somewhat arbitrarily chosen
+
+: RESIZE-FILE ( ud fileid -- ior )
+    -rot 2dup resize-file-limit 2@ d>             ( fileid ud big? )
+    IF
+        ." Argument (" 0 d.r ." ) is larger then RESIZE-FILE-LIMIT." cr
+        ." (You can increase RESIZE-FILE-LIMIT with 2!)" cr
+        abort
+    ELSE
+        rot (resize-file)
+    THEN
+;
+
 : (  ( "comment<rparen>"  -- )
     source-id
     CASE
@@ -127,4 +143,18 @@ create (LINE-TERMINATOR) \n c,
     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 -- 0 ior )
+    r/o bin open-file           ( fileid ior1 )
+    ?dup
+    IF   nip 0 swap             ( 0 ior1 )
+    ELSE close-file 0 swap      ( 0 ior2 )
+    THEN
+;
+
 privatize