# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1221152811 14400
# Node ID b91480c9a729240083a9aafee650636ec985eeb7
# Parent  5030e909fbf32bad9cbf1947131e73c5730ecc04
More opportunities to use regions and lack of string copying

diff -r 5030e909fbf3 -r b91480c9a729 include/urweb.h
--- a/include/urweb.h	Thu Sep 11 12:40:40 2008 -0400
+++ b/include/urweb.h	Thu Sep 11 13:06:51 2008 -0400
@@ -23,6 +23,7 @@
 void *uw_malloc(uw_context, size_t);
 void uw_begin_region(uw_context);
 void uw_end_region(uw_context);
+void uw_memstats(uw_context);
 
 int uw_send(uw_context, int sock);
 
diff -r 5030e909fbf3 -r b91480c9a729 src/c/driver.c
--- a/src/c/driver.c	Thu Sep 11 12:40:40 2008 -0400
+++ b/src/c/driver.c	Thu Sep 11 13:06:51 2008 -0400
@@ -52,8 +52,8 @@
 #define MAX_RETRIES 5
 
 static void *worker(void *data) {
-  int me = *(int *)data, retries_left = MAX_RETRIES;;
-  uw_context ctx = uw_init(1024, 1024);
+  int me = *(int *)data, retries_left = MAX_RETRIES;
+  uw_context ctx = uw_init(1024, 0);
   
   while (1) {
     failure_kind fk = uw_begin_init(ctx);
@@ -224,6 +224,7 @@
         uw_send(ctx, sock);
 
         printf("Done with client.\n\n");
+        uw_memstats(ctx);
         break;
       }
     }
diff -r 5030e909fbf3 -r b91480c9a729 src/c/urweb.c
--- a/src/c/urweb.c	Thu Sep 11 12:40:40 2008 -0400
+++ b/src/c/urweb.c	Thu Sep 11 13:06:51 2008 -0400
@@ -207,6 +207,11 @@
   ctx->regions = r->next;
 }
 
+void uw_memstats(uw_context ctx) {
+  printf("Page: %d/%d\n", ctx->page_front - ctx->page, ctx->page_back - ctx->page);
+  printf("Heap: %d/%d\n", ctx->heap_front - ctx->heap, ctx->heap_back - ctx->heap);
+}
+
 int uw_really_send(int sock, const void *buf, ssize_t len) {
   while (len > 0) {
     ssize_t n = send(sock, buf, len, 0);
diff -r 5030e909fbf3 -r b91480c9a729 src/cjr_print.sml
--- a/src/cjr_print.sml	Thu Sep 11 12:40:40 2008 -0400
+++ b/src/cjr_print.sml	Thu Sep 11 13:06:51 2008 -0400
@@ -393,11 +393,15 @@
          "uw_" ^ ident m ^ "_" ^ ident con,
          "uw_" ^ ident con)
 
-fun p_unsql env (tAll as (t, loc)) e =
+fun p_unsql wontLeakStrings env (tAll as (t, loc)) e =
     case t of
         TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
-      | TFfi ("Basis", "string") => box [string "uw_Basis_strdup(ctx, ", e, string ")"]
+      | TFfi ("Basis", "string") =>
+        if wontLeakStrings then
+            e
+        else
+            box [string "uw_Basis_strdup(ctx, ", e, string ")"]
       | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
       | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
               Print.eprefaces' [("Type", p_typ env tAll)];
@@ -443,6 +447,29 @@
       | String => box [string "strlen(", e, string ")"]
       | Bool => string "sizeof(uw_Basis_bool)"
 
+fun notLeaky env allowHeapAllocated =
+    let
+        fun nl (t, _) =
+            case t of
+                TFun _ => false
+              | TRecord n =>
+                let
+                    val xts = E.lookupStruct env n
+                in
+                    List.all (fn (_, t) => nl t) xts
+                end
+              | TDatatype (dk, _, ref cons) =>
+                (allowHeapAllocated orelse dk = Enum)
+                andalso List.all (fn (_, _, to) => case to of
+                                                       NONE => true
+                                                     | SOME t => nl t) cons
+              | TFfi ("Basis", "string") => false
+              | TFfi _ => true
+              | TOption t => allowHeapAllocated andalso nl t
+    in
+        nl
+    end
+
 fun p_exp' par env (e, loc) =
     case e of
         EPrim p => Prim.p_t_GCC p
@@ -711,8 +738,16 @@
                                             tables
                                                                                               
             val outputs = exps @ tables
+
+            val wontLeakStrings = notLeaky env true state
+            val wontLeakAnything = notLeaky env false state
         in
-            box [string "(uw_begin_region(ctx), ({",
+            box [string "(uw_begin_region(ctx), ",
+                 if wontLeakAnything then
+                     string "uw_begin_regio(ctx), "
+                 else
+                     box [],
+                 string "({",
                  newline,
                  string "PGconn *conn = uw_get_db(ctx);",
                  newline,
@@ -826,7 +861,7 @@
                                                     space,
                                                     string "=",
                                                     space,
-                                                    p_unsql env t
+                                                    p_unsql wontLeakStrings env t
                                                             (box [string "PQgetvalue(res, i, ",
                                                                   string (Int.toString i),
                                                                   string ")"]),
@@ -851,6 +886,11 @@
                  newline,
                  string "PQclear(res);",
                  newline,
+                 if wontLeakAnything then
+                     box [string "uw_end_region(ctx);",
+                          newline]
+                 else
+                     box [],
                  string "acc;",
                  newline,
                  string "}))"]