X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/f9a1c9cea42bd3c290b8823e1ece25a3bc878462..0b1e24898c41afa1f07854c295881b23aa2faea6:/fth/file.fth

diff --git a/fth/file.fth b/fth/file.fth
index b71edc5..a2835bf 100644
--- a/fth/file.fth
+++ b/fth/file.fth
@@ -61,6 +61,15 @@ create (LINE-TERMINATOR) \n c,
     0 2r> + c!        ( )
 ;
 
+: MULTI-LINE-COMMENT ( "comment<rparen>" -- )
+    BEGIN
+        >in @ ')' parse         ( >in c-addr len )
+        nip + >in @ =           ( delimiter-not-found? )
+    WHILE                       ( )
+        refill 0= IF EXIT THEN  ( )
+    REPEAT
+;
+
 }private
 
 \ This treats \n, \r\n, and \r as line terminator.  Reading is done
@@ -108,4 +117,30 @@ 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
+        -1 OF postpone ( ENDOF
+        0  OF postpone ( ENDOF
+        \ for input from files
+        multi-line-comment
+    ENDCASE
+; immediate
+
 privatize