minHeap option in .urp files

10 files changed, 47 insertions, 13 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index 2cbfefb3..68e0b10c 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -163,6 +163,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
   \item \texttt{transactionals}: maximum number of custom transactional actions (e.g., sending an e-mail) that may be run in a single page generation
   \end{itemize}
 \item \texttt{link FILENAME} adds \texttt{FILENAME} to the list of files to be passed to the GCC linker at the end of compilation.  This is most useful for importing extra libraries needed by new FFI modules.
+\item \texttt{minHeap NUMBYTES} sets the initial size for thread-local heaps used in handling requests.  These heaps grow automatically as needed (up to any maximum set with \texttt{limit}), but each regrow requires restarting the request handling process.
 \item \texttt{onError Module.var} changes the handling of fatal application errors.  Instead of displaying a default, ugly error 500 page, the error page will be generated by calling function \texttt{Module.var} on a piece of XML representing the error message.  The error handler should have type $\mt{xbody} \to \mt{transaction} \; \mt{page}$.  Note that the error handler \emph{cannot} be in the application's main module, since that would register it as explicitly callable via URLs.
 \item \texttt{path NAME=VALUE} creates a mapping from \texttt{NAME} to \texttt{VALUE}.  This mapping may be used at the beginnings of filesystem paths given to various other configuration directives.  A path like \texttt{\$NAME/rest} is expanded to \texttt{VALUE/rest}.  There is an initial mapping from the empty name (for paths like \texttt{\$/list}) to the directory where the Ur/Web standard library is installed.  If you accept the default \texttt{configure} options, this directory is \texttt{/usr/local/lib/urweb/ur}.
 \item \texttt{prefix PREFIX} sets the prefix included before every URI within the generated application.  The default is \texttt{/}.
diff --git a/include/urweb.h b/include/urweb.h
index f63b3f4c..a7920851 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -284,8 +284,6 @@ void uw_set_client_data(uw_context, void *);
 
 uw_Basis_int uw_Basis_rand(uw_context);
 
-extern int uw_time_max;
-
-extern int uw_supports_direct_status;
+extern int uw_time_max, uw_supports_direct_status, uw_min_heap;
 
 #endif
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 392108fe..b4a15bce 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -348,7 +348,7 @@ void uw_app_init(uw_app *app) {
   app->client_init();
 }
 
-int uw_time = 0, uw_time_max = 0;
+int uw_time = 0, uw_time_max = 0, uw_min_heap = 0;
 
 
 // Single-request state
