X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=fth%2Ffile.fth;h=59303f06c9b4ae2ccec05ced8395eac40f94ac72;hb=7260a8255869f3c801885a8a74315536f709bae9;hp=a54220cd0178a8d1c1cfa2ba020bdd95984d148c;hpb=391238894e9b4c5ba60ff52a995b2cda81242242;p=debian%2Fpforth

diff --git a/fth/file.fth b/fth/file.fth
index a54220c..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