relicense to 0BSD

[pforth] / fth / file.fth

diff --git a/fth/file.fth b/fth/file.fth
index 0017942..6d26af3 100644 (file)
--- a/fth/file.fth
+++ b/fth/file.fth
@@ -2,14 +2,17 @@
 \
 \ This code is part of pForth.
 \
 \
 \ This code is part of pForth.
 \

-\ The pForth software code is dedicated to the public domain,
-\ and any third party may reproduce, distribute and modify
-\ the pForth software code or any derivative works thereof
-\ without any compensation or license.  The pForth software
-\ code is provided on an "as is" basis without any warranty
-\ of any kind, including, without limitation, the implied
-\ warranties of merchantability and fitness for a particular
-\ purpose and their equivalents under the laws of any jurisdiction.
+\ Permission to use, copy, modify, and/or distribute this
+\ software for any purpose with or without fee is hereby granted.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
+\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

 
 private{
 
 
 private{
 


@@ -117,6 +120,22 @@ create (LINE-TERMINATOR) \n c,
     THEN
 ;
 
     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
 : (  ( "comment<rparen>"  -- )
     source-id
     CASE


@@ -133,10 +152,10 @@ create (LINE-TERMINATOR) \n c,
 \ 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).)
 \ 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 )
+: FILE-STATUS ( c-addr u -- 0 ior )

     r/o bin open-file           ( fileid ior1 )
     ?dup
     r/o bin open-file           ( fileid ior1 )
     ?dup

-    IF                          ( fileid ior1 )
+    IF   nip 0 swap             ( 0 ior1 )

     ELSE close-file 0 swap      ( 0 ior2 )
     THEN
 ;
     ELSE close-file 0 swap      ( 0 ior2 )
     THEN
 ;