@@ -461,7 +461,7 @@ uw_context uw_init() {
   buf_init(uw_headers_max, &ctx->outHeaders, 0);
   buf_init(uw_page_max, &ctx->page, 0);
   ctx->returning_indirectly = 0;
-  buf_init(uw_heap_max, &ctx->heap, 0);
+  buf_init(uw_heap_max, &ctx->heap, uw_min_heap);
   buf_init(uw_script_max, &ctx->script, 1);
   ctx->script.start[0] = 0;
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 46de6a52..df11737e 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2834,6 +2834,16 @@ fun p_file env (ds, ps) =
 
              box [string "static void uw_setup_limits() {",
                   newline,
+                  case Settings.getMinHeap () of
+                      0 => box []
+                    | n => box [string "uw_min_heap",
+                                space,
+                                string "=",
+                                space,
+                                string (Int.toString n),
+                                string ";",
+                                newline,
+                                newline],
                   box [p_list_sep (box []) (fn (class, num) =>
                                                let
                                                    val num = case class of
diff --git a/src/compiler.sig b/src/compiler.sig
index d0f6ac72..971ddf53 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -55,7 +55,8 @@ signature COMPILER = sig
          dbms : string option,
          sigFile : string option,
          safeGets : string list,
-         onError : (string * string list * string) option
+         onError : (string * string list * string) option,
+         minHeap : int
     }
     val compile : string -> bool
     val compiler : string -> unit
diff --git a/src/compiler.sml b/src/compiler.sml
index 63db1b87..655f8ced 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -59,7 +59,8 @@ type job = {
      dbms : string option,
      sigFile : string option,
      safeGets : string list,
-     onError : (string * string list * string) option
+     onError : (string * string list * string) option,
+     minHeap : int
 }
 
 type ('src, 'dst) phase = {
@@ -308,14 +309,19 @@ fun institutionalizeJob (job : job) =
      Option.app Settings.setProtocol (#protocol job);
      Option.app Settings.setDbms (#dbms job);
      Settings.setSafeGets (#safeGets job);
-     Settings.setOnError (#onError job))
+     Settings.setOnError (#onError job);
+     Settings.setMinHeap (#minHeap job))
 
 fun inputCommentableLine inf =
     Option.map (fn s =>
                    let
                        val s = #1 (Substring.splitl (fn ch => ch <> #"#") (Substring.full s))
+                       val s = #1 (Substring.splitr (not o Char.isSpace) s)
                    in
-                       Substring.string (#1 (Substring.splitr (not o Char.isSpace) s))
+                       Substring.string (if Substring.size s > 0 andalso Char.isSpace (Substring.sub (s, Substring.size s - 1)) then
+                                             Substring.trimr 1 s
+                                         else
+                                             s)
                    end) (TextIO.inputLine inf)
 
 fun parseUrp' accLibs fname =
@@ -349,7 +355,8 @@ fun parseUrp' accLibs fname =
                        dbms = NONE,
                        sigFile = NONE,
                        safeGets = [],
-                       onError = NONE}
+                       onError = NONE,
+                       minHeap = 0}
         in
             institutionalizeJob job;
             {Job = job, Libs = []}
@@ -464,6 +471,7 @@ fun parseUrp' accLibs fname =
                     val sigFile = ref (Settings.getSigFile ())
                     val safeGets = ref []
                     val onError = ref NONE
+                    val minHeap = ref 0
 
                     fun finish sources =
                         let
@@ -494,7 +502,8 @@ fun parseUrp' accLibs fname =
                                 dbms = !dbms,
                                 sigFile = !sigFile,
                                 safeGets = rev (!safeGets),
-                                onError = !onError
+                                onError = !onError,
+                                minHeap = !minHeap
                             }
 
                             fun mergeO f (old, new) =
@@ -539,7 +548,8 @@ fun parseUrp' accLibs fname =
                                 dbms = mergeO #2 (#dbms old, #dbms new),
                                 sigFile = mergeO #2 (#sigFile old, #sigFile new),
                                 safeGets = #safeGets old @ #safeGets new,
-                                onError = mergeO #2 (#onError old, #onError new)
+                                onError = mergeO #2 (#onError old, #onError new),
+                                minHeap = Int.max (#minHeap old, #minHeap new)
                             }
                         in
                             if accLibs then
@@ -717,6 +727,10 @@ fun parseUrp' accLibs fname =
                                               else
                                                   Settings.addLimit (class, n))
                                        | _ => ErrorMsg.error "invalid 'limit' arguments")
+                                  | "minHeap" =>
+                                    (case Int.fromString arg of
+                                         NONE => ErrorMsg.error ("invalid min heap '" ^ arg ^ "'")
+                                       | SOME n => minHeap := n)
 
                                   | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
                                 read ()
diff --git a/src/demo.sml b/src/demo.sml
index 19632d0e..4ebdbcbc 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -118,7 +118,8 @@ fun make' {prefix, dirname, guided} =
             dbms = mergeWith #2 (#dbms combined, #dbms urp),
             sigFile = mergeWith #2 (#sigFile combined, #sigFile urp),
             safeGets = [],
-            onError = NONE
+            onError = NONE,
+            minHeap = 0
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
diff --git a/src/settings.sig b/src/settings.sig
index b72d007b..efbbdb32 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -211,4 +211,7 @@ signature SETTINGS = sig
 
     val addLimit : string * int -> unit
     val limits : unit -> (string * int) list
+
+    val setMinHeap : int -> unit
+    val getMinHeap : unit -> int
 end
diff --git a/src/settings.sml b/src/settings.sml
index 7a943217..898b503f 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -509,4 +509,8 @@ fun addLimit (v as (name, _)) =
         raise Fail ("Unknown limit category '" ^ name ^ "'")
 fun limits () = !limitsList
 
+val minHeap = ref 0
+fun setMinHeap n = if n >= 0 then minHeap := n else raise Fail "Trying to set negative minHeap"
+fun getMinHeap () = !minHeap
+
 end
diff --git a/tests/hog.urp b/tests/hog.urp
index 615fb529..edfef7f1 100644
--- a/tests/hog.urp
+++ b/tests/hog.urp
@@ -1 +1,3 @@
+minHeap 1000000
+
 hog