diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c/driver.c | 5 | ||||
| -rw-r--r-- | src/c/urweb.c | 5 | ||||
| -rw-r--r-- | src/cjr_print.sml | 48 |
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 "}))"] |