From: Phil Burk <philburk@mobileer.com>
Date: Mon, 16 Jan 2017 04:28:45 +0000 (-0800)
Subject: Merge pull request #36 from ellerh/resize-file-limit
X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/f1994bf609c5b053c5c0d7db2062b570fa9f5ead?hp=-c

Merge pull request #36 from ellerh/resize-file-limit

This introduces a RESIZE-FILE-LIMIT
---

f1994bf609c5b053c5c0d7db2062b570fa9f5ead
diff --combined fth/file.fth
index a54220c,a2835bf..59303f0
--- a/fth/file.fth
+++ b/fth/file.fth
@@@ -117,6 -117,22 +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,18 -143,4 +143,18 @@@
      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
diff --combined fth/system.fth
index 5830cce,48572cf..21200fa
--- a/fth/system.fth
+++ b/fth/system.fth
@@@ -364,6 -364,14 +364,14 @@@
  	rot = -rot = and
  ;
  
+ : D< ( d1 d2 -- flag )
+     d- nip 0<
+ ;
+ 
+ : D> ( d1 d2 -- flag )
+     2swap d<
+ ;
+ 
  \ define some useful constants ------------------------------
  1 0= constant FALSE
  0 0= constant TRUE
@@@ -721,11 -729,9 +729,11 @@@ ustack 0stack
  variable TRACE-INCLUDE
  
  : INCLUDE.MARK.START  ( c-addr u -- , mark start of include for FILE?)
 -    " ::::"  pad $MOVE
 -    pad $APPEND
 -    pad ['] noop (:)
 +    dup 5 + allocate throw >r
 +    " ::::" r@ $move
 +    r@ $append
 +    r@ ['] noop (:)
 +    r> free throw
  ;
  
  : INCLUDE.MARK.END  ( -- , mark end of include )