Mercurial > urweb
changeset 324:b91480c9a729
More opportunities to use regions and lack of string copying
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 11 Sep 2008 13:06:51 -0400 |
| parents | 5030e909fbf3 |
| children | e457d8972ff1 |
| files | include/urweb.h src/c/driver.c src/c/urweb.c src/cjr_print.sml |
| diffstat | 4 files changed, 53 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- 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);
--- 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; } }
--- 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);
--- 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 "}))"]