summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-11 13:06:51 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-11 13:06:51 -0400
commit05fbd01cabc967d7216d8cbe701ac10ad797b122 (patch)
tree73966b5bbe40adcbb3abbf589652ef3b8afc0440 /src
parentfe9025e471578cbdef8ee21e0f9dc51f0f2107ce (diff)
More opportunities to use regions and lack of string copying
Diffstat (limited to 'src')
-rw-r--r--src/c/driver.c5
-rw-r--r--src/c/urweb.c5
-rw-r--r--src/cjr_print.sml48
3 files changed, 52 insertions, 6 deletions
diff --git a/src/c/driver.c b/src/c/driver.c
index e5e1affd..705bb613 100644
--- a/src/c/driver.c
+++ b/src/c/driver.c
@@ -52,8 +52,8 @@ static pthread_cond_t queue_cond = PTHREAD_COND_INITIALIZER;
#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 @@ static void *worker(void *data) {
uw_send(ctx, sock);
printf("Done with client.\n\n");
+ uw_memstats(ctx);
break;
}
}
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 7c7b057f..d4fd1844 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -207,6 +207,11 @@ void uw_end_region(uw_context ctx) {
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 --git a/src/cjr_print.sml b/src/cjr_print.sml
index 8bdb1ba5..bdf2873f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -393,11 +393,15 @@ fun patConInfo env pc =
"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 @@ fun p_ensql_len t e =
| 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 @@ fun p_exp' par env (e, loc) =
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 @@ fun p_exp' par env (e, loc) =
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 @@ fun p_exp' par env (e, loc) =
newline,
string "PQclear(res);",
newline,
+ if wontLeakAnything then
+ box [string "uw_end_region(ctx);",
+ newline]
+ else
+ box [],
string "acc;",
newline,
string "}))"]