From b1516ed386ca303a526959586f0a06564ca77bb0 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Tue, 27 May 2014 21:14:13 -0400 Subject: Finishes initial prototype, caching parameterless pages with table-match-based invalidation. Still has problems parsing non-Postgres SQL dialects properly. --- src/c/urweb.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index ffcc0146..d4c0b439 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -477,6 +477,9 @@ struct uw_context { char *output_buffer; size_t output_buffer_size; + + // For caching. + char *recording; }; size_t uw_headers_max = SIZE_MAX; @@ -560,6 +563,8 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->output_buffer = malloc(1); ctx->output_buffer_size = 1; + ctx->recording = 0; + return ctx; } @@ -1636,6 +1641,19 @@ void uw_write(uw_context ctx, const char* s) { *ctx->page.front = 0; } +void uw_recordingStart(uw_context ctx) { + // TODO: remove following debug statement. + uw_write(ctx, ""); + ctx->recording = ctx->page.front; +} + +char *uw_recordingRead(uw_context ctx) { + char *recording = strdup(ctx->recording); + // TODO: remove following debug statement. + uw_write(ctx, ""); + return recording; +} + char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) { char *result; int len; -- cgit v1.2.3 From 171e5ecea687a43033e92c98c0661cc161d50e4a Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sat, 31 May 2014 03:08:16 -0400 Subject: Cleans up interface (it's now a command line option) and renames project to "sqlcache" in the all-one-word style. Still has issues to do with concurrency, retrying transactions, and foreign function calls that either rely on state or have side effects. --- caching-tests/test.ur | 1 - src/c/urweb.c | 7 +- src/cjr_print.sml | 14 ++-- src/compiler.sig | 5 +- src/compiler.sml | 9 +-- src/main.mlton.sml | 12 ++-- src/sources | 9 +-- src/sql.sml | 20 +++--- src/sql_cache.sml | 186 -------------------------------------------------- src/sqlcache.sig | 6 ++ src/sqlcache.sml | 182 ++++++++++++++++++++++++++++++++++++++++++++++++ 11 files changed, 227 insertions(+), 224 deletions(-) delete mode 100644 src/sql_cache.sml create mode 100644 src/sqlcache.sig create mode 100644 src/sqlcache.sml (limited to 'src/c/urweb.c') diff --git a/caching-tests/test.ur b/caching-tests/test.ur index d13379a8..a99a387b 100644 --- a/caching-tests/test.ur +++ b/caching-tests/test.ur @@ -2,7 +2,6 @@ table foo01 : {Id : int, Bar : string} PRIMARY KEY Id table foo10 : {Id : int, Bar : string} PRIMARY KEY Id fun flush01 () : transaction page = - dml (INSERT INTO foo01 (Id, Bar) VALUES (42, "baz01")); dml (UPDATE foo01 SET Bar = "baz01" WHERE Id = 42); return Flushed 1! diff --git a/src/c/urweb.c b/src/c/urweb.c index 10bbf930..57762da8 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1667,16 +1667,11 @@ void uw_write(uw_context ctx, const char* s) { } void uw_recordingStart(uw_context ctx) { - // TODO: remove following debug statement. - uw_write(ctx, ""); ctx->recording = ctx->page.front; } char *uw_recordingRead(uw_context ctx) { - char *recording = strdup(ctx->recording); - // TODO: remove following debug statement. - uw_write(ctx, ""); - return recording; + return strdup(ctx->recording); } char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) { diff --git a/src/cjr_print.sml b/src/cjr_print.sml index ecd29f71..af2340fe 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -3388,9 +3388,9 @@ fun p_file env (ds, ps) = newline, string "static uw_Basis_bool uw_Cache_check", string i, - string "(uw_context ctx) { puts(\"Checked ", + string "(uw_context ctx) { puts(\"Checked cache ", string i, - string "\"); if (cache", + string ".\"); if (cache", string i, string " == NULL) { uw_recordingStart(ctx); return uw_Basis_False; } else { uw_write(ctx, cache", string i, @@ -3400,9 +3400,9 @@ fun p_file env (ds, ps) = string i, string "(uw_context ctx) { cache", string i, - string " = uw_recordingRead(ctx); puts(\"Stored ", + string " = uw_recordingRead(ctx); puts(\"Stored cache ", string i, - string "\"); return uw_unit_v; };", + string ".\"); return uw_unit_v; };", newline, string "static uw_unit uw_Cache_flush", string i, @@ -3410,9 +3410,9 @@ fun p_file env (ds, ps) = string i, string "); cache", string i, - string " = NULL; puts(\"Flushed ", + string " = NULL; puts(\"Flushed cache ", string i, - string "\"); return uw_unit_v; };", + string ".\"); return uw_unit_v; };", newline, string "static uw_unit uw_Cache_ready", string i, @@ -3420,7 +3420,7 @@ fun p_file env (ds, ps) = newline, newline] end) - (!SqlCache.ffiIndices)), + (!Sqlcache.ffiIndices)), newline, p_list_sep newline (fn x => x) pds, diff --git a/src/compiler.sig b/src/compiler.sig index a0a653a7..81d92694 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -122,7 +122,7 @@ signature COMPILER = sig val pathcheck : (Mono.file, Mono.file) phase val sidecheck : (Mono.file, Mono.file) phase val sigcheck : (Mono.file, Mono.file) phase - val sqlCache : (Mono.file, Mono.file) phase + val sqlcache : (Mono.file, Mono.file) phase val cjrize : (Mono.file, Cjr.file) phase val prepare : (Cjr.file, Cjr.file) phase val checknest : (Cjr.file, Cjr.file) phase @@ -187,7 +187,7 @@ signature COMPILER = sig val toPathcheck : (string, Mono.file) transform val toSidecheck : (string, Mono.file) transform val toSigcheck : (string, Mono.file) transform - val toSqlCache : (string, Mono.file) transform + val toSqlcache : (string, Mono.file) transform val toCjrize : (string, Cjr.file) transform val toPrepare : (string, Cjr.file) transform val toChecknest : (string, Cjr.file) transform @@ -198,6 +198,7 @@ signature COMPILER = sig val enableBoot : unit -> unit val doIflow : bool ref + val doSqlcache : bool ref val addPath : string * string -> unit val addModuleRoot : string * string -> unit diff --git a/src/compiler.sml b/src/compiler.sml index cbc6478d..26e07e2a 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -83,6 +83,7 @@ type ('src, 'dst) transform = { val debug = ref false val dumpSource = ref false val doIflow = ref false +val doSqlcache = ref false val doDumpSource = ref (fn () => ()) @@ -1439,19 +1440,19 @@ val sigcheck = { val toSigcheck = transform sigcheck "sigcheck" o toSidecheck -val sqlCache = { - func = SqlCache.go, +val sqlcache = { + func = (fn file => (if !doSqlcache then Sqlcache.go file else file)), print = MonoPrint.p_file MonoEnv.empty } -val toSqlCache = transform sqlCache "sqlCache" o toSigcheck +val toSqlcache = transform sqlcache "sqlcache" o toSigcheck val cjrize = { func = Cjrize.cjrize, print = CjrPrint.p_file CjrEnv.empty } -val toCjrize = transform cjrize "cjrize" o toSqlCache +val toCjrize = transform cjrize "cjrize" o toSqlcache val prepare = { func = Prepare.prepare, diff --git a/src/main.mlton.sml b/src/main.mlton.sml index bfc18e59..5ecd7290 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -47,6 +47,7 @@ fun oneRun args = Elaborate.unifyMore := false; Compiler.dumpSource := false; Compiler.doIflow := false; + Compiler.doSqlcache := false; Demo.noEmacs := false; Settings.setDebug false) @@ -64,7 +65,7 @@ fun oneRun args = fun doArgs args = case args of [] => () - | "-version" :: rest => + | "-version" :: rest => printVersion () | "-numeric-version" :: rest => printNumericVersion () @@ -159,6 +160,9 @@ fun oneRun args = | "-iflow" :: rest => (Compiler.doIflow := true; doArgs rest) + | "-sqlcache" :: rest => + (Compiler.doSqlcache := true; + doArgs rest) | "-moduleOf" :: fname :: _ => (print (Compiler.moduleOf fname ^ "\n"); raise Code OS.Process.success) @@ -306,7 +310,7 @@ val () = case CommandLine.arguments () of (* Redirect the daemon's output to the socket. *) redirect Posix.FileSys.stdout; redirect Posix.FileSys.stderr; - + loop' ("", []); Socket.close sock; @@ -325,7 +329,7 @@ val () = case CommandLine.arguments () of loop () end) | ["daemon", "stop"] => - (OS.FileSys.remove socket handle OS.SysErr _ => OS.Process.exit OS.Process.success) + (OS.FileSys.remove socket handle OS.SysErr _ => OS.Process.exit OS.Process.success) | args => let val sock = UnixSock.Strm.socket () diff --git a/src/sources b/src/sources index b468c9a5..a87678f9 100644 --- a/src/sources +++ b/src/sources @@ -189,10 +189,6 @@ $(SRC)/fuse.sml $(SRC)/sql.sig $(SRC)/sql.sml -$(SRC)/multimap_fn.sml - -$(SRC)/sql_cache.sml - $(SRC)/iflow.sig $(SRC)/iflow.sml @@ -211,6 +207,11 @@ $(SRC)/sidecheck.sml $(SRC)/sigcheck.sig $(SRC)/sigcheck.sml +$(SRC)/multimap_fn.sml + +$(SRC)/sqlcache.sig +$(SRC)/sqlcache.sml + $(SRC)/cjr.sml $(SRC)/postgres.sig diff --git a/src/sql.sml b/src/sql.sml index 8642c9d2..11df715c 100644 --- a/src/sql.sml +++ b/src/sql.sml @@ -177,10 +177,10 @@ val uw_ident = wrapP ident (fn s => if String.isPrefix "uw_" s andalso size s >= else NONE) -val field = wrap (follow t_ident - (follow (const ".") - uw_ident)) - (fn (t, ((), f)) => (t, f)) +val field = wrap (follow (opt (follow t_ident (const "."))) + uw_ident) + (fn (SOME (t, ()), f) => (t, f) + | (NONE, f) => ("T", f)) (* Should probably deal with this MySQL/SQLite case better some day. *) datatype Rel = Exps of exp * exp -> prop @@ -396,22 +396,22 @@ val insert = log "insert" val delete = log "delete" (wrap (follow (const "DELETE FROM ") (follow uw_ident - (follow (const " AS T_T WHERE ") + (follow (follow (opt (const " AS T_T")) (const " WHERE ")) sqexp))) - (fn ((), (tab, ((), es))) => (tab, es))) + (fn ((), (tab, (_, es))) => (tab, es))) val setting = log "setting" - (wrap (follow uw_ident (follow (const " = ") sqexp)) - (fn (f, ((), e)) => (f, e))) + (wrap (follow uw_ident (follow (const " = ") sqexp)) + (fn (f, ((), e)) => (f, e))) val update = log "update" (wrap (follow (const "UPDATE ") (follow uw_ident - (follow (const " AS T_T SET ") + (follow (follow (opt (const " AS T_T")) (const " SET ")) (follow (list setting) (follow (ws (const "WHERE ")) sqexp))))) - (fn ((), (tab, ((), (fs, ((), e))))) => + (fn ((), (tab, (_, (fs, ((), e))))) => (tab, fs, e))) val dml = log "dml" diff --git a/src/sql_cache.sml b/src/sql_cache.sml deleted file mode 100644 index 7f9d98d0..00000000 --- a/src/sql_cache.sml +++ /dev/null @@ -1,186 +0,0 @@ -structure SqlCache = struct - -open Sql -open Mono - -structure IS = IntBinarySet -structure IM = IntBinaryMap -structure StringKey = struct type ord_key = string val compare = String.compare end -structure SS = BinarySetFn (StringKey) -structure SM = BinaryMapFn (StringKey) -structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS) - -val ffiIndices : int list ref = ref [] -val rs : int list ref = ref [] -val ws : int list ref = ref [] - -val rec tablesRead = - fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs) - | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2) - -val tableWritten = - fn Insert (tab, _) => tab - | Delete (tab, _) => tab - | Update (tab, _, _) => tab - -fun tablesInExp' exp' = - let - val nothing = {read = SS.empty, written = SS.empty} - in - case exp' of - EQuery {query=e, ...} => - (case parse query e of - SOME q => {read = tablesRead q, written = SS.empty} - | NONE => nothing) - | EDml (e, _) => - (case parse dml e of - SOME q => {read = SS.empty, written = SS.singleton (tableWritten q)} - | NONE => nothing) - | _ => nothing - end - -val tablesInExp = - let - fun addTables (exp', {read, written}) = - let val {read = r, written = w} = tablesInExp' exp' - in {read = SS.union (r, read), written = SS.union (w, written)} end - in - MonoUtil.Exp.fold {typ = #2, exp = addTables} - {read = SS.empty, written = SS.empty} - end - -fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc) -fun intTyp loc = (TFfi ("Basis", "int"), loc) -fun boolPat (b, loc) = (PCon (Enum, - PConFfi {mod = "Basis", datatyp = "bool", arg = NONE, - con = if b then "True" else "False"}, - NONE), - loc) -fun boolTyp loc = (TFfi ("Basis", "int"), loc) - -fun ffiAppExp (module, func, index, loc) = - (EFfiApp (module, func ^ Int.toString index, []), loc) - -fun sequence (befores, center, afters, loc) = - List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc)) - (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) - center - afters) - befores - -fun antiguardUnit (cond, exp, loc) = - (ECase (cond, - [(boolPat (false, loc), exp), - (boolPat (true, loc), (ERecord [], loc))], - {disc = boolTyp loc, result = (TRecord [], loc)}), - loc) - -fun underAbs f (exp as (exp', loc)) = - case exp' of - EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc) - | _ => f exp - -fun addCacheCheck (index, exp) = - let - fun f (body as (_, loc)) = - let - val check = ffiAppExp ("Cache", "check", index, loc) - val store = ffiAppExp ("Cache", "store", index, loc) - in - antiguardUnit (check, sequence ([], body, [store], loc), loc) - end - in - underAbs f exp - end - -fun addCacheFlush (exp, tablesToIndices) = - let - fun addIndices (table, indices) = IS.union (indices, SIMM.find (tablesToIndices, table)) - fun f (body as (_, loc)) = - let - fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc)) - val flushes = - IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body))) - - in - sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc) - end - in - underAbs f exp - end - -val handlerIndices = - let - val isUnit = - fn (TRecord [], _) => true - | _ => false - fun maybeAdd (d, soFar as {readers, writers}) = - case d of - DExport (Link ReadOnly, _, name, typs, typ, _) => - if List.all isUnit (typ::typs) - then {readers = IS.add (readers, name), writers = writers} - else soFar - | DExport (_, _, name, _, _, _) => (* Not read only. *) - {readers = readers, writers = IS.add (writers, name)} - | _ => soFar - in - MonoUtil.File.fold {typ = #2, exp = #2, decl = maybeAdd} - {readers = IS.empty, writers = IS.empty} - end - -fun fileFoldMapiSelected f init (file, indices) = - let - fun doExp (original as ((a, index, b, exp, c), state)) = - if IS.member (indices, index) - then let val (newExp, newState) = f (index, exp, state) - in ((a, index, b, newExp, c), newState) end - else original - fun doDecl decl state = - let - val result = - case decl of - DVal x => - let val (y, newState) = doExp (x, state) - in (DVal y, newState) end - | DValRec xs => - let val (ys, newState) = ListUtil.foldlMap doExp state xs - in (DValRec ys, newState) end - | _ => (decl, state) - in - Search.Continue result - end - fun nada x y = Search.Continue (x, y) - in - case MonoUtil.File.mapfold {typ = nada, exp = nada, decl = doDecl} file init of - Search.Continue x => x - | _ => (file, init) (* Should never happen. *) - end - -fun fileMapSelected f = #1 o fileFoldMapiSelected (fn (_, x, _) => (f x, ())) () - -val addCacheChecking = - let - fun f (index, exp, tablesToIndices) = - (addCacheCheck (index, exp), - SS.foldr (fn (table, tsToIs) => SIMM.insert (tsToIs, table, index)) - tablesToIndices - (#read (tablesInExp exp))) - in - fileFoldMapiSelected f (SM.empty) - end - -fun addCacheFlushing (file, tablesToIndices, writers) = - fileMapSelected (fn exp => addCacheFlush (exp, tablesToIndices)) (file, writers) - -fun go file = - let - val {readers, writers} = handlerIndices file - val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers) - in - rs := IS.listItems readers; - ws := IS.listItems writers; - ffiIndices := IS.listItems readers; - addCacheFlushing (fileWithChecks, tablesToIndices, writers) - end - -end diff --git a/src/sqlcache.sig b/src/sqlcache.sig new file mode 100644 index 00000000..ccc1741a --- /dev/null +++ b/src/sqlcache.sig @@ -0,0 +1,6 @@ +signature SQLCACHE = sig + +val ffiIndices : int list ref +val go : Mono.file -> Mono.file + +end diff --git a/src/sqlcache.sml b/src/sqlcache.sml new file mode 100644 index 00000000..2e7f6e42 --- /dev/null +++ b/src/sqlcache.sml @@ -0,0 +1,182 @@ +structure Sqlcache :> SQLCACHE = struct + +open Sql +open Mono + +structure IS = IntBinarySet +structure IM = IntBinaryMap +structure StringKey = struct type ord_key = string val compare = String.compare end +structure SS = BinarySetFn (StringKey) +structure SM = BinaryMapFn (StringKey) +structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS) + +val ffiIndices : int list ref = ref [] + +val rec tablesRead = + fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs) + | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2) + +val tableWritten = + fn Insert (tab, _) => tab + | Delete (tab, _) => tab + | Update (tab, _, _) => tab + +fun tablesInExp' exp' = + let + val nothing = {read = SS.empty, written = SS.empty} + in + case exp' of + EQuery {query=e, ...} => + (case parse query e of + SOME q => {read = tablesRead q, written = SS.empty} + | NONE => nothing) + | EDml (e, _) => + (case parse dml e of + SOME q => {read = SS.empty, written = SS.singleton (tableWritten q)} + | NONE => nothing) + | _ => nothing + end + +val tablesInExp = + let + fun addTables (exp', {read, written}) = + let val {read = r, written = w} = tablesInExp' exp' + in {read = SS.union (r, read), written = SS.union (w, written)} end + in + MonoUtil.Exp.fold {typ = #2, exp = addTables} + {read = SS.empty, written = SS.empty} + end + +fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc) +fun intTyp loc = (TFfi ("Basis", "int"), loc) +fun boolPat (b, loc) = (PCon (Enum, + PConFfi {mod = "Basis", datatyp = "bool", arg = NONE, + con = if b then "True" else "False"}, + NONE), + loc) +fun boolTyp loc = (TFfi ("Basis", "int"), loc) + +fun ffiAppExp (module, func, index, loc) = + (EFfiApp (module, func ^ Int.toString index, []), loc) + +fun sequence (befores, center, afters, loc) = + List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc)) + (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) + center + afters) + befores + +fun antiguardUnit (cond, exp, loc) = + (ECase (cond, + [(boolPat (false, loc), exp), + (boolPat (true, loc), (ERecord [], loc))], + {disc = boolTyp loc, result = (TRecord [], loc)}), + loc) + +fun underAbs f (exp as (exp', loc)) = + case exp' of + EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc) + | _ => f exp + +fun addCacheCheck (index, exp) = + let + fun f (body as (_, loc)) = + let + val check = ffiAppExp ("Cache", "check", index, loc) + val store = ffiAppExp ("Cache", "store", index, loc) + in + antiguardUnit (check, sequence ([], body, [store], loc), loc) + end + in + underAbs f exp + end + +fun addCacheFlush (exp, tablesToIndices) = + let + fun addIndices (table, indices) = IS.union (indices, SIMM.find (tablesToIndices, table)) + fun f (body as (_, loc)) = + let + fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc)) + val flushes = + IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body))) + + in + sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc) + end + in + underAbs f exp + end + +val handlerIndices = + let + val isUnit = + fn (TRecord [], _) => true + | _ => false + fun maybeAdd (d, soFar as {readers, writers}) = + case d of + DExport (Link ReadOnly, _, name, typs, typ, _) => + if List.all isUnit (typ::typs) + then {readers = IS.add (readers, name), writers = writers} + else soFar + | DExport (_, _, name, _, _, _) => (* Not read only. *) + {readers = readers, writers = IS.add (writers, name)} + | _ => soFar + in + MonoUtil.File.fold {typ = #2, exp = #2, decl = maybeAdd} + {readers = IS.empty, writers = IS.empty} + end + +fun fileFoldMapiSelected f init (file, indices) = + let + fun doExp (original as ((a, index, b, exp, c), state)) = + if IS.member (indices, index) + then let val (newExp, newState) = f (index, exp, state) + in ((a, index, b, newExp, c), newState) end + else original + fun doDecl decl state = + let + val result = + case decl of + DVal x => + let val (y, newState) = doExp (x, state) + in (DVal y, newState) end + | DValRec xs => + let val (ys, newState) = ListUtil.foldlMap doExp state xs + in (DValRec ys, newState) end + | _ => (decl, state) + in + Search.Continue result + end + fun nada x y = Search.Continue (x, y) + in + case MonoUtil.File.mapfold {typ = nada, exp = nada, decl = doDecl} file init of + Search.Continue x => x + | _ => (file, init) (* Should never happen. *) + end + +fun fileMapSelected f = #1 o fileFoldMapiSelected (fn (_, x, _) => (f x, ())) () + +val addCacheChecking = + let + fun f (index, exp, tablesToIndices) = + (addCacheCheck (index, exp), + SS.foldr (fn (table, tsToIs) => SIMM.insert (tsToIs, table, index)) + tablesToIndices + (#read (tablesInExp exp))) + in + fileFoldMapiSelected f (SM.empty) + end + +fun addCacheFlushing (file, tablesToIndices, writers) = + fileMapSelected (fn exp => addCacheFlush (exp, tablesToIndices)) (file, writers) + +fun go file = + let + val {readers, writers} = handlerIndices file + val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers) + in + ffiIndices := IS.listItems readers; + addCacheFlushing (fileWithChecks, tablesToIndices, writers) + end + +end -- cgit v1.2.3 From 24edb607ef64db1ab12b3d5b9ccd3848c50780d1 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sun, 28 Jun 2015 12:46:51 -0700 Subject: Progress on LRU cache but still more known bugs to fix. --- caching-tests/test.ur | 17 +- include/urweb/types_cpp.h | 31 ++ include/urweb/urweb_cpp.h | 8 + include/urweb/uthash.h | 963 ++++++++++++++++++++++++++++++++++++++++++++++ src/c/urweb.c | 147 +++++++ src/lru_cache.sml | 171 ++++++++ src/sources | 1 + src/sqlcache.sml | 115 +++--- 8 files changed, 1397 insertions(+), 56 deletions(-) create mode 100644 include/urweb/uthash.h create mode 100644 src/lru_cache.sml (limited to 'src/c/urweb.c') diff --git a/caching-tests/test.ur b/caching-tests/test.ur index 8035e336..842fd77d 100644 --- a/caching-tests/test.ur +++ b/caching-tests/test.ur @@ -16,13 +16,24 @@ fun flush id = FROM tab WHERE tab.Id = {[id]}); (case res of - None => dml (INSERT INTO tab (Id, Val) - VALUES ({[id]}, 0)) + None => return () (* dml (INSERT INTO tab (Id, Val) *) + (* VALUES ({[id]}, 0)) *) | Some row => dml (UPDATE tab SET Val = {[row.Tab.Val + 1]} - WHERE Id = {[id]})); + WHERE Id = {[id + 1]} OR Id = {[id]} (* OR Id = {[id - 1]} *))); return {case res of None => Initialized {[id]}! | Some row => Incremented {[id]}!} + +(* task periodic 5 = *) +(* fn () => *) +(* t <- now; *) +(* let *) +(* val n = toSeconds t % 2 *) +(* in *) +(* dml (UPDATE tab *) +(* SET Val = 9001 *) +(* WHERE Id = {[n]} OR Id = {[n+1]}) *) +(* end *) diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 0c431ff8..2f154e1f 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -119,4 +119,35 @@ typedef struct { char *start, *front, *back; } uw_buffer; +// Caching + +#include "uthash.h" + +typedef struct CacheValue { + char *result; + char *output; +} CacheValue; + +typedef struct CacheEntry { + char *key; + void *value; + time_t timeValid; + struct CacheEntry *prev; + struct CacheEntry *next; + UT_hash_handle hh; +} CacheEntry; + +typedef struct CacheList { + CacheEntry *first; + CacheEntry *last; + int size; +} CacheList; + +typedef struct Cache { + CacheEntry *table; + time_t timeInvalid; + CacheList *lru; + int height; +} Cache; + #endif diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index a9d42554..3ae5b69e 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -402,4 +402,12 @@ void uw_set_remoteSock(struct uw_context *, int sock); void uw_Basis_writec(struct uw_context *, char); +// Sqlcache. + +#include "uthash.h" + +CacheValue *check(Cache *, char **); +CacheValue *store(Cache *, char **, CacheValue *); +CacheValue *flush(Cache *, char **); + #endif diff --git a/include/urweb/uthash.h b/include/urweb/uthash.h new file mode 100644 index 00000000..367d295a --- /dev/null +++ b/include/urweb/uthash.h @@ -0,0 +1,963 @@ +/* +Copyright (c) 2003-2014, Troy D. Hanson http://troydhanson.github.com/uthash/ +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*/ + +#ifndef UTHASH_H +#define UTHASH_H + +#include /* memcmp,strlen */ +#include /* ptrdiff_t */ +#include /* exit() */ + +/* These macros use decltype or the earlier __typeof GNU extension. + As decltype is only available in newer compilers (VS2010 or gcc 4.3+ + when compiling c++ source) this code uses whatever method is needed + or, for VS2008 where neither is available, uses casting workarounds. */ +#if defined(_MSC_VER) /* MS compiler */ +#if _MSC_VER >= 1600 && defined(__cplusplus) /* VS2010 or newer in C++ mode */ +#define DECLTYPE(x) (decltype(x)) +#else /* VS2008 or older (or VS2010 in C mode) */ +#define NO_DECLTYPE +#define DECLTYPE(x) +#endif +#elif defined(__BORLANDC__) || defined(__LCC__) || defined(__WATCOMC__) +#define NO_DECLTYPE +#define DECLTYPE(x) +#else /* GNU, Sun and other compilers */ +#define DECLTYPE(x) (__typeof(x)) +#endif + +#ifdef NO_DECLTYPE +#define DECLTYPE_ASSIGN(dst,src) \ +do { \ + char **_da_dst = (char**)(&(dst)); \ + *_da_dst = (char*)(src); \ +} while(0) +#else +#define DECLTYPE_ASSIGN(dst,src) \ +do { \ + (dst) = DECLTYPE(dst)(src); \ +} while(0) +#endif + +/* a number of the hash function use uint32_t which isn't defined on Pre VS2010 */ +#if defined (_WIN32) +#if defined(_MSC_VER) && _MSC_VER >= 1600 +#include +#elif defined(__WATCOMC__) +#include +#else +typedef unsigned int uint32_t; +typedef unsigned char uint8_t; +#endif +#else +#include +#endif + +#define UTHASH_VERSION 1.9.9 + +#ifndef uthash_fatal +#define uthash_fatal(msg) exit(-1) /* fatal error (out of memory,etc) */ +#endif +#ifndef uthash_malloc +#define uthash_malloc(sz) malloc(sz) /* malloc fcn */ +#endif +#ifndef uthash_free +#define uthash_free(ptr,sz) free(ptr) /* free fcn */ +#endif + +#ifndef uthash_noexpand_fyi +#define uthash_noexpand_fyi(tbl) /* can be defined to log noexpand */ +#endif +#ifndef uthash_expand_fyi +#define uthash_expand_fyi(tbl) /* can be defined to log expands */ +#endif + +/* initial number of buckets */ +#define HASH_INITIAL_NUM_BUCKETS 32U /* initial number of buckets */ +#define HASH_INITIAL_NUM_BUCKETS_LOG2 5U /* lg2 of initial number of buckets */ +#define HASH_BKT_CAPACITY_THRESH 10U /* expand when bucket count reaches */ + +/* calculate the element whose hash handle address is hhe */ +#define ELMT_FROM_HH(tbl,hhp) ((void*)(((char*)(hhp)) - ((tbl)->hho))) + +#define HASH_FIND(hh,head,keyptr,keylen,out) \ +do { \ + out=NULL; \ + if (head != NULL) { \ + unsigned _hf_bkt,_hf_hashv; \ + HASH_FCN(keyptr,keylen, (head)->hh.tbl->num_buckets, _hf_hashv, _hf_bkt); \ + if (HASH_BLOOM_TEST((head)->hh.tbl, _hf_hashv) != 0) { \ + HASH_FIND_IN_BKT((head)->hh.tbl, hh, (head)->hh.tbl->buckets[ _hf_bkt ], \ + keyptr,keylen,out); \ + } \ + } \ +} while (0) + +#ifdef HASH_BLOOM +#define HASH_BLOOM_BITLEN (1UL << HASH_BLOOM) +#define HASH_BLOOM_BYTELEN (HASH_BLOOM_BITLEN/8UL) + (((HASH_BLOOM_BITLEN%8UL)!=0UL) ? 1UL : 0UL) +#define HASH_BLOOM_MAKE(tbl) \ +do { \ + (tbl)->bloom_nbits = HASH_BLOOM; \ + (tbl)->bloom_bv = (uint8_t*)uthash_malloc(HASH_BLOOM_BYTELEN); \ + if (!((tbl)->bloom_bv)) { uthash_fatal( "out of memory"); } \ + memset((tbl)->bloom_bv, 0, HASH_BLOOM_BYTELEN); \ + (tbl)->bloom_sig = HASH_BLOOM_SIGNATURE; \ +} while (0) + +#define HASH_BLOOM_FREE(tbl) \ +do { \ + uthash_free((tbl)->bloom_bv, HASH_BLOOM_BYTELEN); \ +} while (0) + +#define HASH_BLOOM_BITSET(bv,idx) (bv[(idx)/8U] |= (1U << ((idx)%8U))) +#define HASH_BLOOM_BITTEST(bv,idx) (bv[(idx)/8U] & (1U << ((idx)%8U))) + +#define HASH_BLOOM_ADD(tbl,hashv) \ + HASH_BLOOM_BITSET((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1U))) + +#define HASH_BLOOM_TEST(tbl,hashv) \ + HASH_BLOOM_BITTEST((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1U))) + +#else +#define HASH_BLOOM_MAKE(tbl) +#define HASH_BLOOM_FREE(tbl) +#define HASH_BLOOM_ADD(tbl,hashv) +#define HASH_BLOOM_TEST(tbl,hashv) (1) +#define HASH_BLOOM_BYTELEN 0U +#endif + +#define HASH_MAKE_TABLE(hh,head) \ +do { \ + (head)->hh.tbl = (UT_hash_table*)uthash_malloc( \ + sizeof(UT_hash_table)); \ + if (!((head)->hh.tbl)) { uthash_fatal( "out of memory"); } \ + memset((head)->hh.tbl, 0, sizeof(UT_hash_table)); \ + (head)->hh.tbl->tail = &((head)->hh); \ + (head)->hh.tbl->num_buckets = HASH_INITIAL_NUM_BUCKETS; \ + (head)->hh.tbl->log2_num_buckets = HASH_INITIAL_NUM_BUCKETS_LOG2; \ + (head)->hh.tbl->hho = (char*)(&(head)->hh) - (char*)(head); \ + (head)->hh.tbl->buckets = (UT_hash_bucket*)uthash_malloc( \ + HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \ + if (! (head)->hh.tbl->buckets) { uthash_fatal( "out of memory"); } \ + memset((head)->hh.tbl->buckets, 0, \ + HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \ + HASH_BLOOM_MAKE((head)->hh.tbl); \ + (head)->hh.tbl->signature = HASH_SIGNATURE; \ +} while(0) + +#define HASH_ADD(hh,head,fieldname,keylen_in,add) \ + HASH_ADD_KEYPTR(hh,head,&((add)->fieldname),keylen_in,add) + +#define HASH_REPLACE(hh,head,fieldname,keylen_in,add,replaced) \ +do { \ + replaced=NULL; \ + HASH_FIND(hh,head,&((add)->fieldname),keylen_in,replaced); \ + if (replaced!=NULL) { \ + HASH_DELETE(hh,head,replaced); \ + } \ + HASH_ADD(hh,head,fieldname,keylen_in,add); \ +} while(0) + +#define HASH_ADD_KEYPTR(hh,head,keyptr,keylen_in,add) \ +do { \ + unsigned _ha_bkt; \ + (add)->hh.next = NULL; \ + (add)->hh.key = (char*)(keyptr); \ + (add)->hh.keylen = (unsigned)(keylen_in); \ + if (!(head)) { \ + head = (add); \ + (head)->hh.prev = NULL; \ + HASH_MAKE_TABLE(hh,head); \ + } else { \ + (head)->hh.tbl->tail->next = (add); \ + (add)->hh.prev = ELMT_FROM_HH((head)->hh.tbl, (head)->hh.tbl->tail); \ + (head)->hh.tbl->tail = &((add)->hh); \ + } \ + (head)->hh.tbl->num_items++; \ + (add)->hh.tbl = (head)->hh.tbl; \ + HASH_FCN(keyptr,keylen_in, (head)->hh.tbl->num_buckets, \ + (add)->hh.hashv, _ha_bkt); \ + HASH_ADD_TO_BKT((head)->hh.tbl->buckets[_ha_bkt],&(add)->hh); \ + HASH_BLOOM_ADD((head)->hh.tbl,(add)->hh.hashv); \ + HASH_EMIT_KEY(hh,head,keyptr,keylen_in); \ + HASH_FSCK(hh,head); \ +} while(0) + +#define HASH_TO_BKT( hashv, num_bkts, bkt ) \ +do { \ + bkt = ((hashv) & ((num_bkts) - 1U)); \ +} while(0) + +/* delete "delptr" from the hash table. + * "the usual" patch-up process for the app-order doubly-linked-list. + * The use of _hd_hh_del below deserves special explanation. + * These used to be expressed using (delptr) but that led to a bug + * if someone used the same symbol for the head and deletee, like + * HASH_DELETE(hh,users,users); + * We want that to work, but by changing the head (users) below + * we were forfeiting our ability to further refer to the deletee (users) + * in the patch-up process. Solution: use scratch space to + * copy the deletee pointer, then the latter references are via that + * scratch pointer rather than through the repointed (users) symbol. + */ +#define HASH_DELETE(hh,head,delptr) \ +do { \ + struct UT_hash_handle *_hd_hh_del; \ + if ( ((delptr)->hh.prev == NULL) && ((delptr)->hh.next == NULL) ) { \ + uthash_free((head)->hh.tbl->buckets, \ + (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \ + HASH_BLOOM_FREE((head)->hh.tbl); \ + uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \ + head = NULL; \ + } else { \ + unsigned _hd_bkt; \ + _hd_hh_del = &((delptr)->hh); \ + if ((delptr) == ELMT_FROM_HH((head)->hh.tbl,(head)->hh.tbl->tail)) { \ + (head)->hh.tbl->tail = \ + (UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \ + (head)->hh.tbl->hho); \ + } \ + if ((delptr)->hh.prev != NULL) { \ + ((UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \ + (head)->hh.tbl->hho))->next = (delptr)->hh.next; \ + } else { \ + DECLTYPE_ASSIGN(head,(delptr)->hh.next); \ + } \ + if (_hd_hh_del->next != NULL) { \ + ((UT_hash_handle*)((ptrdiff_t)_hd_hh_del->next + \ + (head)->hh.tbl->hho))->prev = \ + _hd_hh_del->prev; \ + } \ + HASH_TO_BKT( _hd_hh_del->hashv, (head)->hh.tbl->num_buckets, _hd_bkt); \ + HASH_DEL_IN_BKT(hh,(head)->hh.tbl->buckets[_hd_bkt], _hd_hh_del); \ + (head)->hh.tbl->num_items--; \ + } \ + HASH_FSCK(hh,head); \ +} while (0) + + +/* convenience forms of HASH_FIND/HASH_ADD/HASH_DEL */ +#define HASH_FIND_STR(head,findstr,out) \ + HASH_FIND(hh,head,findstr,(unsigned)strlen(findstr),out) +#define HASH_ADD_STR(head,strfield,add) \ + HASH_ADD(hh,head,strfield[0],(unsigned int)strlen(add->strfield),add) +#define HASH_REPLACE_STR(head,strfield,add,replaced) \ + HASH_REPLACE(hh,head,strfield[0],(unsigned)strlen(add->strfield),add,replaced) +#define HASH_FIND_INT(head,findint,out) \ + HASH_FIND(hh,head,findint,sizeof(int),out) +#define HASH_ADD_INT(head,intfield,add) \ + HASH_ADD(hh,head,intfield,sizeof(int),add) +#define HASH_REPLACE_INT(head,intfield,add,replaced) \ + HASH_REPLACE(hh,head,intfield,sizeof(int),add,replaced) +#define HASH_FIND_PTR(head,findptr,out) \ + HASH_FIND(hh,head,findptr,sizeof(void *),out) +#define HASH_ADD_PTR(head,ptrfield,add) \ + HASH_ADD(hh,head,ptrfield,sizeof(void *),add) +#define HASH_REPLACE_PTR(head,ptrfield,add,replaced) \ + HASH_REPLACE(hh,head,ptrfield,sizeof(void *),add,replaced) +#define HASH_DEL(head,delptr) \ + HASH_DELETE(hh,head,delptr) + +/* HASH_FSCK checks hash integrity on every add/delete when HASH_DEBUG is defined. + * This is for uthash developer only; it compiles away if HASH_DEBUG isn't defined. + */ +#ifdef HASH_DEBUG +#define HASH_OOPS(...) do { fprintf(stderr,__VA_ARGS__); exit(-1); } while (0) +#define HASH_FSCK(hh,head) \ +do { \ + struct UT_hash_handle *_thh; \ + if (head) { \ + unsigned _bkt_i; \ + unsigned _count; \ + char *_prev; \ + _count = 0; \ + for( _bkt_i = 0; _bkt_i < (head)->hh.tbl->num_buckets; _bkt_i++) { \ + unsigned _bkt_count = 0; \ + _thh = (head)->hh.tbl->buckets[_bkt_i].hh_head; \ + _prev = NULL; \ + while (_thh) { \ + if (_prev != (char*)(_thh->hh_prev)) { \ + HASH_OOPS("invalid hh_prev %p, actual %p\n", \ + _thh->hh_prev, _prev ); \ + } \ + _bkt_count++; \ + _prev = (char*)(_thh); \ + _thh = _thh->hh_next; \ + } \ + _count += _bkt_count; \ + if ((head)->hh.tbl->buckets[_bkt_i].count != _bkt_count) { \ + HASH_OOPS("invalid bucket count %u, actual %u\n", \ + (head)->hh.tbl->buckets[_bkt_i].count, _bkt_count); \ + } \ + } \ + if (_count != (head)->hh.tbl->num_items) { \ + HASH_OOPS("invalid hh item count %u, actual %u\n", \ + (head)->hh.tbl->num_items, _count ); \ + } \ + /* traverse hh in app order; check next/prev integrity, count */ \ + _count = 0; \ + _prev = NULL; \ + _thh = &(head)->hh; \ + while (_thh) { \ + _count++; \ + if (_prev !=(char*)(_thh->prev)) { \ + HASH_OOPS("invalid prev %p, actual %p\n", \ + _thh->prev, _prev ); \ + } \ + _prev = (char*)ELMT_FROM_HH((head)->hh.tbl, _thh); \ + _thh = ( _thh->next ? (UT_hash_handle*)((char*)(_thh->next) + \ + (head)->hh.tbl->hho) : NULL ); \ + } \ + if (_count != (head)->hh.tbl->num_items) { \ + HASH_OOPS("invalid app item count %u, actual %u\n", \ + (head)->hh.tbl->num_items, _count ); \ + } \ + } \ +} while (0) +#else +#define HASH_FSCK(hh,head) +#endif + +/* When compiled with -DHASH_EMIT_KEYS, length-prefixed keys are emitted to + * the descriptor to which this macro is defined for tuning the hash function. + * The app can #include to get the prototype for write(2). */ +#ifdef HASH_EMIT_KEYS +#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen) \ +do { \ + unsigned _klen = fieldlen; \ + write(HASH_EMIT_KEYS, &_klen, sizeof(_klen)); \ + write(HASH_EMIT_KEYS, keyptr, (unsigned long)fieldlen); \ +} while (0) +#else +#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen) +#endif + +/* default to Jenkin's hash unless overridden e.g. DHASH_FUNCTION=HASH_SAX */ +#ifdef HASH_FUNCTION +#define HASH_FCN HASH_FUNCTION +#else +#define HASH_FCN HASH_JEN +#endif + +/* The Bernstein hash function, used in Perl prior to v5.6. Note (x<<5+x)=x*33. */ +#define HASH_BER(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned _hb_keylen=(unsigned)keylen; \ + const unsigned char *_hb_key=(const unsigned char*)(key); \ + (hashv) = 0; \ + while (_hb_keylen-- != 0U) { \ + (hashv) = (((hashv) << 5) + (hashv)) + *_hb_key++; \ + } \ + bkt = (hashv) & (num_bkts-1U); \ +} while (0) + + +/* SAX/FNV/OAT/JEN hash functions are macro variants of those listed at + * http://eternallyconfuzzled.com/tuts/algorithms/jsw_tut_hashing.aspx */ +#define HASH_SAX(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned _sx_i; \ + const unsigned char *_hs_key=(const unsigned char*)(key); \ + hashv = 0; \ + for(_sx_i=0; _sx_i < keylen; _sx_i++) { \ + hashv ^= (hashv << 5) + (hashv >> 2) + _hs_key[_sx_i]; \ + } \ + bkt = hashv & (num_bkts-1U); \ +} while (0) +/* FNV-1a variation */ +#define HASH_FNV(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned _fn_i; \ + const unsigned char *_hf_key=(const unsigned char*)(key); \ + hashv = 2166136261U; \ + for(_fn_i=0; _fn_i < keylen; _fn_i++) { \ + hashv = hashv ^ _hf_key[_fn_i]; \ + hashv = hashv * 16777619U; \ + } \ + bkt = hashv & (num_bkts-1U); \ +} while(0) + +#define HASH_OAT(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned _ho_i; \ + const unsigned char *_ho_key=(const unsigned char*)(key); \ + hashv = 0; \ + for(_ho_i=0; _ho_i < keylen; _ho_i++) { \ + hashv += _ho_key[_ho_i]; \ + hashv += (hashv << 10); \ + hashv ^= (hashv >> 6); \ + } \ + hashv += (hashv << 3); \ + hashv ^= (hashv >> 11); \ + hashv += (hashv << 15); \ + bkt = hashv & (num_bkts-1U); \ +} while(0) + +#define HASH_JEN_MIX(a,b,c) \ +do { \ + a -= b; a -= c; a ^= ( c >> 13 ); \ + b -= c; b -= a; b ^= ( a << 8 ); \ + c -= a; c -= b; c ^= ( b >> 13 ); \ + a -= b; a -= c; a ^= ( c >> 12 ); \ + b -= c; b -= a; b ^= ( a << 16 ); \ + c -= a; c -= b; c ^= ( b >> 5 ); \ + a -= b; a -= c; a ^= ( c >> 3 ); \ + b -= c; b -= a; b ^= ( a << 10 ); \ + c -= a; c -= b; c ^= ( b >> 15 ); \ +} while (0) + +#define HASH_JEN(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned _hj_i,_hj_j,_hj_k; \ + unsigned const char *_hj_key=(unsigned const char*)(key); \ + hashv = 0xfeedbeefu; \ + _hj_i = _hj_j = 0x9e3779b9u; \ + _hj_k = (unsigned)(keylen); \ + while (_hj_k >= 12U) { \ + _hj_i += (_hj_key[0] + ( (unsigned)_hj_key[1] << 8 ) \ + + ( (unsigned)_hj_key[2] << 16 ) \ + + ( (unsigned)_hj_key[3] << 24 ) ); \ + _hj_j += (_hj_key[4] + ( (unsigned)_hj_key[5] << 8 ) \ + + ( (unsigned)_hj_key[6] << 16 ) \ + + ( (unsigned)_hj_key[7] << 24 ) ); \ + hashv += (_hj_key[8] + ( (unsigned)_hj_key[9] << 8 ) \ + + ( (unsigned)_hj_key[10] << 16 ) \ + + ( (unsigned)_hj_key[11] << 24 ) ); \ + \ + HASH_JEN_MIX(_hj_i, _hj_j, hashv); \ + \ + _hj_key += 12; \ + _hj_k -= 12U; \ + } \ + hashv += (unsigned)(keylen); \ + switch ( _hj_k ) { \ + case 11: hashv += ( (unsigned)_hj_key[10] << 24 ); /* FALLTHROUGH */ \ + case 10: hashv += ( (unsigned)_hj_key[9] << 16 ); /* FALLTHROUGH */ \ + case 9: hashv += ( (unsigned)_hj_key[8] << 8 ); /* FALLTHROUGH */ \ + case 8: _hj_j += ( (unsigned)_hj_key[7] << 24 ); /* FALLTHROUGH */ \ + case 7: _hj_j += ( (unsigned)_hj_key[6] << 16 ); /* FALLTHROUGH */ \ + case 6: _hj_j += ( (unsigned)_hj_key[5] << 8 ); /* FALLTHROUGH */ \ + case 5: _hj_j += _hj_key[4]; /* FALLTHROUGH */ \ + case 4: _hj_i += ( (unsigned)_hj_key[3] << 24 ); /* FALLTHROUGH */ \ + case 3: _hj_i += ( (unsigned)_hj_key[2] << 16 ); /* FALLTHROUGH */ \ + case 2: _hj_i += ( (unsigned)_hj_key[1] << 8 ); /* FALLTHROUGH */ \ + case 1: _hj_i += _hj_key[0]; \ + } \ + HASH_JEN_MIX(_hj_i, _hj_j, hashv); \ + bkt = hashv & (num_bkts-1U); \ +} while(0) + +/* The Paul Hsieh hash function */ +#undef get16bits +#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \ + || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__) +#define get16bits(d) (*((const uint16_t *) (d))) +#endif + +#if !defined (get16bits) +#define get16bits(d) ((((uint32_t)(((const uint8_t *)(d))[1])) << 8) \ + +(uint32_t)(((const uint8_t *)(d))[0]) ) +#endif +#define HASH_SFH(key,keylen,num_bkts,hashv,bkt) \ +do { \ + unsigned const char *_sfh_key=(unsigned const char*)(key); \ + uint32_t _sfh_tmp, _sfh_len = (uint32_t)keylen; \ + \ + unsigned _sfh_rem = _sfh_len & 3U; \ + _sfh_len >>= 2; \ + hashv = 0xcafebabeu; \ + \ + /* Main loop */ \ + for (;_sfh_len > 0U; _sfh_len--) { \ + hashv += get16bits (_sfh_key); \ + _sfh_tmp = ((uint32_t)(get16bits (_sfh_key+2)) << 11) ^ hashv; \ + hashv = (hashv << 16) ^ _sfh_tmp; \ + _sfh_key += 2U*sizeof (uint16_t); \ + hashv += hashv >> 11; \ + } \ + \ + /* Handle end cases */ \ + switch (_sfh_rem) { \ + case 3: hashv += get16bits (_sfh_key); \ + hashv ^= hashv << 16; \ + hashv ^= (uint32_t)(_sfh_key[sizeof (uint16_t)]) << 18; \ + hashv += hashv >> 11; \ + break; \ + case 2: hashv += get16bits (_sfh_key); \ + hashv ^= hashv << 11; \ + hashv += hashv >> 17; \ + break; \ + case 1: hashv += *_sfh_key; \ + hashv ^= hashv << 10; \ + hashv += hashv >> 1; \ + } \ + \ + /* Force "avalanching" of final 127 bits */ \ + hashv ^= hashv << 3; \ + hashv += hashv >> 5; \ + hashv ^= hashv << 4; \ + hashv += hashv >> 17; \ + hashv ^= hashv << 25; \ + hashv += hashv >> 6; \ + bkt = hashv & (num_bkts-1U); \ +} while(0) + +#ifdef HASH_USING_NO_STRICT_ALIASING +/* The MurmurHash exploits some CPU's (x86,x86_64) tolerance for unaligned reads. + * For other types of CPU's (e.g. Sparc) an unaligned read causes a bus error. + * MurmurHash uses the faster approach only on CPU's where we know it's safe. + * + * Note the preprocessor built-in defines can be emitted using: + * + * gcc -m64 -dM -E - < /dev/null (on gcc) + * cc -## a.c (where a.c is a simple test file) (Sun Studio) + */ +#if (defined(__i386__) || defined(__x86_64__) || defined(_M_IX86)) +#define MUR_GETBLOCK(p,i) p[i] +#else /* non intel */ +#define MUR_PLUS0_ALIGNED(p) (((unsigned long)p & 3UL) == 0UL) +#define MUR_PLUS1_ALIGNED(p) (((unsigned long)p & 3UL) == 1UL) +#define MUR_PLUS2_ALIGNED(p) (((unsigned long)p & 3UL) == 2UL) +#define MUR_PLUS3_ALIGNED(p) (((unsigned long)p & 3UL) == 3UL) +#define WP(p) ((uint32_t*)((unsigned long)(p) & ~3UL)) +#if (defined(__BIG_ENDIAN__) || defined(SPARC) || defined(__ppc__) || defined(__ppc64__)) +#define MUR_THREE_ONE(p) ((((*WP(p))&0x00ffffff) << 8) | (((*(WP(p)+1))&0xff000000) >> 24)) +#define MUR_TWO_TWO(p) ((((*WP(p))&0x0000ffff) <<16) | (((*(WP(p)+1))&0xffff0000) >> 16)) +#define MUR_ONE_THREE(p) ((((*WP(p))&0x000000ff) <<24) | (((*(WP(p)+1))&0xffffff00) >> 8)) +#else /* assume little endian non-intel */ +#define MUR_THREE_ONE(p) ((((*WP(p))&0xffffff00) >> 8) | (((*(WP(p)+1))&0x000000ff) << 24)) +#define MUR_TWO_TWO(p) ((((*WP(p))&0xffff0000) >>16) | (((*(WP(p)+1))&0x0000ffff) << 16)) +#define MUR_ONE_THREE(p) ((((*WP(p))&0xff000000) >>24) | (((*(WP(p)+1))&0x00ffffff) << 8)) +#endif +#define MUR_GETBLOCK(p,i) (MUR_PLUS0_ALIGNED(p) ? ((p)[i]) : \ + (MUR_PLUS1_ALIGNED(p) ? MUR_THREE_ONE(p) : \ + (MUR_PLUS2_ALIGNED(p) ? MUR_TWO_TWO(p) : \ + MUR_ONE_THREE(p)))) +#endif +#define MUR_ROTL32(x,r) (((x) << (r)) | ((x) >> (32 - (r)))) +#define MUR_FMIX(_h) \ +do { \ + _h ^= _h >> 16; \ + _h *= 0x85ebca6bu; \ + _h ^= _h >> 13; \ + _h *= 0xc2b2ae35u; \ + _h ^= _h >> 16; \ +} while(0) + +#define HASH_MUR(key,keylen,num_bkts,hashv,bkt) \ +do { \ + const uint8_t *_mur_data = (const uint8_t*)(key); \ + const int _mur_nblocks = (int)(keylen) / 4; \ + uint32_t _mur_h1 = 0xf88D5353u; \ + uint32_t _mur_c1 = 0xcc9e2d51u; \ + uint32_t _mur_c2 = 0x1b873593u; \ + uint32_t _mur_k1 = 0; \ + const uint8_t *_mur_tail; \ + const uint32_t *_mur_blocks = (const uint32_t*)(_mur_data+(_mur_nblocks*4)); \ + int _mur_i; \ + for(_mur_i = -_mur_nblocks; _mur_i!=0; _mur_i++) { \ + _mur_k1 = MUR_GETBLOCK(_mur_blocks,_mur_i); \ + _mur_k1 *= _mur_c1; \ + _mur_k1 = MUR_ROTL32(_mur_k1,15); \ + _mur_k1 *= _mur_c2; \ + \ + _mur_h1 ^= _mur_k1; \ + _mur_h1 = MUR_ROTL32(_mur_h1,13); \ + _mur_h1 = (_mur_h1*5U) + 0xe6546b64u; \ + } \ + _mur_tail = (const uint8_t*)(_mur_data + (_mur_nblocks*4)); \ + _mur_k1=0; \ + switch((keylen) & 3U) { \ + case 3: _mur_k1 ^= (uint32_t)_mur_tail[2] << 16; /* FALLTHROUGH */ \ + case 2: _mur_k1 ^= (uint32_t)_mur_tail[1] << 8; /* FALLTHROUGH */ \ + case 1: _mur_k1 ^= (uint32_t)_mur_tail[0]; \ + _mur_k1 *= _mur_c1; \ + _mur_k1 = MUR_ROTL32(_mur_k1,15); \ + _mur_k1 *= _mur_c2; \ + _mur_h1 ^= _mur_k1; \ + } \ + _mur_h1 ^= (uint32_t)(keylen); \ + MUR_FMIX(_mur_h1); \ + hashv = _mur_h1; \ + bkt = hashv & (num_bkts-1U); \ +} while(0) +#endif /* HASH_USING_NO_STRICT_ALIASING */ + +/* key comparison function; return 0 if keys equal */ +#define HASH_KEYCMP(a,b,len) memcmp(a,b,(unsigned long)(len)) + +/* iterate over items in a known bucket to find desired item */ +#define HASH_FIND_IN_BKT(tbl,hh,head,keyptr,keylen_in,out) \ +do { \ + if (head.hh_head != NULL) { DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,head.hh_head)); } \ + else { out=NULL; } \ + while (out != NULL) { \ + if ((out)->hh.keylen == (keylen_in)) { \ + if ((HASH_KEYCMP((out)->hh.key,keyptr,keylen_in)) == 0) { break; } \ + } \ + if ((out)->hh.hh_next != NULL) { DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,(out)->hh.hh_next)); } \ + else { out = NULL; } \ + } \ +} while(0) + +/* add an item to a bucket */ +#define HASH_ADD_TO_BKT(head,addhh) \ +do { \ + head.count++; \ + (addhh)->hh_next = head.hh_head; \ + (addhh)->hh_prev = NULL; \ + if (head.hh_head != NULL) { (head).hh_head->hh_prev = (addhh); } \ + (head).hh_head=addhh; \ + if ((head.count >= ((head.expand_mult+1U) * HASH_BKT_CAPACITY_THRESH)) \ + && ((addhh)->tbl->noexpand != 1U)) { \ + HASH_EXPAND_BUCKETS((addhh)->tbl); \ + } \ +} while(0) + +/* remove an item from a given bucket */ +#define HASH_DEL_IN_BKT(hh,head,hh_del) \ + (head).count--; \ + if ((head).hh_head == hh_del) { \ + (head).hh_head = hh_del->hh_next; \ + } \ + if (hh_del->hh_prev) { \ + hh_del->hh_prev->hh_next = hh_del->hh_next; \ + } \ + if (hh_del->hh_next) { \ + hh_del->hh_next->hh_prev = hh_del->hh_prev; \ + } + +/* Bucket expansion has the effect of doubling the number of buckets + * and redistributing the items into the new buckets. Ideally the + * items will distribute more or less evenly into the new buckets + * (the extent to which this is true is a measure of the quality of + * the hash function as it applies to the key domain). + * + * With the items distributed into more buckets, the chain length + * (item count) in each bucket is reduced. Thus by expanding buckets + * the hash keeps a bound on the chain length. This bounded chain + * length is the essence of how a hash provides constant time lookup. + * + * The calculation of tbl->ideal_chain_maxlen below deserves some + * explanation. First, keep in mind that we're calculating the ideal + * maximum chain length based on the *new* (doubled) bucket count. + * In fractions this is just n/b (n=number of items,b=new num buckets). + * Since the ideal chain length is an integer, we want to calculate + * ceil(n/b). We don't depend on floating point arithmetic in this + * hash, so to calculate ceil(n/b) with integers we could write + * + * ceil(n/b) = (n/b) + ((n%b)?1:0) + * + * and in fact a previous version of this hash did just that. + * But now we have improved things a bit by recognizing that b is + * always a power of two. We keep its base 2 log handy (call it lb), + * so now we can write this with a bit shift and logical AND: + * + * ceil(n/b) = (n>>lb) + ( (n & (b-1)) ? 1:0) + * + */ +#define HASH_EXPAND_BUCKETS(tbl) \ +do { \ + unsigned _he_bkt; \ + unsigned _he_bkt_i; \ + struct UT_hash_handle *_he_thh, *_he_hh_nxt; \ + UT_hash_bucket *_he_new_buckets, *_he_newbkt; \ + _he_new_buckets = (UT_hash_bucket*)uthash_malloc( \ + 2UL * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \ + if (!_he_new_buckets) { uthash_fatal( "out of memory"); } \ + memset(_he_new_buckets, 0, \ + 2UL * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \ + tbl->ideal_chain_maxlen = \ + (tbl->num_items >> (tbl->log2_num_buckets+1U)) + \ + (((tbl->num_items & ((tbl->num_buckets*2U)-1U)) != 0U) ? 1U : 0U); \ + tbl->nonideal_items = 0; \ + for(_he_bkt_i = 0; _he_bkt_i < tbl->num_buckets; _he_bkt_i++) \ + { \ + _he_thh = tbl->buckets[ _he_bkt_i ].hh_head; \ + while (_he_thh != NULL) { \ + _he_hh_nxt = _he_thh->hh_next; \ + HASH_TO_BKT( _he_thh->hashv, tbl->num_buckets*2U, _he_bkt); \ + _he_newbkt = &(_he_new_buckets[ _he_bkt ]); \ + if (++(_he_newbkt->count) > tbl->ideal_chain_maxlen) { \ + tbl->nonideal_items++; \ + _he_newbkt->expand_mult = _he_newbkt->count / \ + tbl->ideal_chain_maxlen; \ + } \ + _he_thh->hh_prev = NULL; \ + _he_thh->hh_next = _he_newbkt->hh_head; \ + if (_he_newbkt->hh_head != NULL) { _he_newbkt->hh_head->hh_prev = \ + _he_thh; } \ + _he_newbkt->hh_head = _he_thh; \ + _he_thh = _he_hh_nxt; \ + } \ + } \ + uthash_free( tbl->buckets, tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \ + tbl->num_buckets *= 2U; \ + tbl->log2_num_buckets++; \ + tbl->buckets = _he_new_buckets; \ + tbl->ineff_expands = (tbl->nonideal_items > (tbl->num_items >> 1)) ? \ + (tbl->ineff_expands+1U) : 0U; \ + if (tbl->ineff_expands > 1U) { \ + tbl->noexpand=1; \ + uthash_noexpand_fyi(tbl); \ + } \ + uthash_expand_fyi(tbl); \ +} while(0) + + +/* This is an adaptation of Simon Tatham's O(n log(n)) mergesort */ +/* Note that HASH_SORT assumes the hash handle name to be hh. + * HASH_SRT was added to allow the hash handle name to be passed in. */ +#define HASH_SORT(head,cmpfcn) HASH_SRT(hh,head,cmpfcn) +#define HASH_SRT(hh,head,cmpfcn) \ +do { \ + unsigned _hs_i; \ + unsigned _hs_looping,_hs_nmerges,_hs_insize,_hs_psize,_hs_qsize; \ + struct UT_hash_handle *_hs_p, *_hs_q, *_hs_e, *_hs_list, *_hs_tail; \ + if (head != NULL) { \ + _hs_insize = 1; \ + _hs_looping = 1; \ + _hs_list = &((head)->hh); \ + while (_hs_looping != 0U) { \ + _hs_p = _hs_list; \ + _hs_list = NULL; \ + _hs_tail = NULL; \ + _hs_nmerges = 0; \ + while (_hs_p != NULL) { \ + _hs_nmerges++; \ + _hs_q = _hs_p; \ + _hs_psize = 0; \ + for ( _hs_i = 0; _hs_i < _hs_insize; _hs_i++ ) { \ + _hs_psize++; \ + _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ? \ + ((void*)((char*)(_hs_q->next) + \ + (head)->hh.tbl->hho)) : NULL); \ + if (! (_hs_q) ) { break; } \ + } \ + _hs_qsize = _hs_insize; \ + while ((_hs_psize > 0U) || ((_hs_qsize > 0U) && (_hs_q != NULL))) {\ + if (_hs_psize == 0U) { \ + _hs_e = _hs_q; \ + _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ? \ + ((void*)((char*)(_hs_q->next) + \ + (head)->hh.tbl->hho)) : NULL); \ + _hs_qsize--; \ + } else if ( (_hs_qsize == 0U) || (_hs_q == NULL) ) { \ + _hs_e = _hs_p; \ + if (_hs_p != NULL){ \ + _hs_p = (UT_hash_handle*)((_hs_p->next != NULL) ? \ + ((void*)((char*)(_hs_p->next) + \ + (head)->hh.tbl->hho)) : NULL); \ + } \ + _hs_psize--; \ + } else if (( \ + cmpfcn(DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_p)), \ + DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_q))) \ + ) <= 0) { \ + _hs_e = _hs_p; \ + if (_hs_p != NULL){ \ + _hs_p = (UT_hash_handle*)((_hs_p->next != NULL) ? \ + ((void*)((char*)(_hs_p->next) + \ + (head)->hh.tbl->hho)) : NULL); \ + } \ + _hs_psize--; \ + } else { \ + _hs_e = _hs_q; \ + _hs_q = (UT_hash_handle*)((_hs_q->next != NULL) ? \ + ((void*)((char*)(_hs_q->next) + \ + (head)->hh.tbl->hho)) : NULL); \ + _hs_qsize--; \ + } \ + if ( _hs_tail != NULL ) { \ + _hs_tail->next = ((_hs_e != NULL) ? \ + ELMT_FROM_HH((head)->hh.tbl,_hs_e) : NULL); \ + } else { \ + _hs_list = _hs_e; \ + } \ + if (_hs_e != NULL) { \ + _hs_e->prev = ((_hs_tail != NULL) ? \ + ELMT_FROM_HH((head)->hh.tbl,_hs_tail) : NULL); \ + } \ + _hs_tail = _hs_e; \ + } \ + _hs_p = _hs_q; \ + } \ + if (_hs_tail != NULL){ \ + _hs_tail->next = NULL; \ + } \ + if ( _hs_nmerges <= 1U ) { \ + _hs_looping=0; \ + (head)->hh.tbl->tail = _hs_tail; \ + DECLTYPE_ASSIGN(head,ELMT_FROM_HH((head)->hh.tbl, _hs_list)); \ + } \ + _hs_insize *= 2U; \ + } \ + HASH_FSCK(hh,head); \ + } \ +} while (0) + +/* This function selects items from one hash into another hash. + * The end result is that the selected items have dual presence + * in both hashes. There is no copy of the items made; rather + * they are added into the new hash through a secondary hash + * hash handle that must be present in the structure. */ +#define HASH_SELECT(hh_dst, dst, hh_src, src, cond) \ +do { \ + unsigned _src_bkt, _dst_bkt; \ + void *_last_elt=NULL, *_elt; \ + UT_hash_handle *_src_hh, *_dst_hh, *_last_elt_hh=NULL; \ + ptrdiff_t _dst_hho = ((char*)(&(dst)->hh_dst) - (char*)(dst)); \ + if (src != NULL) { \ + for(_src_bkt=0; _src_bkt < (src)->hh_src.tbl->num_buckets; _src_bkt++) { \ + for(_src_hh = (src)->hh_src.tbl->buckets[_src_bkt].hh_head; \ + _src_hh != NULL; \ + _src_hh = _src_hh->hh_next) { \ + _elt = ELMT_FROM_HH((src)->hh_src.tbl, _src_hh); \ + if (cond(_elt)) { \ + _dst_hh = (UT_hash_handle*)(((char*)_elt) + _dst_hho); \ + _dst_hh->key = _src_hh->key; \ + _dst_hh->keylen = _src_hh->keylen; \ + _dst_hh->hashv = _src_hh->hashv; \ + _dst_hh->prev = _last_elt; \ + _dst_hh->next = NULL; \ + if (_last_elt_hh != NULL) { _last_elt_hh->next = _elt; } \ + if (dst == NULL) { \ + DECLTYPE_ASSIGN(dst,_elt); \ + HASH_MAKE_TABLE(hh_dst,dst); \ + } else { \ + _dst_hh->tbl = (dst)->hh_dst.tbl; \ + } \ + HASH_TO_BKT(_dst_hh->hashv, _dst_hh->tbl->num_buckets, _dst_bkt); \ + HASH_ADD_TO_BKT(_dst_hh->tbl->buckets[_dst_bkt],_dst_hh); \ + (dst)->hh_dst.tbl->num_items++; \ + _last_elt = _elt; \ + _last_elt_hh = _dst_hh; \ + } \ + } \ + } \ + } \ + HASH_FSCK(hh_dst,dst); \ +} while (0) + +#define HASH_CLEAR(hh,head) \ +do { \ + if (head != NULL) { \ + uthash_free((head)->hh.tbl->buckets, \ + (head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket)); \ + HASH_BLOOM_FREE((head)->hh.tbl); \ + uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \ + (head)=NULL; \ + } \ +} while(0) + +#define HASH_OVERHEAD(hh,head) \ + ((head != NULL) ? ( \ + (size_t)(((head)->hh.tbl->num_items * sizeof(UT_hash_handle)) + \ + ((head)->hh.tbl->num_buckets * sizeof(UT_hash_bucket)) + \ + sizeof(UT_hash_table) + \ + (HASH_BLOOM_BYTELEN))) : 0U) + +#ifdef NO_DECLTYPE +#define HASH_ITER(hh,head,el,tmp) \ +for(((el)=(head)), ((*(char**)(&(tmp)))=(char*)((head!=NULL)?(head)->hh.next:NULL)); \ + (el) != NULL; ((el)=(tmp)), ((*(char**)(&(tmp)))=(char*)((tmp!=NULL)?(tmp)->hh.next:NULL))) +#else +#define HASH_ITER(hh,head,el,tmp) \ +for(((el)=(head)), ((tmp)=DECLTYPE(el)((head!=NULL)?(head)->hh.next:NULL)); \ + (el) != NULL; ((el)=(tmp)), ((tmp)=DECLTYPE(el)((tmp!=NULL)?(tmp)->hh.next:NULL))) +#endif + +/* obtain a count of items in the hash */ +#define HASH_COUNT(head) HASH_CNT(hh,head) +#define HASH_CNT(hh,head) ((head != NULL)?((head)->hh.tbl->num_items):0U) + +typedef struct UT_hash_bucket { + struct UT_hash_handle *hh_head; + unsigned count; + + /* expand_mult is normally set to 0. In this situation, the max chain length + * threshold is enforced at its default value, HASH_BKT_CAPACITY_THRESH. (If + * the bucket's chain exceeds this length, bucket expansion is triggered). + * However, setting expand_mult to a non-zero value delays bucket expansion + * (that would be triggered by additions to this particular bucket) + * until its chain length reaches a *multiple* of HASH_BKT_CAPACITY_THRESH. + * (The multiplier is simply expand_mult+1). The whole idea of this + * multiplier is to reduce bucket expansions, since they are expensive, in + * situations where we know that a particular bucket tends to be overused. + * It is better to let its chain length grow to a longer yet-still-bounded + * value, than to do an O(n) bucket expansion too often. + */ + unsigned expand_mult; + +} UT_hash_bucket; + +/* random signature used only to find hash tables in external analysis */ +#define HASH_SIGNATURE 0xa0111fe1u +#define HASH_BLOOM_SIGNATURE 0xb12220f2u + +typedef struct UT_hash_table { + UT_hash_bucket *buckets; + unsigned num_buckets, log2_num_buckets; + unsigned num_items; + struct UT_hash_handle *tail; /* tail hh in app order, for fast append */ + ptrdiff_t hho; /* hash handle offset (byte pos of hash handle in element */ + + /* in an ideal situation (all buckets used equally), no bucket would have + * more than ceil(#items/#buckets) items. that's the ideal chain length. */ + unsigned ideal_chain_maxlen; + + /* nonideal_items is the number of items in the hash whose chain position + * exceeds the ideal chain maxlen. these items pay the penalty for an uneven + * hash distribution; reaching them in a chain traversal takes >ideal steps */ + unsigned nonideal_items; + + /* ineffective expands occur when a bucket doubling was performed, but + * afterward, more than half the items in the hash had nonideal chain + * positions. If this happens on two consecutive expansions we inhibit any + * further expansion, as it's not helping; this happens when the hash + * function isn't a good fit for the key domain. When expansion is inhibited + * the hash will still work, albeit no longer in constant time. */ + unsigned ineff_expands, noexpand; + + uint32_t signature; /* used only to find hash tables in external analysis */ +#ifdef HASH_BLOOM + uint32_t bloom_sig; /* used only to test bloom exists in external analysis */ + uint8_t *bloom_bv; + uint8_t bloom_nbits; +#endif + +} UT_hash_table; + +typedef struct UT_hash_handle { + struct UT_hash_table *tbl; + void *prev; /* prev element in app order */ + void *next; /* next element in app order */ + struct UT_hash_handle *hh_prev; /* previous hh in bucket order */ + struct UT_hash_handle *hh_next; /* next hh in bucket order */ + void *key; /* ptr to enclosing struct's key */ + unsigned keylen; /* enclosing struct's key len */ + unsigned hashv; /* result of hash-fcn(key) */ +} UT_hash_handle; + +#endif /* UTHASH_H */ diff --git a/src/c/urweb.c b/src/c/urweb.c index 53344c5e..e0fd503c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -22,6 +22,8 @@ #include "types.h" +#include "uthash.h" + uw_unit uw_unit_v = 0; @@ -4494,3 +4496,148 @@ int uw_remoteSock(uw_context ctx) { void uw_set_remoteSock(uw_context ctx, int sock) { ctx->remoteSock = sock; } + + +// Sqlcache + +void listDelete(CacheList *list, CacheEntry *entry) { + if (list->first == entry) { + list->first = entry->next; + } + if (list->last == entry) { + list->last = entry->prev; + } + if (entry->prev) { + entry->prev->next = entry->next; + } + if (entry->next) { + entry->next->prev = entry->prev; + } + entry->prev = NULL; + entry->next = NULL; + --(list->size); +} + +void listAdd(CacheList *list, CacheEntry *entry) { + if (list->last) { + list->last->next = entry; + entry->prev = list->last; + list->last = entry; + } else { + list->first = entry; + list->last = entry; + } + ++(list->size); +} + +void listBump(CacheList *list, CacheEntry *entry) { + listDelete(list, entry); + listAdd(list, entry); +} + +// TODO: deal with time properly. + +time_t getTimeNow() { + return time(NULL); +} + +time_t timeMax(time_t x, time_t y) { + return difftime(x, y) > 0 ? x : y; +} + +void freeCacheValue(CacheValue *value) { + if (value) { + free(value->result); + free(value->output); + free(value); + } +} + +void delete(Cache *cache, CacheEntry* entry) { + //listDelete(cache->lru, entry); + HASH_DELETE(hh, cache->table, entry); + freeCacheValue(entry->value); + free(entry->key); + free(entry); +} + +CacheValue *checkHelper(Cache *cache, char **keys, int timeInvalid) { + char *key = keys[cache->height]; + CacheEntry *entry; + HASH_FIND(hh, cache->table, key, strlen(key), entry); + timeInvalid = timeMax(timeInvalid, cache->timeInvalid); + if (entry && difftime(entry->timeValid, timeInvalid) > 0) { + if (cache->height == 0) { + // At height 0, entry->value is the desired value. + //listBump(cache->lru, entry); + return entry->value; + } else { + // At height n+1, entry->value is a pointer to a cache at heignt n. + return checkHelper(entry->value, keys, timeInvalid); + } + } else { + return NULL; + } +} + +CacheValue *check(Cache *cache, char **keys) { + return checkHelper(cache, keys, 0); +} + +void storeHelper(Cache *cache, char **keys, CacheValue *value, int timeNow) { + CacheEntry *entry; + char *key = keys[cache->height]; + HASH_FIND(hh, cache->table, key, strlen(key), entry); + if (!entry) { + entry = malloc(sizeof(CacheEntry)); + entry->key = strdup(key); + entry->value = NULL; + HASH_ADD_KEYPTR(hh, cache->table, entry->key, strlen(entry->key), entry); + } + entry->timeValid = timeNow; + if (cache->height == 0) { + //listAdd(cache->lru, entry); + freeCacheValue(entry->value); + entry->value = value; + //if (cache->lru->size > MAX_SIZE) { + //delete(cache, cache->lru->first); + // TODO: return flushed value. + //} + } else { + if (!entry->value) { + Cache *newCache = malloc(sizeof(Cache)); + newCache->table = NULL; + newCache->timeInvalid = timeNow; + newCache->lru = cache->lru; + newCache->height = cache->height - 1; + entry->value = newCache; + } + storeHelper(entry->value, keys, value, timeNow); + } +} + +void store(Cache *cache, char **keys, CacheValue *value) { + storeHelper(cache, keys, value, getTimeNow()); +} + +void flushHelper(Cache *cache, char **keys, int timeNow) { + CacheEntry *entry; + char *key = keys[cache->height]; + if (key) { + HASH_FIND(hh, cache->table, key, strlen(key), entry); + if (entry) { + if (cache->height == 0) { + delete(cache, entry); + } else { + flushHelper(entry->value, keys, timeNow); + } + } + } else { + // Null key means invalidate the entire subtree. + cache->timeInvalid = timeNow; + } +} + +void flush(Cache *cache, char **keys) { + flushHelper(cache, keys, getTimeNow()); +} diff --git a/src/lru_cache.sml b/src/lru_cache.sml new file mode 100644 index 00000000..87e939fa --- /dev/null +++ b/src/lru_cache.sml @@ -0,0 +1,171 @@ +structure LruCache : sig + val cache : Cache.cache +end = struct + + +(* Mono *) + +open Mono + +val dummyLoc = ErrorMsg.dummySpan +val stringTyp = (TFfi ("Basis", "string"), dummyLoc) +val optionStringTyp = (TOption stringTyp, dummyLoc) +fun withTyp typ = map (fn exp => (exp, typ)) + +fun ffiAppCache' (func, index, argTyps) = + EFfiApp ("Sqlcache", func ^ Int.toString index, argTyps) + +fun check (index, keys) = + ffiAppCache' ("check", index, withTyp stringTyp keys) + +fun store (index, keys, value) = + ffiAppCache' ("store", index, (value, stringTyp) :: withTyp stringTyp keys) + +fun flush (index, keys) = + ffiAppCache' ("flush", index, withTyp optionStringTyp keys) + + +(* Cjr *) + +open Print +open Print.PD + +fun setupQuery {index, params} = + let + + val i = Int.toString index + + fun paramRepeat itemi sep = + let + fun f n = + if n < 0 then "" + else if n = 0 then itemi (Int.toString 0) + else f (n-1) ^ sep ^ itemi (Int.toString n) + in + f (params - 1) + end + + fun paramRepeatRev itemi sep = + let + fun f n = + if n < 0 then "" + else if n = 0 then itemi (Int.toString 0) + else itemi (Int.toString n) ^ sep ^ f (n-1) + in + f (params - 1) + end + + fun paramRepeatInit itemi sep = + if params = 0 then "" else sep ^ paramRepeat itemi sep + + val typedArgs = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", " + + val revArgs = paramRepeatRev (fn p => "p" ^ p) ", " + + in + Print.box + [string ("static Cache cacheStruct" ^ i ^ " = {"), + newline, + string " .table = NULL,", + newline, + string " .timeInvalid = 0,", + newline, + string " .lru = NULL,", + newline, + string (" .height = " ^ Int.toString (params - 1) ^ "};"), + newline, + string ("static Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), + newline, + newline, + + string ("static uw_Basis_string uw_Sqlcache_check" ^ i), + string ("(uw_context ctx" ^ typedArgs ^ ") {"), + newline, + string (" char *ks[] = {" ^ revArgs ^ "};"), + newline, + string (" CacheValue *v = check(cache" ^ i ^ ", ks);"), + newline, + string " if (v) {", + newline, + string (" puts(\"SQLCACHE: hit " ^ i ^ ".\");"), + newline, + string " uw_write(ctx, v->output);", + newline, + string " return v->result;", + newline, + string " } else {", + newline, + string (" puts(\"SQLCACHE: miss " ^ i ^ ".\");"), + newline, + string " uw_recordingStart(ctx);", + newline, + string " return NULL;", + newline, + string " }", + newline, + string "}", + newline, + newline, + + string ("static uw_unit uw_Sqlcache_store" ^ i), + string ("(uw_context ctx, uw_Basis_string s" ^ typedArgs ^ ") {"), + newline, + string (" char *ks[] = {" ^ revArgs ^ "};"), + newline, + string (" CacheValue *v = malloc(sizeof(CacheValue));"), + newline, + string " v->result = strdup(s);", + newline, + string " v->output = uw_recordingRead(ctx);", + newline, + string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), + newline, + string (" store(cache" ^ i ^ ", ks, v);"), + newline, + string " return uw_unit_v;", + newline, + string "}", + newline, + newline, + + string ("static uw_unit uw_Sqlcache_flush" ^ i), + string ("(uw_context ctx" ^ typedArgs ^ ") {"), + newline, + string (" char *ks[] = {" ^ revArgs ^ "};"), + newline, + string (" flush(cache" ^ i ^ ", ks);"), + newline, + string " return uw_unit_v;", + newline, + string "}", + newline, + newline] + end + +val setupGlobal = string "/* No global setup for LRU cache. */" + + +(* Bundled up. *) + +(* For now, use the toy implementation if there are no arguments. *) +fun toyIfNoKeys numKeys implLru implToy args = + if numKeys args = 0 + then implToy args + else implLru args + +val cache = + let + val {check = toyCheck, + store = toyStore, + flush = toyFlush, + setupQuery = toySetupQuery, + ...} = ToyCache.cache + in + {check = toyIfNoKeys (length o #2) check toyCheck, + store = toyIfNoKeys (length o #2) store toyStore, + flush = toyIfNoKeys (length o #2) flush toyFlush, + setupQuery = toyIfNoKeys #params setupQuery toySetupQuery, + setupGlobal = setupGlobal} + end + +end diff --git a/src/sources b/src/sources index aaf640ca..0608d710 100644 --- a/src/sources +++ b/src/sources @@ -177,6 +177,7 @@ $(SRC)/multimap_fn.sml $(SRC)/cache.sml $(SRC)/toy_cache.sml +$(SRC)/lru_cache.sml $(SRC)/sqlcache.sig $(SRC)/sqlcache.sml diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 3082904c..bf9ee77a 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -39,7 +39,7 @@ val ffiEffectful = andalso not (m = "Basis" andalso SS.member (fs, f)) end -val cache = ref ToyCache.cache +val cache = ref LruCache.cache fun setCache c = cache := c fun getCache () = !cache @@ -52,8 +52,8 @@ fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : exp -> false, then expression is definitely not effectful if effs is fully populated. The intended pattern is to use this a number of times equal to the number of declarations in a file, Bellman-Ford style. *) - (* TODO: make incrementing of bound less janky, probably by using [MonoUtil] - instead of all this. *) + (* TODO: make incrementing of the number of bound variables cleaner, + probably by using [MonoUtil] instead of all this. *) let (* DEBUG: remove printing when done. *) fun tru msg = if doPrint then (print (msg ^ "\n"); true) else true @@ -138,14 +138,14 @@ val effectfulMap = (* Boolean formula normalization. *) -datatype normalForm = Cnf | Dnf +datatype junctionType = Conj | Disj datatype 'atom formula = Atom of 'atom | Negate of 'atom formula - | Combo of normalForm * 'atom formula list + | Combo of junctionType * 'atom formula list -val flipNf = fn Cnf => Dnf | Dnf => Cnf +val flipJt = fn Conj => Disj | Disj => Conj fun bind xs f = List.concat (map f xs) @@ -158,7 +158,7 @@ val rec cartesianProduct : 'a list list -> 'a list list = fun pushNegate (negate : 'atom -> 'atom) (negating : bool) = fn Atom x => Atom (if negating then negate x else x) | Negate f => pushNegate negate (not negating) f - | Combo (n, fs) => Combo (if negating then flipNf n else n, map (pushNegate negate negating) fs) + | Combo (n, fs) => Combo (if negating then flipJt n else n, map (pushNegate negate negating) fs) val rec flatten = fn Combo (n, fs) => @@ -170,17 +170,17 @@ val rec flatten = (map flatten fs)) | f => f -fun normalize' (negate : 'atom -> 'atom) (norm : normalForm) = +fun normalize' (negate : 'atom -> 'atom) (junc : junctionType) = fn Atom x => [[x]] - | Negate f => map (map negate) (normalize' negate (flipNf norm) f) - | Combo (n, fs) => + | Negate f => map (map negate) (normalize' negate (flipJt junc) f) + | Combo (j, fs) => let - val fss = bind fs (normalize' negate n) + val fss = bind fs (normalize' negate j) in - if n = norm then fss else cartesianProduct fss + if j = junc then fss else cartesianProduct fss end -fun normalize negate norm = normalize' negate norm o flatten o pushNegate negate false +fun normalize negate junc = normalize' negate junc o flatten o pushNegate negate false fun mapFormula mf = fn Atom x => Atom (mf x) @@ -200,36 +200,29 @@ datatype atomExp = | Prim of Prim.t | Field of string * string -val equalAtomExp = - let - val isEqual = fn EQUAL => true | _ => false - in - fn (QueryArg n1, QueryArg n2) => n1 = n2 - | (DmlRel n1, DmlRel n2) => n1 = n2 - | (Prim p1, Prim p2) => isEqual (Prim.compare (p1, p2)) - | (Field (t1, f1), Field (t2, f2)) => isEqual (String.compare (t1 ^ "." ^ f1, t2 ^ "." ^ f2)) - | _ => false - end - structure AtomExpKey : ORD_KEY = struct -type ord_key = atomExp - -val compare = - fn (QueryArg n1, QueryArg n2) => Int.compare (n1, n2) - | (QueryArg _, _) => LESS - | (_, QueryArg _) => GREATER - | (DmlRel n1, DmlRel n2) => Int.compare (n1, n2) - | (DmlRel _, _) => LESS - | (_, DmlRel _) => GREATER - | (Prim p1, Prim p2) => Prim.compare (p1, p2) - | (Prim _, _) => LESS - | (_, Prim _) => GREATER - | (Field (t1, f1), Field (t2, f2)) => String.compare (t1 ^ "." ^ f1, t2 ^ "." ^ f2) + type ord_key = atomExp + + val compare = + fn (QueryArg n1, QueryArg n2) => Int.compare (n1, n2) + | (QueryArg _, _) => LESS + | (_, QueryArg _) => GREATER + | (DmlRel n1, DmlRel n2) => Int.compare (n1, n2) + | (DmlRel _, _) => LESS + | (_, DmlRel _) => GREATER + | (Prim p1, Prim p2) => Prim.compare (p1, p2) + | (Prim _, _) => LESS + | (_, Prim _) => GREATER + | (Field (t1, f1), Field (t2, f2)) => + case String.compare (t1, t2) of + EQUAL => String.compare (f1, f2) + | ord => ord end structure UF = UnionFindFn(AtomExpKey) + val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula * (Sql.cmp * Sql.sqexp * Sql.sqexp) formula -> atomExp IM.map list = @@ -246,7 +239,9 @@ val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula o List.mapPartial toKnownEquality fun addToEqs (eqs, n, e) = case IM.find (eqs, n) of - (* Comparing to a constant seems better? *) + (* Comparing to a constant is probably better than comparing to + a variable? Checking that an existing constant matches a new + one is handled by [accumulateEqs]. *) SOME (Prim _) => eqs | _ => IM.insert (eqs, n, e) val accumulateEqs = @@ -263,6 +258,9 @@ val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula (* TODO: deal with equalities involving just [DmlRel]s and [Prim]s. This would involve guarding the invalidation with a check for the relevant comparisons. *) + (* DEBUG: remove these print statements. *) + (* | ((DmlRel r, Prim p), eqso) => (print ("sadness " ^ Int.toString r ^ " = " ^ Prim.toString p ^ "\n"); eqso) *) + (* | ((Prim p, DmlRel r), eqso) => (print ("sadness " ^ Int.toString r ^ " = " ^ Prim.toString p ^ "\n"); eqso) *) | (_, eqso) => eqso val eqsOfClass : atomExp list -> atomExp IM.map option = List.foldl accumulateEqs (SOME IM.empty) @@ -275,7 +273,8 @@ val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula | Sql.Field tf => SOME (Field tf) | Sql.Inj (EPrim p, _) => SOME (Prim p) | Sql.Inj (ERel n, _) => SOME (rel n) - (* We can't deal with anything else. *) + (* We can't deal with anything else, e.g., CURRENT_TIMESTAMP + becomes Sql.Unmodeled, which becomes NONE here. *) | _ => NONE in (cmp, qa e1, qa e2) @@ -302,17 +301,17 @@ val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula List.foldr (fn (SOME eqs, SOME acc) => SOME (IM.unionWith #1 (eqs, acc)) | _ => NONE) (SOME IM.empty) fun dnf (fQuery, fDml) = - normalize negateCmp Dnf (Combo (Cnf, [markQuery fQuery, markDml fDml])) + normalize negateCmp Disj (Combo (Conj, [markQuery fQuery, markDml fDml])) in List.mapPartial (mergeEqs o map eqsOfClass o equivClasses) o dnf end val rec sqexpToFormula = - fn Sql.SqTrue => Combo (Cnf, []) - | Sql.SqFalse => Combo (Dnf, []) + fn Sql.SqTrue => Combo (Conj, []) + | Sql.SqFalse => Combo (Disj, []) | Sql.SqNot e => Negate (sqexpToFormula e) | Sql.Binop (Sql.RCmp c, e1, e2) => Atom (c, e1, e2) - | Sql.Binop (Sql.RLop l, p1, p2) => Combo (case l of Sql.And => Cnf | Sql.Or => Dnf, + | Sql.Binop (Sql.RLop l, p1, p2) => Combo (case l of Sql.And => Conj | Sql.Or => Disj, [sqexpToFormula p1, sqexpToFormula p2]) (* ASK: any other sqexps that can be props? *) | _ => raise Match @@ -332,13 +331,13 @@ fun renameTables tablePairs = end val rec queryToFormula = - fn Sql.Query1 {Where = NONE, ...} => Combo (Cnf, []) + fn Sql.Query1 {Where = NONE, ...} => Combo (Conj, []) | Sql.Query1 {From = tablePairs, Where = SOME e, ...} => renameTables tablePairs (sqexpToFormula e) - | Sql.Union (q1, q2) => Combo (Dnf, [queryToFormula q1, queryToFormula q2]) + | Sql.Union (q1, q2) => Combo (Disj, [queryToFormula q1, queryToFormula q2]) fun valsToFormula (table, vals) = - Combo (Cnf, map (fn (field, v) => Atom (Sql.Eq, Sql.Field (table, field), v)) vals) + Combo (Conj, map (fn (field, v) => Atom (Sql.Eq, Sql.Field (table, field), v)) vals) val rec dmlToFormula = fn Sql.Insert (table, vals) => valsToFormula (table, vals) @@ -354,8 +353,8 @@ val rec dmlToFormula = val mark = mapFormula (fn (cmp, e1, e2) => (cmp, markField e1, markField e2)) in renameTables [(table, "T")] - (Combo (Dnf, [Combo (Cnf, [fVals, mark fWhere]), - Combo (Cnf, [mark fVals, fWhere])])) + (Combo (Disj, [Combo (Conj, [fVals, mark fWhere]), + Combo (Conj, [mark fVals, fWhere])])) end val rec tablesQuery = @@ -370,6 +369,13 @@ val tableDml = (* Program instrumentation. *) +val varName = + let + val varNumber = ref 0 + in + fn s => (varNumber := !varNumber + 1; s ^ Int.toString (!varNumber)) + end + val {check, store, flush, ...} = getCache () val dummyLoc = ErrorMsg.dummySpan @@ -412,8 +418,8 @@ fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = in ECase (check, [((PNone stringTyp, loc), - (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), - ((PSome (stringTyp, (PVar ("hit", stringTyp), loc)), loc), + (ELet (varName "q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), + ((PSome (stringTyp, (PVar (varName "hit", stringTyp), loc)), loc), (* Boolean is false because we're not unurlifying from a cookie. *) (EUnurlify (rel0, resultTyp, false), loc))], {disc = stringTyp, result = resultTyp}) @@ -454,7 +460,7 @@ fun factorOutNontrivial text = chunks fun wrapLets e' = (* Important that this is foldl (to oppose foldr above). *) - List.foldl (fn (v, e') => ELet ("sqlArg", stringTyp, v, (e', loc))) + List.foldl (fn (v, e') => ELet (varName "sqlArg", stringTyp, v, (e', loc))) e' newVariables val numArgs = length newVariables @@ -482,6 +488,7 @@ fun addChecking file = exps = exps}, dummyLoc) val (EQuery {query = queryText, ...}, _) = queryExp + (* DEBUG: we can remove the following line at some point. *) val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty queryText)) val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc)) fun bind x f = Option.mapPartial f x @@ -530,9 +537,11 @@ fun invalidations ((query, numArgs), dml) = (* Tests if [ys] makes [xs] a redundant cache invalidation. [NONE] here represents unknown, which means a wider invalidation. *) val rec madeRedundantBy : atomExp option list * atomExp option list -> bool = - fn ([], []) => true + fn ([], []) => (print "hey!\n"; true) | (NONE :: xs, _ :: ys) => madeRedundantBy (xs, ys) - | (SOME x :: xs, SOME y :: ys) => equalAtomExp (x, y) andalso madeRedundantBy (xs, ys) + | (SOME x :: xs, SOME y :: ys) => (case AtomExpKey.compare (x, y) of + EQUAL => madeRedundantBy (xs, ys) + | _ => false) | _ => false fun removeRedundant' (xss, yss) = case xss of -- cgit v1.2.3 From bc38beafd07b7ae6106a2fffda82084a08af7f06 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sun, 19 Jul 2015 19:03:11 -0700 Subject: Rename C functions and remove functors nested inside modules. --- include/urweb/types_cpp.h | 28 ++++++++--------- include/urweb/urweb_cpp.h | 6 ++-- src/c/urweb.c | 78 +++++++++++++++++++++++------------------------ src/lru_cache.sml | 12 ++++---- src/option_key_fn.sml | 11 +++++++ src/sources | 3 +- src/sqlcache.sml | 30 +----------------- src/triple_key_fn.sml | 15 +++++++++ 8 files changed, 91 insertions(+), 92 deletions(-) create mode 100644 src/option_key_fn.sml create mode 100644 src/triple_key_fn.sml (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 2f154e1f..7b9a90a4 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -123,31 +123,31 @@ typedef struct { #include "uthash.h" -typedef struct CacheValue { +typedef struct uw_sqlcache_CacheValue { char *result; char *output; -} CacheValue; +} uw_sqlcache_CacheValue; -typedef struct CacheEntry { +typedef struct uw_sqlcache_CacheEntry { char *key; void *value; time_t timeValid; - struct CacheEntry *prev; - struct CacheEntry *next; + struct uw_sqlcache_CacheEntry *prev; + struct uw_sqlcache_CacheEntry *next; UT_hash_handle hh; -} CacheEntry; +} uw_sqlcache_CacheEntry; -typedef struct CacheList { - CacheEntry *first; - CacheEntry *last; +typedef struct uw_sqlcache_CacheList { + uw_sqlcache_CacheEntry *first; + uw_sqlcache_CacheEntry *last; int size; -} CacheList; +} uw_sqlcache_CacheList; -typedef struct Cache { - CacheEntry *table; +typedef struct uw_sqlcache_Cache { + uw_sqlcache_CacheEntry *table; time_t timeInvalid; - CacheList *lru; + uw_sqlcache_CacheList *lru; int height; -} Cache; +} uw_sqlcache_Cache; #endif diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 3ae5b69e..3fac7041 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -406,8 +406,8 @@ void uw_Basis_writec(struct uw_context *, char); #include "uthash.h" -CacheValue *check(Cache *, char **); -CacheValue *store(Cache *, char **, CacheValue *); -CacheValue *flush(Cache *, char **); +uw_sqlcache_CacheValue *uw_sqlcache_check(uw_sqlcache_Cache *, char **); +uw_sqlcache_CacheValue *uw_sqlcache_store(uw_sqlcache_Cache *, char **, uw_sqlcache_CacheValue *); +uw_sqlcache_CacheValue *uw_sqlcache_flush(uw_sqlcache_Cache *, char **); #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index e0fd503c..3993448b 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4500,7 +4500,7 @@ void uw_set_remoteSock(uw_context ctx, int sock) { // Sqlcache -void listDelete(CacheList *list, CacheEntry *entry) { +void uw_sqlcache_listDelete(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { if (list->first == entry) { list->first = entry->next; } @@ -4518,7 +4518,7 @@ void listDelete(CacheList *list, CacheEntry *entry) { --(list->size); } -void listAdd(CacheList *list, CacheEntry *entry) { +void uw_sqlcache_listAdd(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { if (list->last) { list->last->next = entry; entry->prev = list->last; @@ -4530,22 +4530,22 @@ void listAdd(CacheList *list, CacheEntry *entry) { ++(list->size); } -void listBump(CacheList *list, CacheEntry *entry) { - listDelete(list, entry); - listAdd(list, entry); +void uw_sqlcache_listBump(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { + uw_sqlcache_listDelete(list, entry); + uw_sqlcache_listAdd(list, entry); } // TODO: deal with time properly. -time_t getTimeNow() { +time_t uw_sqlcache_getTimeNow() { return time(NULL); } -time_t timeMax(time_t x, time_t y) { +time_t uw_sqlcache_timeMax(time_t x, time_t y) { return difftime(x, y) > 0 ? x : y; } -void freeCacheValue(CacheValue *value) { +void uw_sqlcache_freeuw_sqlcache_CacheValue(uw_sqlcache_CacheValue *value) { if (value) { free(value->result); free(value->output); @@ -4553,83 +4553,83 @@ void freeCacheValue(CacheValue *value) { } } -void delete(Cache *cache, CacheEntry* entry) { - //listDelete(cache->lru, entry); +void uw_sqlcache_delete(uw_sqlcache_Cache *cache, uw_sqlcache_CacheEntry* entry) { + //uw_sqlcache_listUw_Sqlcache_Delete(cache->lru, entry); HASH_DELETE(hh, cache->table, entry); - freeCacheValue(entry->value); + uw_sqlcache_freeuw_sqlcache_CacheValue(entry->value); free(entry->key); free(entry); } -CacheValue *checkHelper(Cache *cache, char **keys, int timeInvalid) { +uw_sqlcache_CacheValue *uw_sqlcache_checkHelper(uw_sqlcache_Cache *cache, char **keys, int timeInvalid) { char *key = keys[cache->height]; - CacheEntry *entry; + uw_sqlcache_CacheEntry *entry; HASH_FIND(hh, cache->table, key, strlen(key), entry); - timeInvalid = timeMax(timeInvalid, cache->timeInvalid); + timeInvalid = uw_sqlcache_timeMax(timeInvalid, cache->timeInvalid); if (entry && difftime(entry->timeValid, timeInvalid) > 0) { if (cache->height == 0) { // At height 0, entry->value is the desired value. - //listBump(cache->lru, entry); + //uw_sqlcache_listBump(cache->lru, entry); return entry->value; } else { // At height n+1, entry->value is a pointer to a cache at heignt n. - return checkHelper(entry->value, keys, timeInvalid); + return uw_sqlcache_checkHelper(entry->value, keys, timeInvalid); } } else { return NULL; } } -CacheValue *check(Cache *cache, char **keys) { - return checkHelper(cache, keys, 0); +uw_sqlcache_CacheValue *uw_sqlcache_check(uw_sqlcache_Cache *cache, char **keys) { + return uw_sqlcache_checkHelper(cache, keys, 0); } -void storeHelper(Cache *cache, char **keys, CacheValue *value, int timeNow) { - CacheEntry *entry; +void uw_sqlcache_storeHelper(uw_sqlcache_Cache *cache, char **keys, uw_sqlcache_CacheValue *value, int timeNow) { + uw_sqlcache_CacheEntry *entry; char *key = keys[cache->height]; HASH_FIND(hh, cache->table, key, strlen(key), entry); if (!entry) { - entry = malloc(sizeof(CacheEntry)); + entry = malloc(sizeof(uw_sqlcache_CacheEntry)); entry->key = strdup(key); entry->value = NULL; HASH_ADD_KEYPTR(hh, cache->table, entry->key, strlen(entry->key), entry); } entry->timeValid = timeNow; if (cache->height == 0) { - //listAdd(cache->lru, entry); - freeCacheValue(entry->value); + //uw_sqlcache_listAdd(cache->lru, entry); + uw_sqlcache_freeuw_sqlcache_CacheValue(entry->value); entry->value = value; //if (cache->lru->size > MAX_SIZE) { - //delete(cache, cache->lru->first); + //uw_sqlcache_delete(cache, cache->lru->first); // TODO: return flushed value. //} } else { if (!entry->value) { - Cache *newCache = malloc(sizeof(Cache)); - newCache->table = NULL; - newCache->timeInvalid = timeNow; - newCache->lru = cache->lru; - newCache->height = cache->height - 1; - entry->value = newCache; + uw_sqlcache_Cache *newuw_sqlcache_Cache = malloc(sizeof(uw_sqlcache_Cache)); + newuw_sqlcache_Cache->table = NULL; + newuw_sqlcache_Cache->timeInvalid = timeNow; + newuw_sqlcache_Cache->lru = cache->lru; + newuw_sqlcache_Cache->height = cache->height - 1; + entry->value = newuw_sqlcache_Cache; } - storeHelper(entry->value, keys, value, timeNow); + uw_sqlcache_storeHelper(entry->value, keys, value, timeNow); } } -void store(Cache *cache, char **keys, CacheValue *value) { - storeHelper(cache, keys, value, getTimeNow()); +void uw_sqlcache_store(uw_sqlcache_Cache *cache, char **keys, uw_sqlcache_CacheValue *value) { + uw_sqlcache_storeHelper(cache, keys, value, uw_sqlcache_getTimeNow()); } -void flushHelper(Cache *cache, char **keys, int timeNow) { - CacheEntry *entry; +void uw_sqlcache_flushHelper(uw_sqlcache_Cache *cache, char **keys, int timeNow) { + uw_sqlcache_CacheEntry *entry; char *key = keys[cache->height]; if (key) { HASH_FIND(hh, cache->table, key, strlen(key), entry); if (entry) { if (cache->height == 0) { - delete(cache, entry); + uw_sqlcache_delete(cache, entry); } else { - flushHelper(entry->value, keys, timeNow); + uw_sqlcache_flushHelper(entry->value, keys, timeNow); } } } else { @@ -4638,6 +4638,6 @@ void flushHelper(Cache *cache, char **keys, int timeNow) { } } -void flush(Cache *cache, char **keys) { - flushHelper(cache, keys, getTimeNow()); +void uw_sqlcache_flush(uw_sqlcache_Cache *cache, char **keys) { + uw_sqlcache_flushHelper(cache, keys, uw_sqlcache_getTimeNow()); } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 87e939fa..26590312 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -64,7 +64,7 @@ fun setupQuery {index, params} = in Print.box - [string ("static Cache cacheStruct" ^ i ^ " = {"), + [string ("static uw_sqlcache_Cache cacheStruct" ^ i ^ " = {"), newline, string " .table = NULL,", newline, @@ -74,7 +74,7 @@ fun setupQuery {index, params} = newline, string (" .height = " ^ Int.toString (params - 1) ^ "};"), newline, - string ("static Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), + string ("static uw_sqlcache_Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), newline, newline, @@ -83,7 +83,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" CacheValue *v = check(cache" ^ i ^ ", ks);"), + string (" uw_sqlcache_CacheValue *v = uw_sqlcache_check(cache" ^ i ^ ", ks);"), newline, string " if (v) {", newline, @@ -112,7 +112,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" CacheValue *v = malloc(sizeof(CacheValue));"), + string (" uw_sqlcache_CacheValue *v = malloc(sizeof(uw_sqlcache_CacheValue));"), newline, string " v->result = strdup(s);", newline, @@ -120,7 +120,7 @@ fun setupQuery {index, params} = newline, string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline, - string (" store(cache" ^ i ^ ", ks, v);"), + string (" uw_sqlcache_store(cache" ^ i ^ ", ks, v);"), newline, string " return uw_unit_v;", newline, @@ -133,7 +133,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" flush(cache" ^ i ^ ", ks);"), + string (" uw_sqlcache_flush(cache" ^ i ^ ", ks);"), newline, string " return uw_unit_v;", newline, diff --git a/src/option_key_fn.sml b/src/option_key_fn.sml new file mode 100644 index 00000000..ba636d4e --- /dev/null +++ b/src/option_key_fn.sml @@ -0,0 +1,11 @@ +functor OptionKeyFn(K : ORD_KEY) : ORD_KEY = struct + +type ord_key = K.ord_key option + +val compare = + fn (NONE, NONE) => EQUAL + | (NONE, _) => LESS + | (_, NONE) => GREATER + | (SOME x, SOME y) => K.compare (x, y) + +end diff --git a/src/sources b/src/sources index 0608d710..f0914bdf 100644 --- a/src/sources +++ b/src/sources @@ -172,8 +172,9 @@ $(SRC)/sql.sig $(SRC)/sql.sml $(SRC)/union_find_fn.sml - $(SRC)/multimap_fn.sml +$(SRC)/option_key_fn.sml +$(SRC)/triple_key_fn.sml $(SRC)/cache.sml $(SRC)/toy_cache.sml diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 5f737ac5..ff58ef77 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -207,7 +207,7 @@ fun mapFormula mf = (* SQL analysis. *) -structure CmpKey : ORD_KEY = struct +structure CmpKey = struct type ord_key = Sql.cmp @@ -247,34 +247,6 @@ functor ListKeyFn (K : ORD_KEY) : ORD_KEY = struct end *) -functor OptionKeyFn (K : ORD_KEY) : ORD_KEY = struct - - type ord_key = K.ord_key option - - val compare = - fn (NONE, NONE) => EQUAL - | (NONE, _) => LESS - | (_, NONE) => GREATER - | (SOME x, SOME y) => K.compare (x, y) - -end - -functor TripleKeyFn (structure I : ORD_KEY - structure J : ORD_KEY - structure K : ORD_KEY) - : ORD_KEY where type ord_key = I.ord_key * J.ord_key * K.ord_key = struct - - type ord_key = I.ord_key * J.ord_key * K.ord_key - - fun compare ((i1, j1, k1), (i2, j2, k2)) = - case I.compare (i1, i2) of - EQUAL => (case J.compare (j1, j2) of - EQUAL => K.compare (k1, k2) - | ord => ord) - | ord => ord - -end - val rec chooseTwos : 'a list -> ('a * 'a) list = fn [] => [] | x :: ys => map (fn y => (x, y)) ys @ chooseTwos ys diff --git a/src/triple_key_fn.sml b/src/triple_key_fn.sml new file mode 100644 index 00000000..ba77c60b --- /dev/null +++ b/src/triple_key_fn.sml @@ -0,0 +1,15 @@ +functor TripleKeyFn (structure I : ORD_KEY + structure J : ORD_KEY + structure K : ORD_KEY) + : ORD_KEY where type ord_key = I.ord_key * J.ord_key * K.ord_key = struct + +type ord_key = I.ord_key * J.ord_key * K.ord_key + +fun compare ((i1, j1, k1), (i2, j2, k2)) = + case I.compare (i1, i2) of + EQUAL => (case J.compare (j1, j2) of + EQUAL => K.compare (k1, k2) + | ord => ord) + | ord => ord + +end -- cgit v1.2.3 From 46fe4e62ddefd8f79f4a29f7a273f585436d3c85 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sun, 13 Sep 2015 16:02:45 -0400 Subject: Start work on pure expression caching. --- include/urweb/types_cpp.h | 28 ++++---- include/urweb/urweb_cpp.h | 6 +- src/c/openssl.c | 4 +- src/c/urweb.c | 78 ++++++++++----------- src/lru_cache.sml | 12 ++-- src/sqlcache.sml | 174 +++++++++++++++++++++++++++++++++++++++++----- 6 files changed, 221 insertions(+), 81 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 7b9a90a4..84423105 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -123,31 +123,31 @@ typedef struct { #include "uthash.h" -typedef struct uw_sqlcache_CacheValue { +typedef struct uw_Sqlcache_CacheValue { char *result; char *output; -} uw_sqlcache_CacheValue; +} uw_Sqlcache_CacheValue; -typedef struct uw_sqlcache_CacheEntry { +typedef struct uw_Sqlcache_CacheEntry { char *key; void *value; time_t timeValid; - struct uw_sqlcache_CacheEntry *prev; - struct uw_sqlcache_CacheEntry *next; + struct uw_Sqlcache_CacheEntry *prev; + struct uw_Sqlcache_CacheEntry *next; UT_hash_handle hh; -} uw_sqlcache_CacheEntry; +} uw_Sqlcache_CacheEntry; -typedef struct uw_sqlcache_CacheList { - uw_sqlcache_CacheEntry *first; - uw_sqlcache_CacheEntry *last; +typedef struct uw_Sqlcache_CacheList { + uw_Sqlcache_CacheEntry *first; + uw_Sqlcache_CacheEntry *last; int size; -} uw_sqlcache_CacheList; +} uw_Sqlcache_CacheList; -typedef struct uw_sqlcache_Cache { - uw_sqlcache_CacheEntry *table; +typedef struct uw_Sqlcache_Cache { + uw_Sqlcache_CacheEntry *table; time_t timeInvalid; - uw_sqlcache_CacheList *lru; + uw_Sqlcache_CacheList *lru; int height; -} uw_sqlcache_Cache; +} uw_Sqlcache_Cache; #endif diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 3fac7041..05e3e4a0 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -406,8 +406,8 @@ void uw_Basis_writec(struct uw_context *, char); #include "uthash.h" -uw_sqlcache_CacheValue *uw_sqlcache_check(uw_sqlcache_Cache *, char **); -uw_sqlcache_CacheValue *uw_sqlcache_store(uw_sqlcache_Cache *, char **, uw_sqlcache_CacheValue *); -uw_sqlcache_CacheValue *uw_sqlcache_flush(uw_sqlcache_Cache *, char **); +uw_Sqlcache_CacheValue *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **); +uw_Sqlcache_CacheValue *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, uw_Sqlcache_CacheValue *); +uw_Sqlcache_CacheValue *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **); #endif diff --git a/src/c/openssl.c b/src/c/openssl.c index 6d018707..533c3e21 100644 --- a/src/c/openssl.c +++ b/src/c/openssl.c @@ -35,7 +35,7 @@ static void random_password() { // OpenSSL callbacks static void thread_id(CRYPTO_THREADID *const result) { - CRYPTO_THREADID_set_numeric(result, pthread_self()); + CRYPTO_THREADID_set_numeric(result, (unsigned long)pthread_self()); } static void lock_or_unlock(const int mode, const int type, const char *file, const int line) { @@ -73,7 +73,7 @@ void uw_init_crypto() { if (access(uw_sig_file, F_OK)) { random_password(); - + if ((fd = open(uw_sig_file, O_WRONLY | O_CREAT, 0700)) < 0) { fprintf(stderr, "Can't open signature file %s\n", uw_sig_file); perror("open"); diff --git a/src/c/urweb.c b/src/c/urweb.c index 66fedfa2..61742693 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4498,7 +4498,7 @@ void uw_set_remoteSock(uw_context ctx, int sock) { // Sqlcache -void uw_sqlcache_listDelete(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { +void uw_Sqlcache_listDelete(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { if (list->first == entry) { list->first = entry->next; } @@ -4516,7 +4516,7 @@ void uw_sqlcache_listDelete(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry --(list->size); } -void uw_sqlcache_listAdd(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { +void uw_Sqlcache_listAdd(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { if (list->last) { list->last->next = entry; entry->prev = list->last; @@ -4528,22 +4528,22 @@ void uw_sqlcache_listAdd(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *en ++(list->size); } -void uw_sqlcache_listBump(uw_sqlcache_CacheList *list, uw_sqlcache_CacheEntry *entry) { - uw_sqlcache_listDelete(list, entry); - uw_sqlcache_listAdd(list, entry); +void uw_Sqlcache_listBump(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { + uw_Sqlcache_listDelete(list, entry); + uw_Sqlcache_listAdd(list, entry); } // TODO: deal with time properly. -time_t uw_sqlcache_getTimeNow() { +time_t uw_Sqlcache_getTimeNow() { return time(NULL); } -time_t uw_sqlcache_timeMax(time_t x, time_t y) { +time_t uw_Sqlcache_timeMax(time_t x, time_t y) { return difftime(x, y) > 0 ? x : y; } -void uw_sqlcache_freeuw_sqlcache_CacheValue(uw_sqlcache_CacheValue *value) { +void uw_Sqlcache_freeuw_Sqlcache_CacheValue(uw_Sqlcache_CacheValue *value) { if (value) { free(value->result); free(value->output); @@ -4551,83 +4551,83 @@ void uw_sqlcache_freeuw_sqlcache_CacheValue(uw_sqlcache_CacheValue *value) { } } -void uw_sqlcache_delete(uw_sqlcache_Cache *cache, uw_sqlcache_CacheEntry* entry) { - //uw_sqlcache_listUw_Sqlcache_Delete(cache->lru, entry); +void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_CacheEntry* entry) { + //uw_Sqlcache_listUw_Sqlcache_Delete(cache->lru, entry); HASH_DELETE(hh, cache->table, entry); - uw_sqlcache_freeuw_sqlcache_CacheValue(entry->value); + uw_Sqlcache_freeuw_Sqlcache_CacheValue(entry->value); free(entry->key); free(entry); } -uw_sqlcache_CacheValue *uw_sqlcache_checkHelper(uw_sqlcache_Cache *cache, char **keys, int timeInvalid) { +uw_Sqlcache_CacheValue *uw_Sqlcache_checkHelper(uw_Sqlcache_Cache *cache, char **keys, int timeInvalid) { char *key = keys[cache->height]; - uw_sqlcache_CacheEntry *entry; + uw_Sqlcache_CacheEntry *entry; HASH_FIND(hh, cache->table, key, strlen(key), entry); - timeInvalid = uw_sqlcache_timeMax(timeInvalid, cache->timeInvalid); + timeInvalid = uw_Sqlcache_timeMax(timeInvalid, cache->timeInvalid); if (entry && difftime(entry->timeValid, timeInvalid) > 0) { if (cache->height == 0) { // At height 0, entry->value is the desired value. - //uw_sqlcache_listBump(cache->lru, entry); + //uw_Sqlcache_listBump(cache->lru, entry); return entry->value; } else { // At height n+1, entry->value is a pointer to a cache at heignt n. - return uw_sqlcache_checkHelper(entry->value, keys, timeInvalid); + return uw_Sqlcache_checkHelper(entry->value, keys, timeInvalid); } } else { return NULL; } } -uw_sqlcache_CacheValue *uw_sqlcache_check(uw_sqlcache_Cache *cache, char **keys) { - return uw_sqlcache_checkHelper(cache, keys, 0); +uw_Sqlcache_CacheValue *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { + return uw_Sqlcache_checkHelper(cache, keys, 0); } -void uw_sqlcache_storeHelper(uw_sqlcache_Cache *cache, char **keys, uw_sqlcache_CacheValue *value, int timeNow) { - uw_sqlcache_CacheEntry *entry; +void uw_Sqlcache_storeHelper(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_CacheValue *value, int timeNow) { + uw_Sqlcache_CacheEntry *entry; char *key = keys[cache->height]; HASH_FIND(hh, cache->table, key, strlen(key), entry); if (!entry) { - entry = malloc(sizeof(uw_sqlcache_CacheEntry)); + entry = malloc(sizeof(uw_Sqlcache_CacheEntry)); entry->key = strdup(key); entry->value = NULL; HASH_ADD_KEYPTR(hh, cache->table, entry->key, strlen(entry->key), entry); } entry->timeValid = timeNow; if (cache->height == 0) { - //uw_sqlcache_listAdd(cache->lru, entry); - uw_sqlcache_freeuw_sqlcache_CacheValue(entry->value); + //uw_Sqlcache_listAdd(cache->lru, entry); + uw_Sqlcache_freeuw_Sqlcache_CacheValue(entry->value); entry->value = value; //if (cache->lru->size > MAX_SIZE) { - //uw_sqlcache_delete(cache, cache->lru->first); + //uw_Sqlcache_delete(cache, cache->lru->first); // TODO: return flushed value. //} } else { if (!entry->value) { - uw_sqlcache_Cache *newuw_sqlcache_Cache = malloc(sizeof(uw_sqlcache_Cache)); - newuw_sqlcache_Cache->table = NULL; - newuw_sqlcache_Cache->timeInvalid = timeNow; - newuw_sqlcache_Cache->lru = cache->lru; - newuw_sqlcache_Cache->height = cache->height - 1; - entry->value = newuw_sqlcache_Cache; + uw_Sqlcache_Cache *newuw_Sqlcache_Cache = malloc(sizeof(uw_Sqlcache_Cache)); + newuw_Sqlcache_Cache->table = NULL; + newuw_Sqlcache_Cache->timeInvalid = timeNow; + newuw_Sqlcache_Cache->lru = cache->lru; + newuw_Sqlcache_Cache->height = cache->height - 1; + entry->value = newuw_Sqlcache_Cache; } - uw_sqlcache_storeHelper(entry->value, keys, value, timeNow); + uw_Sqlcache_storeHelper(entry->value, keys, value, timeNow); } } -void uw_sqlcache_store(uw_sqlcache_Cache *cache, char **keys, uw_sqlcache_CacheValue *value) { - uw_sqlcache_storeHelper(cache, keys, value, uw_sqlcache_getTimeNow()); +void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_CacheValue *value) { + uw_Sqlcache_storeHelper(cache, keys, value, uw_Sqlcache_getTimeNow()); } -void uw_sqlcache_flushHelper(uw_sqlcache_Cache *cache, char **keys, int timeNow) { - uw_sqlcache_CacheEntry *entry; +void uw_Sqlcache_flushHelper(uw_Sqlcache_Cache *cache, char **keys, int timeNow) { + uw_Sqlcache_CacheEntry *entry; char *key = keys[cache->height]; if (key) { HASH_FIND(hh, cache->table, key, strlen(key), entry); if (entry) { if (cache->height == 0) { - uw_sqlcache_delete(cache, entry); + uw_Sqlcache_delete(cache, entry); } else { - uw_sqlcache_flushHelper(entry->value, keys, timeNow); + uw_Sqlcache_flushHelper(entry->value, keys, timeNow); } } } else { @@ -4636,6 +4636,6 @@ void uw_sqlcache_flushHelper(uw_sqlcache_Cache *cache, char **keys, int timeNow) } } -void uw_sqlcache_flush(uw_sqlcache_Cache *cache, char **keys) { - uw_sqlcache_flushHelper(cache, keys, uw_sqlcache_getTimeNow()); +void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys) { + uw_Sqlcache_flushHelper(cache, keys, uw_Sqlcache_getTimeNow()); } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 26590312..0030777f 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -64,7 +64,7 @@ fun setupQuery {index, params} = in Print.box - [string ("static uw_sqlcache_Cache cacheStruct" ^ i ^ " = {"), + [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), newline, string " .table = NULL,", newline, @@ -74,7 +74,7 @@ fun setupQuery {index, params} = newline, string (" .height = " ^ Int.toString (params - 1) ^ "};"), newline, - string ("static uw_sqlcache_Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), + string ("static uw_Sqlcache_Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), newline, newline, @@ -83,7 +83,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_sqlcache_CacheValue *v = uw_sqlcache_check(cache" ^ i ^ ", ks);"), + string (" uw_Sqlcache_CacheValue *v = uw_Sqlcache_check(cache" ^ i ^ ", ks);"), newline, string " if (v) {", newline, @@ -112,7 +112,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_sqlcache_CacheValue *v = malloc(sizeof(uw_sqlcache_CacheValue));"), + string (" uw_Sqlcache_CacheValue *v = malloc(sizeof(uw_Sqlcache_CacheValue));"), newline, string " v->result = strdup(s);", newline, @@ -120,7 +120,7 @@ fun setupQuery {index, params} = newline, string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline, - string (" uw_sqlcache_store(cache" ^ i ^ ", ks, v);"), + string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, v);"), newline, string " return uw_unit_v;", newline, @@ -133,7 +133,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_sqlcache_flush(cache" ^ i ^ ", ks);"), + string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks);"), newline, string " return uw_unit_v;", newline, diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 8fae15eb..8efe999c 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -1,4 +1,4 @@ -structure Sqlcache (* DEBUG: add back :> SQLCACHE. *) = struct +structure Sqlcache :> SQLCACHE = struct open Mono @@ -9,6 +9,12 @@ structure SS = BinarySetFn(SK) structure SM = BinaryMapFn(SK) structure SIMM = MultimapFn(structure KeyMap = SM structure ValSet = IS) +fun iterate f n x = if n < 0 + then raise Fail "Can't iterate function negative number of times." + else if n = 0 + then x + else iterate f (n-1) (f x) + (* Filled in by [cacheWrap] during [Sqlcache]. *) val ffiInfo : {index : int, params : int} list ref = ref [] @@ -36,7 +42,7 @@ val ffiEffectful = "urlifyChannel_w"] in fn (m, f) => Settings.isEffectful (m, f) - andalso not (m = "Basis" andalso SS.member (fs, f)) + orelse not (m = "Basis" andalso SS.member (fs, f)) end val cache = ref LruCache.cache @@ -45,8 +51,8 @@ fun getCache () = !cache (* Used to have type context for local variables in MonoUtil functions. *) val doBind = - fn (ctx, MonoUtil.Exp.RelE (_, t)) => t :: ctx - | (ctx, _) => ctx + fn (env, MonoUtil.Exp.RelE (s, t)) => MonoEnv.pushERel env s t NONE + | (env, _) => env (*******************) @@ -59,12 +65,12 @@ fun effectful (effs : IS.set) = val isFunction = fn (TFun _, _) => true | _ => false - fun doExp (ctx, e) = + fun doExp (env, e) = case e of EPrim _ => false (* For now: variables of function type might be effectful, but others are fully evaluated and are therefore not effectful. *) - | ERel n => isFunction (List.nth (ctx, n)) + | ERel n => isFunction (#2 (MonoEnv.lookupERel env n)) | ENamed n => IS.member (effs, n) | EFfi (m, f) => ffiEffectful (m, f) | EFfiApp (m, f, _) => ffiEffectful (m, f) @@ -84,9 +90,8 @@ fun effectful (effs : IS.set) = | EWrite _ => false | ESeq _ => false | ELet _ => false - (* ASK: what should we do about closures? *) - | EClosure _ => false | EUnurlify _ => false + (* ASK: what should we do about closures? *) (* Everything else is some sort of effect. We could flip this and explicitly list bits of Mono that are effectful, but this is conservatively robust to future changes (however unlikely). *) @@ -99,7 +104,7 @@ fun effectful (effs : IS.set) = fun effectfulDecls (decls, _) = let fun doVal ((_, name, _, e, _), effs) = - if effectful effs [] e + if effectful effs MonoEnv.empty e then IS.add (effs, name) else effs val doDecl = @@ -362,9 +367,9 @@ structure ConflictMaps = struct val markDml : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula -> (Sql.cmp * atomExp option * atomExp option) formula = mapFormula (toAtomExps DmlRel) + (* No eqs should have key conflicts because no variable is in two equivalence classes, so the [#1] could be [#2]. *) - val mergeEqs : (atomExp IntBinaryMap.map option list -> atomExp IntBinaryMap.map option) = List.foldr (fn (SOME eqs, SOME acc) => SOME (IM.unionWith #1 (eqs, acc)) | _ => NONE) @@ -511,10 +516,10 @@ fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = fun fileMapfold doExp file start = case MonoUtil.File.mapfoldB {typ = Search.return2, - exp = fn ctx => fn e' => fn s => Search.Continue (doExp ctx e' s), + exp = fn env => fn e' => fn s => Search.Continue (doExp env e' s), decl = fn _ => Search.return2, bind = doBind} - [] file start of + MonoEnv.empty file start of Search.Continue x => x | Search.Return _ => raise Match @@ -556,8 +561,9 @@ fun factorOutNontrivial text = fun addChecking file = let - fun doExp ctx (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = + fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = fn e' as EQuery {query = origQueryText, + (* ASK: could this get messed up by inlining? *) sqlcacheInfo = urlifiedRel0, state = resultTyp, initial, body, tables, exps} => @@ -581,10 +587,14 @@ fun addChecking file = fun guard b x = if b then x else NONE val effs = effectfulDecls file (* We use dummyTyp here. I think this is okay because databases - don't store (effectful) functions, but there could be some - corner case I missed. *) + don't store (effectful) functions, but perhaps there's some + pathalogical corner case missing.... *) fun safe bound = - not o effectful effs (List.tabulate (bound, fn _ => dummyTyp) @ ctx) + not + o effectful effs + (iterate (fn env => MonoEnv.pushERel env "_" dummyTyp NONE) + bound + env) val attempt = (* Ziv misses Haskell's do notation.... *) guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) ( @@ -602,7 +612,7 @@ fun addChecking file = end | e' => (e', queryInfo) in - fileMapfold (fn ctx => fn exp => fn state => doExp ctx state exp) + fileMapfold (fn env => fn exp => fn state => doExp env state exp) file (SIMM.empty, IM.empty, 0) end @@ -716,4 +726,134 @@ fun go file = file' end + +(**********************) +(* Mono Type Checking *) +(**********************) + +val typOfPrim = + fn Prim.Int _ => TFfi ("Basis", "int") + | Prim.Float _ => TFfi ("Basis", "int") + +fun typOfExp' (env : MonoEnv.env) : exp' -> typ option = + fn EPrim p => SOME (TFfi ("Basis", case p of + Prim.Int _ => "int" + | Prim.Float _ => "double" + | Prim.String _ => "string" + | Prim.Char _ => "char"), + dummyLoc) + | ERel n => SOME (#2 (MonoEnv.lookupERel env n)) + | ENamed n => SOME (#2 (MonoEnv.lookupENamed env n)) + (* ASK: okay to make a new [ref] each time? *) + | ECon (dk, PConVar nCon, _) => + let + val (_, _, nData) = MonoEnv.lookupConstructor env nCon + val (_, cs) = MonoEnv.lookupDatatype env nData + in + SOME (TDatatype (nData, ref (dk, cs)), dummyLoc) + end + | ECon (_, PConFfi {mod = s, datatyp, ...}, _) => SOME (TFfi (s, datatyp), dummyLoc) + | ENone t => SOME (TOption t, dummyLoc) + | ESome (t, _) => SOME (TOption t, dummyLoc) + | EFfi _ => NONE + | EFfiApp _ => NONE + | EApp (e1, e2) => (case typOfExp env e1 of + SOME (TFun (_, t), _) => SOME t + | _ => NONE) + | EAbs (_, t1, t2, _) => SOME (TFun (t1, t2), dummyLoc) + (* ASK: is this right? *) + | EUnop (unop, e) => (case unop of + "!" => SOME (TFfi ("Basis", "bool"), dummyLoc) + | "-" => typOfExp env e + | _ => NONE) + (* ASK: how should this (and other "=> NONE" cases) work? *) + | EBinop _ => NONE + | ERecord fields => SOME (TRecord (map (fn (s, _, t) => (s, t)) fields), dummyLoc) + | EField (e, s) => (case typOfExp env e of + SOME (TRecord fields, _) => + (case List.find (fn (s', _) => s = s') fields of + SOME (_, t) => SOME t + | _ => NONE) + | _ => NONE) + | ECase (_, _, {result, ...}) => SOME result + | EStrcat _ => SOME (TFfi ("Basis", "string"), dummyLoc) + | EWrite _ => SOME (TRecord [], dummyLoc) + | ESeq (_, e) => typOfExp env e + | ELet (s, t, e1, e2) => typOfExp (MonoEnv.pushERel env s t (SOME e1)) e2 + | EClosure _ => NONE + | EUnurlify (_, t, _) => SOME t + +and typOfExp env (e', loc) = typOfExp' env e' + + +(*******************************) +(* Caching Pure Subexpressions *) +(*******************************) + +datatype subexp = Pure of unit -> exp | Impure of exp + +val isImpure = + fn Pure _ => false + | Impure _ => true + +val expOfSubexp = + fn Pure f => f () + | Impure e => e + +val makeCache : MonoEnv.env -> exp' -> exp' = fn _ => fn _ => raise Fail "TODO" + +fun pureCache (effs : IS.set) (env : MonoEnv.env) (exp as (exp', loc)) : subexp = + let + fun wrapBindN f (args : (MonoEnv.env * exp) list) = + let + val subexps = map (fn (env, exp) => pureCache effs env exp) args + in + if List.exists isImpure subexps + then Impure (f (map expOfSubexp subexps), loc) + else Pure (fn () => (makeCache env (f (map #2 args)), loc)) + end + fun wrapBind1 f arg = + wrapBindN (fn [arg] => f arg | _ => raise Match) [arg] + fun wrapBind2 f (arg1, arg2) = + wrapBindN (fn [arg1, arg2] => f (arg1, arg2) | _ => raise Match) [arg1, arg2] + fun wrapN f es = wrapBindN f (map (fn e => (env, e)) es) + fun wrap1 f e = wrapBind1 f (env, e) + fun wrap2 f (e1, e2) = wrapBind2 f ((env, e1), (env, e2)) + in + case exp' of + ECon (dk, pc, SOME e) => wrap1 (fn e => ECon (dk, pc, SOME e)) e + | ESome (t, e) => wrap1 (fn e => ESome (t, e)) e + | EFfiApp (s1, s2, args) => + wrapN (fn es => EFfiApp (s1, s2, ListPair.map (fn (e, (_, t)) => (e, t)) (es, args))) + (map #1 args) + | EApp (e1, e2) => wrap2 EApp (e1, e2) + | EAbs (s, t1, t2, e) => + wrapBind1 (fn e => EAbs (s, t1, t2, e)) + (MonoEnv.pushERel env s t1 NONE, e) + | EUnop (s, e) => wrap1 (fn e => EUnop (s, e)) e + | EBinop (bi, s, e1, e2) => wrap2 (fn (e1, e2) => EBinop (bi, s, e1, e2)) (e1, e2) + | ERecord fields => + wrapN (fn es => ERecord (ListPair.map (fn (e, (s, _, t)) => (s, e, t)) (es, fields))) + (map #2 fields) + | EField (e, s) => wrap1 (fn e => EField (e, s)) e + | ECase (e, cases, {disc, result}) => + wrapBindN (fn (e::es) => + ECase (e, + (ListPair.map (fn (e, (p, _)) => (p, e)) (es, cases)), + {disc = disc, result = result})) + ((env, e) :: map (fn (p, e) => (MonoEnv.patBinds env p, e)) cases) + | EStrcat (e1, e2) => wrap2 EStrcat (e1, e2) + (* We record page writes, so they're cachable. *) + | EWrite e => wrap1 EWrite e + | ESeq (e1, e2) => wrap2 ESeq (e1, e2) + | ELet (s, t, e1, e2) => + wrapBind2 (fn (e1, e2) => ELet (s, t, e1, e2)) + ((env, e1), (MonoEnv.pushERel env s t (SOME e1), e2)) + (* ASK: | EClosure (n, es) => ? *) + | EUnurlify (e, t, b) => wrap1 (fn e => EUnurlify (e, t, b)) e + | _ => if effectful effs env exp + then Impure exp + else Pure (fn () => (makeCache env exp', loc)) + end + end -- cgit v1.2.3 From 013ea39e9f187efbb0e3a613264a1c7adfebe692 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Wed, 7 Oct 2015 08:58:08 -0400 Subject: Fix recording bugs to do with nesting and buffer reallocation. Stop MonoFooify printing spurious errors. --- src/c/urweb.c | 26 +++++++++---- src/lru_cache.sml | 3 +- src/mono_fooify.sml | 75 +++++++++++++++++++++--------------- src/sqlcache.sml | 107 +++++++++++++++++++++++++++++++--------------------- src/toy_cache.sml | 16 ++++++-- 5 files changed, 141 insertions(+), 86 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 61742693..957f158c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -72,6 +72,9 @@ void uw_buffer_free(uw_buffer *b) { void uw_buffer_reset(uw_buffer *b) { b->front = b->start; + if (b->front != b->back) { + *b->front = 0; + } } int uw_buffer_check(uw_buffer *b, size_t extra) { @@ -486,7 +489,8 @@ struct uw_context { size_t output_buffer_size; // For caching. - char *recording; + int numRecording; + int recordingOffset; int remoteSock; }; @@ -572,7 +576,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->output_buffer = malloc(1); ctx->output_buffer_size = 1; - ctx->recording = 0; + ctx->numRecording = 0; + ctx->recordingOffset = 0; ctx->remoteSock = -1; @@ -1689,11 +1694,18 @@ void uw_write(uw_context ctx, const char* s) { } void uw_recordingStart(uw_context ctx) { - ctx->recording = ctx->page.front; + if (ctx->numRecording++ == 0) { + ctx->recordingOffset = ctx->page.front - ctx->page.start; + } } char *uw_recordingRead(uw_context ctx) { - return strdup(ctx->recording); + // Only the outermost recorder can read unless the recording is empty. + char *recording = ctx->page.start + ctx->recordingOffset; + if (--ctx->numRecording > 0 && recording != ctx->page.front) { + return NULL; + } + return strdup(recording); } char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) { @@ -4543,7 +4555,7 @@ time_t uw_Sqlcache_timeMax(time_t x, time_t y) { return difftime(x, y) > 0 ? x : y; } -void uw_Sqlcache_freeuw_Sqlcache_CacheValue(uw_Sqlcache_CacheValue *value) { +void uw_Sqlcache_free(uw_Sqlcache_CacheValue *value) { if (value) { free(value->result); free(value->output); @@ -4554,7 +4566,7 @@ void uw_Sqlcache_freeuw_Sqlcache_CacheValue(uw_Sqlcache_CacheValue *value) { void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_CacheEntry* entry) { //uw_Sqlcache_listUw_Sqlcache_Delete(cache->lru, entry); HASH_DELETE(hh, cache->table, entry); - uw_Sqlcache_freeuw_Sqlcache_CacheValue(entry->value); + uw_Sqlcache_free(entry->value); free(entry->key); free(entry); } @@ -4595,7 +4607,7 @@ void uw_Sqlcache_storeHelper(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_ entry->timeValid = timeNow; if (cache->height == 0) { //uw_Sqlcache_listAdd(cache->lru, entry); - uw_Sqlcache_freeuw_Sqlcache_CacheValue(entry->value); + uw_Sqlcache_free(entry->value); entry->value = value; //if (cache->lru->size > MAX_SIZE) { //uw_Sqlcache_delete(cache, cache->lru->first); diff --git a/src/lru_cache.sml b/src/lru_cache.sml index b8dfde5e..275c3061 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -91,7 +91,8 @@ fun setupQuery {index, params} = newline, string (" uw_Sqlcache_CacheValue *v = uw_Sqlcache_check(cache" ^ i ^ ", ks);"), newline, - string " if (v) {", + (* If the output is null, it means we had too much recursion, so it's a miss. *) + string " if (v && v->output != NULL) {", newline, string (" puts(\"SQLCACHE: hit " ^ i ^ ".\");"), newline, diff --git a/src/mono_fooify.sml b/src/mono_fooify.sml index b7d0b6c6..bbd34b15 100644 --- a/src/mono_fooify.sml +++ b/src/mono_fooify.sml @@ -127,9 +127,13 @@ fun capitalize s = structure E = ErrorMsg +exception TypeMismatch of Fm.t * E.span +exception CantPass of Fm.t * typ +exception DontKnow of Fm.t * typ + val dummyExp = (EPrim (Prim.Int 0), E.dummySpan) -fun fooifyExp fk lookupENamed lookupDatatype = +fun fooifyExpWithExceptions fk lookupENamed lookupDatatype = let fun fooify fm (e, tAll as (t, loc)) = case #1 e of @@ -155,8 +159,7 @@ fun fooifyExp fk lookupENamed lookupDatatype = arg'), loc)), loc), fm) end - | _ => (E.errorAt loc "Type mismatch encoding attribute"; - (e, fm)) + | _ => raise TypeMismatch (fm, loc) in attrify (args, ft, (EPrim (Prim.String (Prim.Normal, Settings.getUrlPrefix () ^ s)), loc), fm) end @@ -165,10 +168,8 @@ fun fooifyExp fk lookupENamed lookupDatatype = TFfi ("Basis", "unit") => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) | TFfi (m, x) => (if Settings.mayClientToServer (m, x) (* TODO: better error message. (Then again, user should never see this.) *) - then () - else (E.errorAt loc "MonoFooify: can't pass type from client to server"; - Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]); - ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm)) + then ((EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm) + else raise CantPass (fm, tAll)) | TRecord [] => ((EPrim (Prim.String (Prim.Normal, "")), loc), fm) | TRecord ((x, t) :: xts) => @@ -291,38 +292,50 @@ fun fooifyExp fk lookupENamed lookupDatatype = ((EApp ((ENamed n, loc), e), loc), fm) end - | _ => (E.errorAt loc "Don't know how to encode attribute/URL type"; - Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]; - (dummyExp, fm)) + | _ => raise DontKnow (fm, tAll) in fooify end +fun fooifyExp fk lookupENamed lookupDatatype fm exp = + fooifyExpWithExceptions fk lookupENamed lookupDatatype fm exp + handle TypeMismatch (fm, loc) => + (E.errorAt loc "Type mismatch encoding attribute"; + (dummyExp, fm)) + | CantPass (fm, typ as (_, loc)) => + (E.errorAt loc "MonoFooify: can't pass type from client to server"; + Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty typ)]; + (dummyExp, fm)) + | DontKnow (fm, typ as (_, loc)) => + (E.errorAt loc "Don't know how to encode attribute/URL type"; + Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty typ)]; + (dummyExp, fm)) + + (* Has to be set at the end of [Monoize]. *) val canonicalFm = ref (Fm.empty 0 : Fm.t) fun urlify env expTyp = - if ErrorMsg.anyErrors () - then ((* DEBUG *) print "already error"; NONE) - else - let - val (exp, fm) = - fooifyExp - Url - (fn n => - let - val (_, t, _, s) = MonoEnv.lookupENamed env n - in - (t, s) - end) - (fn n => MonoEnv.lookupDatatype env n) - (!canonicalFm) - expTyp - in - if ErrorMsg.anyErrors () - then ((* DEBUG *) print "why"; (ErrorMsg.resetErrors (); NONE)) - else (canonicalFm := fm; SOME exp) - end + let + val (exp, fm) = + fooifyExpWithExceptions + Url + (fn n => + let + val (_, t, _, s) = MonoEnv.lookupENamed env n + in + (t, s) + end) + (fn n => MonoEnv.lookupDatatype env n) + (!canonicalFm) + expTyp + in + canonicalFm := fm; + SOME exp + end + handle TypeMismatch _ => NONE + | CantPass _ => NONE + | DontKnow _ => NONE fun getNewFmDecls () = let diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 4d4c7d36..dd851787 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -53,8 +53,9 @@ fun getCache () = !cache (* Used to have type context for local variables in MonoUtil functions. *) val doBind = - fn (env, MonoUtil.Exp.RelE (s, t)) => MonoEnv.pushERel env s t NONE - | (env, _) => env + fn (env, MonoUtil.Exp.RelE (x, t)) => MonoEnv.pushERel env x t NONE + | (env, MonoUtil.Exp.NamedE (x, n, t, eo, s)) => MonoEnv.pushENamed env x n t eo s + | (env, MonoUtil.Exp.Datatype (x, n, cs)) => MonoEnv.pushDatatype env x n cs (*******************) @@ -499,8 +500,6 @@ fun cacheWrap (env, exp, resultTyp, args, i) = let val loc = dummyLoc val rel0 = (ERel 0, loc) - (* DEBUG *) - val () = print (Int.toString i ^ "\n") in case MonoFooify.urlify env (rel0, resultTyp) of NONE => NONE @@ -524,7 +523,42 @@ fun cacheWrap (env, exp, resultTyp, args, i) = end end -fun fileMapfoldB doExp file start = +fun fileTopLevelMapfoldB doTopLevelExp (decls, sideInfo) state = + let + fun doVal env ((x, n, t, exp, s), state) = + let + val (exp, state) = doTopLevelExp env exp state + in + ((x, n, t, exp, s), state) + end + fun doDecl' env (decl', state) = + case decl' of + DVal v => + let + val (v, state) = doVal env (v, state) + in + (DVal v, state) + end + | DValRec vs => + let + val (vs, state) = ListUtil.foldlMap (doVal env) state vs + in + (DValRec vs, state) + end + | _ => (decl', state) + fun doDecl (decl as (decl', loc), (env, state)) = + let + val env = MonoEnv.declBinds env decl + val (decl', state) = doDecl' env (decl', state) + in + ((decl', loc), (env, state)) + end + val (decls, (_, state)) = (ListUtil.foldlMap doDecl (MonoEnv.empty, state) decls) + in + ((decls, sideInfo), state) + end + +fun fileAllMapfoldB doExp file start = case MonoUtil.File.mapfoldB {typ = Search.return2, exp = fn env => fn e' => fn s => Search.Continue (doExp env e' s), @@ -534,7 +568,7 @@ fun fileMapfoldB doExp file start = Search.Continue x => x | Search.Return _ => raise Match -fun fileMap doExp file = #1 (fileMapfoldB (fn _ => fn e => fn _ => (doExp e, ())) file ()) +fun fileMap doExp file = #1 (fileAllMapfoldB (fn _ => fn e => fn _ => (doExp e, ())) file ()) fun factorOutNontrivial text = let @@ -623,7 +657,7 @@ fun addChecking file = end | e' => (e', queryInfo) in - (fileMapfoldB (fn env => fn exp => fn state => doExp env state exp) + (fileAllMapfoldB (fn env => fn exp => fn state => doExp env state exp) file (SIMM.empty, IM.empty, 0), effs) @@ -675,8 +709,8 @@ end val invalidations = Invalidations.invalidations (* DEBUG *) -val gunk : ((Sql.query * int) * Sql.dml) list ref = ref [] -val gunk' : exp list ref = ref [] +(* val gunk : ((Sql.query * int) * Sql.dml) list ref = ref [] *) +(* val gunk' : exp list ref = ref [] *) fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) = let @@ -686,19 +720,19 @@ fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) = fn EDml (origDmlText, failureMode) => let (* DEBUG *) - val () = gunk' := origDmlText :: !gunk' + (* val () = gunk' := origDmlText :: !gunk' *) val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText val dmlText = incRels numArgs newDmlText val dmlExp = EDml (dmlText, failureMode) (* DEBUG *) - val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) + (* val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *) val inval = case Sql.parse Sql.dml dmlText of SOME dmlParsed => SOME (map (fn i => (case IM.find (indexToQueryNumArgs, i) of SOME queryNumArgs => (* DEBUG *) - (gunk := (queryNumArgs, dmlParsed) :: !gunk; + ((* gunk := (queryNumArgs, dmlParsed) :: !gunk; *) (i, invalidations (queryNumArgs, dmlParsed))) (* TODO: fail more gracefully. *) | NONE => raise Match)) @@ -713,7 +747,7 @@ fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) = | e' => e' in (* DEBUG *) - gunk := []; + (* gunk := []; *) (fileMap doExp file, index, effs) end @@ -957,52 +991,37 @@ fun pureCache (effs : IS.set) ((env, exp as (exp', loc)), index) : subexp * int index + 1) end -fun addPure ((decls, sideInfo), indexStart, effs) = +fun addPure (file, indexStart, effs) = let - fun doVal env ((x, n, t, exp, s), index) = + fun doTopLevelExp env exp index = let val (subexp, index) = pureCache effs ((env, exp), index) in - ((x, n, t, expOfSubexp subexp, s), index) - end - fun doDecl' env (decl', index) = - case decl' of - DVal v => - let - val (v, index) = doVal env (v, index) - in - (DVal v, index) - end - | DValRec vs => - let - val (vs, index) = ListUtil.foldlMap (doVal env) index vs - in - (DValRec vs, index) - end - | _ => (decl', index) - fun doDecl (decl as (decl', loc), (revDecls, env, index)) = - let - val env = MonoEnv.declBinds env decl - val (decl', index) = doDecl' env (decl', index) - (* Important that this happens after [MonoFooify.urlify] calls! *) - val fmDecls = MonoFooify.getNewFmDecls () - in - ((decl', loc) :: (fmDecls @ revDecls), env, index) + (expOfSubexp subexp, index) end in - (rev (#1 (List.foldl doDecl ([], MonoEnv.empty, indexStart) decls)), sideInfo) + #1 (fileTopLevelMapfoldB doTopLevelExp file indexStart) + end + +fun insertAfterDatatypes ((decls, sideInfo), newDecls) = + let + val (datatypes, others) = List.partition (fn (DDatatype _, _) => true | _ => false) decls + in + (datatypes @ newDecls @ others, sideInfo) end -val go' = addPure o addFlushing o addChecking (* DEBUG: add back [o inlineSql]. *) +val go' = addPure o addFlushing o addChecking o inlineSql fun go file = let (* TODO: do something nicer than [Sql] being in one of two modes. *) val () = (resetFfiInfo (); Sql.sqlcacheMode := true) - val file' = go' file + val file = go' file + (* Important that this happens after [MonoFooify.urlify] calls! *) + val fmDecls = MonoFooify.getNewFmDecls () val () = Sql.sqlcacheMode := false in - file' + insertAfterDatatypes (file, rev fmDecls) end end diff --git a/src/toy_cache.sml b/src/toy_cache.sml index 34a7a26f..cfde027b 100644 --- a/src/toy_cache.sml +++ b/src/toy_cache.sml @@ -95,7 +95,7 @@ fun setupQuery {index, params} = string args, string ") {", newline, - string "if (cacheQuery", + string "if (cacheWrite", string i, (* ASK: is returning the pointer okay? Should we duplicate? *) string " == NULL", @@ -116,9 +116,11 @@ fun setupQuery {index, params} = string i, string ".\");", newline, - string "uw_write(ctx, cacheWrite", + string " if (cacheWrite", string i, - string ");", + string " != NULL) { uw_write(ctx, cacheWrite", + string i, + string "); }", newline, string "return cacheQuery", string i, @@ -176,6 +178,14 @@ fun setupQuery {index, params} = string i, string " = NULL;", newline, + string "free(cacheWrite", + string i, + string ");", + newline, + string "cacheWrite", + string i, + string " = NULL;", + newline, string "puts(\"SQLCACHE: flush ", string i, string ".\");}", -- cgit v1.2.3 From 7b14b2f01fd0218c0bbe0a5c4071fff190c91ce1 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Wed, 11 Nov 2015 20:01:48 -0500 Subject: Rewrite LRU cache. Now uses one big hash table and is less buggy. --- include/urweb/types_cpp.h | 29 +++--- include/urweb/urweb_cpp.h | 8 +- src/c/urweb.c | 240 ++++++++++++++++++++++++---------------------- src/lru_cache.sml | 15 +-- 4 files changed, 147 insertions(+), 145 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 84423105..4847a3fd 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -123,31 +123,24 @@ typedef struct { #include "uthash.h" -typedef struct uw_Sqlcache_CacheValue { +typedef struct uw_Sqlcache_Value { char *result; char *output; -} uw_Sqlcache_CacheValue; + unsigned long timeValid; +} uw_Sqlcache_Value; -typedef struct uw_Sqlcache_CacheEntry { +typedef struct uw_Sqlcache_Entry { char *key; - void *value; - time_t timeValid; - struct uw_Sqlcache_CacheEntry *prev; - struct uw_Sqlcache_CacheEntry *next; + uw_Sqlcache_Value *value; + unsigned long timeInvalid; UT_hash_handle hh; -} uw_Sqlcache_CacheEntry; - -typedef struct uw_Sqlcache_CacheList { - uw_Sqlcache_CacheEntry *first; - uw_Sqlcache_CacheEntry *last; - int size; -} uw_Sqlcache_CacheList; +} uw_Sqlcache_Entry; typedef struct uw_Sqlcache_Cache { - uw_Sqlcache_CacheEntry *table; - time_t timeInvalid; - uw_Sqlcache_CacheList *lru; - int height; + struct uw_Sqlcache_Entry *table; + unsigned long timeInvalid; + unsigned long timeNow; + UT_hash_handle hh; } uw_Sqlcache_Cache; #endif diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index ab2a91c1..52e54372 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -405,10 +405,8 @@ void uw_Basis_writec(struct uw_context *, char); // Sqlcache. -#include "uthash.h" - -uw_Sqlcache_CacheValue *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **); -uw_Sqlcache_CacheValue *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, uw_Sqlcache_CacheValue *); -uw_Sqlcache_CacheValue *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **); +uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **, int); +void *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, int, uw_Sqlcache_Value *); +void *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **, int); #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index ef7eb9bb..09d04f1c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4532,144 +4532,154 @@ void uw_set_remoteSock(uw_context ctx, int sock) { // Sqlcache -void uw_Sqlcache_listDelete(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { - if (list->first == entry) { - list->first = entry->next; - } - if (list->last == entry) { - list->last = entry->prev; - } - if (entry->prev) { - entry->prev->next = entry->next; - } - if (entry->next) { - entry->next->prev = entry->prev; +void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) { + if (value) { + free(value->result); + free(value->output); + free(value); } - entry->prev = NULL; - entry->next = NULL; - --(list->size); } -void uw_Sqlcache_listAdd(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { - if (list->last) { - list->last->next = entry; - entry->prev = list->last; - list->last = entry; - } else { - list->first = entry; - list->last = entry; +void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) { + if (entry) { + free(entry->key); + uw_Sqlcache_freeValue(entry->value); + free(entry); } - ++(list->size); -} - -void uw_Sqlcache_listBump(uw_Sqlcache_CacheList *list, uw_Sqlcache_CacheEntry *entry) { - uw_Sqlcache_listDelete(list, entry); - uw_Sqlcache_listAdd(list, entry); } -// TODO: deal with time properly. +// TODO: pick a number. +unsigned int uw_Sqlcache_maxSize = 1234567890; -time_t uw_Sqlcache_getTimeNow() { - return time(NULL); +void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry) { + HASH_DEL(cache->table, entry); + uw_Sqlcache_freeEntry(entry); } -time_t uw_Sqlcache_timeMax(time_t x, time_t y) { - return difftime(x, y) > 0 ? x : y; +uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t len, int bump) { + uw_Sqlcache_Entry *entry = NULL; + HASH_FIND(hh, cache->table, key, len, entry); + if (entry && bump) { + // Bump for LRU purposes. + HASH_DEL(cache->table, entry); + // Important that we use [entry->key], because [key] might be ephemeral. + HASH_ADD_KEYPTR(hh, cache->table, entry->key, len, entry); + } + return entry; } -void uw_Sqlcache_free(uw_Sqlcache_CacheValue *value) { - if (value) { - free(value->result); - free(value->output); - free(value); +void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, size_t len) { + HASH_ADD_KEYPTR(hh, cache->table, entry->key, len, entry); + if (HASH_COUNT(cache->table) > uw_Sqlcache_maxSize) { + // Deletes the first element of the cache. + uw_Sqlcache_delete(cache, cache->table); } } -void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_CacheEntry* entry) { - //uw_Sqlcache_listUw_Sqlcache_Delete(cache->lru, entry); - HASH_DELETE(hh, cache->table, entry); - uw_Sqlcache_free(entry->value); - free(entry->key); - free(entry); -} - -uw_Sqlcache_CacheValue *uw_Sqlcache_checkHelper(uw_Sqlcache_Cache *cache, char **keys, int timeInvalid) { - char *key = keys[cache->height]; - uw_Sqlcache_CacheEntry *entry; - HASH_FIND(hh, cache->table, key, strlen(key), entry); - timeInvalid = uw_Sqlcache_timeMax(timeInvalid, cache->timeInvalid); - if (entry && difftime(entry->timeValid, timeInvalid) > 0) { - if (cache->height == 0) { - // At height 0, entry->value is the desired value. - //uw_Sqlcache_listBump(cache->lru, entry); - return entry->value; - } else { - // At height n+1, entry->value is a pointer to a cache at heignt n. - return uw_Sqlcache_checkHelper(entry->value, keys, timeInvalid); - } - } else { - return NULL; - } +unsigned long uw_Sqlcache_getTimeNow(uw_Sqlcache_Cache *cache) { + return ++cache->timeNow; } -uw_Sqlcache_CacheValue *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { - return uw_Sqlcache_checkHelper(cache, keys, 0); +unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) { + return x > y ? x : y; } -void uw_Sqlcache_storeHelper(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_CacheValue *value, int timeNow) { - uw_Sqlcache_CacheEntry *entry; - char *key = keys[cache->height]; - HASH_FIND(hh, cache->table, key, strlen(key), entry); - if (!entry) { - entry = malloc(sizeof(uw_Sqlcache_CacheEntry)); - entry->key = strdup(key); - entry->value = NULL; - HASH_ADD_KEYPTR(hh, cache->table, entry->key, strlen(entry->key), entry); +char uw_Sqlcache_keySep = '_'; + +char *uw_Sqlcache_allocKeyBuffer(char **keys, int numKeys) { + size_t len = 0; + while (numKeys-- > 0) { + char* k = keys[numKeys]; + if (!k) { + // Can only happen when flushihg, in which case we don't need anything past the null key. + break; + } + // Leave room for separator. + len += 1 + strlen(k); } - entry->timeValid = timeNow; - if (cache->height == 0) { - //uw_Sqlcache_listAdd(cache->lru, entry); - uw_Sqlcache_free(entry->value); - entry->value = value; - //if (cache->lru->size > MAX_SIZE) { - //uw_Sqlcache_delete(cache, cache->lru->first); - // TODO: return flushed value. - //} - } else { - if (!entry->value) { - uw_Sqlcache_Cache *newuw_Sqlcache_Cache = malloc(sizeof(uw_Sqlcache_Cache)); - newuw_Sqlcache_Cache->table = NULL; - newuw_Sqlcache_Cache->timeInvalid = timeNow; - newuw_Sqlcache_Cache->lru = cache->lru; - newuw_Sqlcache_Cache->height = cache->height - 1; - entry->value = newuw_Sqlcache_Cache; + char *buf = malloc(len+1); + // If nothing is copied into the buffer, it should look like it has length 0. + buf[0] = 0; + return buf; +} + +char *uw_Sqlcache_keyCopy(char *buf, char *key) { + *buf++ = uw_Sqlcache_keySep; + return stpcpy(buf, key); +} + +// The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn". +// TODO: strlen(key) = buf - key? + +uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys, int numKeys) { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; + time_t timeInvalid = cache->timeInvalid; + uw_Sqlcache_Entry *entry; + while (numKeys-- > 0) { + buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 1); + if (!entry) { + free(key); + return NULL; } - uw_Sqlcache_storeHelper(entry->value, keys, value, timeNow); + timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid); } -} - -void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_CacheValue *value) { - uw_Sqlcache_storeHelper(cache, keys, value, uw_Sqlcache_getTimeNow()); -} - -void uw_Sqlcache_flushHelper(uw_Sqlcache_Cache *cache, char **keys, int timeNow) { - uw_Sqlcache_CacheEntry *entry; - char *key = keys[cache->height]; - if (key) { - HASH_FIND(hh, cache->table, key, strlen(key), entry); - if (entry) { - if (cache->height == 0) { - uw_Sqlcache_delete(cache, entry); + free(key); + uw_Sqlcache_Value *value = entry->value; + return value && value->timeValid > timeInvalid ? value : NULL; +} + +void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, int numKeys, uw_Sqlcache_Value *value) { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; + time_t timeNow = uw_Sqlcache_getTimeNow(cache); + uw_Sqlcache_Entry *entry; + while (numKeys-- > 0) { + buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 1); + if (!entry) { + entry = malloc(sizeof(uw_Sqlcache_Entry)); + entry->key = strdup(key); + entry->value = NULL; + entry->timeInvalid = 0; // ASK: is this okay? + uw_Sqlcache_add(cache, entry, len); + } + } + free(key); + uw_Sqlcache_freeValue(entry->value); + entry->value = value; + entry->value->timeValid = timeNow; +} + +void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys, int numKeys) { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; + time_t timeNow = uw_Sqlcache_getTimeNow(cache); + uw_Sqlcache_Entry *entry; + while (numKeys-- > 0) { + char *k = keys[numKeys]; + if (!k) { + if (entry) { + entry->timeInvalid = timeNow; } else { - uw_Sqlcache_flushHelper(entry->value, keys, timeNow); + // Haven't found an entry yet, so the first key was null. + cache->timeInvalid = timeNow; } + free(key); + return; + } + buf = uw_Sqlcache_keyCopy(buf, k); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 0); + if (!entry) { + free(key); + return; } - } else { - // Null key means invalidate the entire subtree. - cache->timeInvalid = timeNow; } -} - -void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys) { - uw_Sqlcache_flushHelper(cache, keys, uw_Sqlcache_getTimeNow()); + free(key); + // All the keys were non-null and the relevant entry is present, so we delete it. + uw_Sqlcache_delete(cache, entry); } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index e69624d8..6fcfdc55 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -62,6 +62,8 @@ fun setupQuery {index, params} = val revArgs = paramRepeatRev (fn p => "p" ^ p) ", " + val numArgs = Int.toString params + in Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), @@ -70,9 +72,7 @@ fun setupQuery {index, params} = newline, string " .timeInvalid = 0,", newline, - string " .lru = NULL,", - newline, - string (" .height = " ^ Int.toString (params - 1) ^ "};"), + string " .timeNow = 0};", newline, string ("static uw_Sqlcache_Cache *cache" ^ i ^ " = &cacheStruct" ^ i ^ ";"), newline, @@ -83,7 +83,8 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_CacheValue *v = uw_Sqlcache_check(cache" ^ i ^ ", ks);"), + string " uw_Sqlcache_Value *v = ", + string ("uw_Sqlcache_check(cache" ^ i ^ ", ks, " ^ numArgs ^ ");"), newline, (* If the output is null, it means we had too much recursion, so it's a miss. *) string " if (v && v->output != NULL) {", @@ -113,7 +114,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_CacheValue *v = malloc(sizeof(uw_Sqlcache_CacheValue));"), + string (" uw_Sqlcache_Value *v = malloc(sizeof(uw_Sqlcache_Value));"), newline, string " v->result = strdup(s);", newline, @@ -121,7 +122,7 @@ fun setupQuery {index, params} = newline, string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline, - string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, v);"), + string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, " ^ numArgs ^ ", v);"), newline, string " return uw_unit_v;", newline, @@ -134,7 +135,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks);"), + string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks, " ^ numArgs ^ ");"), newline, string " return uw_unit_v;", newline, -- cgit v1.2.3 From 011b7148c87f8b0d90abee2f454ef7689493e1f9 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Thu, 12 Nov 2015 09:15:50 -0500 Subject: Simplify C interface. --- include/urweb/types_cpp.h | 1 + include/urweb/urweb_cpp.h | 6 +++--- src/c/urweb.c | 11 +++++++---- src/lru_cache.sml | 11 +++++------ 4 files changed, 16 insertions(+), 13 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 4847a3fd..3955dcc8 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -140,6 +140,7 @@ typedef struct uw_Sqlcache_Cache { struct uw_Sqlcache_Entry *table; unsigned long timeInvalid; unsigned long timeNow; + size_t numKeys; UT_hash_handle hh; } uw_Sqlcache_Cache; diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index f89c432c..15bfffac 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -406,8 +406,8 @@ void uw_Basis_writec(struct uw_context *, char); // Sqlcache. -uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **, int); -void *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, int, uw_Sqlcache_Value *); -void *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **, int); +uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **); +void *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *); +void *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **); #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index 30619314..71130cc7 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -488,7 +488,7 @@ struct uw_context { char *output_buffer; size_t output_buffer_size; - // For caching. + // Sqlcache. int numRecording; int recordingOffset; @@ -4616,7 +4616,8 @@ char *uw_Sqlcache_keyCopy(char *buf, char *key) { // The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn". // TODO: strlen(key) = buf - key? -uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys, int numKeys) { +uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { + size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; time_t timeInvalid = cache->timeInvalid; @@ -4636,7 +4637,8 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys, int return value && value->timeValid > timeInvalid ? value : NULL; } -void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, int numKeys, uw_Sqlcache_Value *value) { +void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { + size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; time_t timeNow = uw_Sqlcache_getTimeNow(cache); @@ -4659,7 +4661,8 @@ void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, int numKeys, uw_Sq entry->value->timeValid = timeNow; } -void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys, int numKeys) { +void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys) { + size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; time_t timeNow = uw_Sqlcache_getTimeNow(cache); diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 6fcfdc55..d4da2849 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -62,14 +62,14 @@ fun setupQuery {index, params} = val revArgs = paramRepeatRev (fn p => "p" ^ p) ", " - val numArgs = Int.toString params - in Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), newline, string " .table = NULL,", newline, + string (" .numKeys = " ^ Int.toString params ^ ","), + newline, string " .timeInvalid = 0,", newline, string " .timeNow = 0};", @@ -83,8 +83,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string " uw_Sqlcache_Value *v = ", - string ("uw_Sqlcache_check(cache" ^ i ^ ", ks, " ^ numArgs ^ ");"), + string (" uw_Sqlcache_Value *v = uw_Sqlcache_check(cache" ^ i ^ ", ks);"), newline, (* If the output is null, it means we had too much recursion, so it's a miss. *) string " if (v && v->output != NULL) {", @@ -122,7 +121,7 @@ fun setupQuery {index, params} = newline, string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline, - string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, " ^ numArgs ^ ", v);"), + string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, v);"), newline, string " return uw_unit_v;", newline, @@ -135,7 +134,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks, " ^ numArgs ^ ");"), + string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks);"), newline, string " return uw_unit_v;", newline, -- cgit v1.2.3 From 7fff147bd1fad81381fb36396021c3acb33da44d Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Thu, 12 Nov 2015 09:47:20 -0500 Subject: Make cache flushes safe for transactions (not sure about LRU bump on read). --- src/c/urweb.c | 49 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 48 insertions(+), 1 deletion(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 71130cc7..050a06c9 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -424,6 +424,12 @@ typedef struct { void (*free)(void*); } global; +typedef struct uw_Sqlcache_Inval { + uw_Sqlcache_Cache *cache; + char **keys; + struct uw_Sqlcache_Inval *next; +} uw_Sqlcache_Inval; + struct uw_context { uw_app *app; int id; @@ -491,6 +497,7 @@ struct uw_context { // Sqlcache. int numRecording; int recordingOffset; + uw_Sqlcache_Inval *inval; int remoteSock; }; @@ -4661,7 +4668,7 @@ void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value entry->value->timeValid = timeNow; } -void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys) { +void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4691,3 +4698,43 @@ void uw_Sqlcache_flush(uw_Sqlcache_Cache *cache, char **keys) { // All the keys were non-null and the relevant entry is present, so we delete it. uw_Sqlcache_delete(cache, entry); } + +void uw_Sqlcache_flushFree(void *data, int dontCare) { + uw_Sqlcache_Inval *inval = (uw_Sqlcache_Inval *)data; + while (inval) { + char** keys = inval->keys; + size_t numKeys = inval->cache->numKeys; + while (numKeys-- > 0) { + free(keys[numKeys]); + } + free(keys); + uw_Sqlcache_Inval *nextInval = inval->next; + free(inval); + inval = nextInval; + } +} + +void uw_Sqlcache_flushCommit(void *data) { + uw_Sqlcache_Inval *inval = (uw_Sqlcache_Inval *)data; + uw_Sqlcache_Inval *invalFirst = inval; + while (inval) { + uw_Sqlcache_Cache *cache = inval->cache; + char **keys = inval->keys; + uw_Sqlcache_flushCommitOne(cache, keys); + inval = inval->next; + } + uw_Sqlcache_flushFree(invalFirst, 0); +} + +void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + uw_Sqlcache_Inval *inval = malloc(sizeof(uw_Sqlcache_Inval)); + inval->cache = cache; + inval->keys = keys; + inval->next = NULL; + if (ctx->inval) { + ctx->inval->next = inval; + } else { + uw_register_transactional(ctx, inval, uw_Sqlcache_flushCommit, NULL, uw_Sqlcache_flushFree); + } + ctx->inval = inval; +} -- cgit v1.2.3 From ed20a67a1268bf517cfdbc1a897b659dce38f3a4 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Thu, 12 Nov 2015 10:06:07 -0500 Subject: Initialize invalidation to NULL! --- src/c/urweb.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 050a06c9..55d89fd5 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -585,6 +585,7 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->numRecording = 0; ctx->recordingOffset = 0; + ctx->inval = NULL; ctx->remoteSock = -1; @@ -4732,9 +4733,11 @@ void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { inval->keys = keys; inval->next = NULL; if (ctx->inval) { + // An invalidation is already registered, so just extend it. ctx->inval->next = inval; } else { uw_register_transactional(ctx, inval, uw_Sqlcache_flushCommit, NULL, uw_Sqlcache_flushFree); } + // [ctx->inval] should always point to the last invalidation. ctx->inval = inval; } -- cgit v1.2.3 From fd7375f584790047731686345c8ce6fedee71435 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Thu, 12 Nov 2015 11:44:21 -0500 Subject: Actually use transactional machinery for flushes this time. --- include/urweb/types_cpp.h | 10 +++------- include/urweb/urweb_cpp.h | 2 +- src/c/urweb.c | 28 ++++++++++++++++++++++++---- src/lru_cache.sml | 4 +++- 4 files changed, 31 insertions(+), 13 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 3955dcc8..c4af2866 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -129,15 +129,11 @@ typedef struct uw_Sqlcache_Value { unsigned long timeValid; } uw_Sqlcache_Value; -typedef struct uw_Sqlcache_Entry { - char *key; - uw_Sqlcache_Value *value; - unsigned long timeInvalid; - UT_hash_handle hh; -} uw_Sqlcache_Entry; +typedef struct uw_Sqlcache_Entry uw_Sqlcache_Entry; typedef struct uw_Sqlcache_Cache { - struct uw_Sqlcache_Entry *table; + //pthread_rwlock_t *lock; + uw_Sqlcache_Entry *table; unsigned long timeInvalid; unsigned long timeNow; size_t numKeys; diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 15bfffac..3e70b4ac 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -408,6 +408,6 @@ void uw_Basis_writec(struct uw_context *, char); uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **); void *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *); -void *uw_Sqlcache_flush(uw_Sqlcache_Cache *, char **); +void *uw_Sqlcache_flush(struct uw_context *, uw_Sqlcache_Cache *, char **); #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index 55d89fd5..4db019fe 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4545,6 +4545,13 @@ void uw_set_remoteSock(uw_context ctx, int sock) { // Sqlcache +typedef struct uw_Sqlcache_Entry { + char *key; + uw_Sqlcache_Value *value; + unsigned long timeInvalid; + UT_hash_handle hh; +} uw_Sqlcache_Entry; + void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) { if (value) { free(value->result); @@ -4599,7 +4606,7 @@ unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) { char uw_Sqlcache_keySep = '_'; -char *uw_Sqlcache_allocKeyBuffer(char **keys, int numKeys) { +char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) { size_t len = 0; while (numKeys-- > 0) { char* k = keys[numKeys]; @@ -4625,6 +4632,7 @@ char *uw_Sqlcache_keyCopy(char *buf, char *key) { // TODO: strlen(key) = buf - key? uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { + //pthread_rwlock_rdlock(cache->lock); size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4642,10 +4650,12 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { } free(key); uw_Sqlcache_Value *value = entry->value; + //pthread_rwlock_unlock(cache->lock); return value && value->timeValid > timeInvalid ? value : NULL; } void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { + //pthread_rwlock_wrlock(cache->lock); size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4667,6 +4677,7 @@ void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value uw_Sqlcache_freeValue(entry->value); entry->value = value; entry->value->timeValid = timeNow; + //pthread_rwlock_unlock(cache->lock); } void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { @@ -4717,20 +4728,28 @@ void uw_Sqlcache_flushFree(void *data, int dontCare) { void uw_Sqlcache_flushCommit(void *data) { uw_Sqlcache_Inval *inval = (uw_Sqlcache_Inval *)data; - uw_Sqlcache_Inval *invalFirst = inval; while (inval) { uw_Sqlcache_Cache *cache = inval->cache; char **keys = inval->keys; uw_Sqlcache_flushCommitOne(cache, keys); inval = inval->next; } - uw_Sqlcache_flushFree(invalFirst, 0); +} + +char **uw_Sqlcache_copyKeys(char **keys, size_t numKeys) { + char **copy = malloc(sizeof(char *) * numKeys); + while (numKeys-- > 0) { + char * k = keys[numKeys]; + copy[numKeys] = k ? strdup(k) : NULL; + } + return copy; } void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + //pthread_rwlock_wrlock(cache->lock); uw_Sqlcache_Inval *inval = malloc(sizeof(uw_Sqlcache_Inval)); inval->cache = cache; - inval->keys = keys; + inval->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys); inval->next = NULL; if (ctx->inval) { // An invalidation is already registered, so just extend it. @@ -4740,4 +4759,5 @@ void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { } // [ctx->inval] should always point to the last invalidation. ctx->inval = inval; + //pthread_rwlock_unlock(cache->lock); } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index d4da2849..9d65420b 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -65,6 +65,8 @@ fun setupQuery {index, params} = in Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), + (* newline, *) + (* string " .lock = PTHREAD_RWLOCK_INITIALIZER,", *) newline, string " .table = NULL,", newline, @@ -134,7 +136,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_flush(cache" ^ i ^ ", ks);"), + string (" uw_Sqlcache_flush(ctx, cache" ^ i ^ ", ks);"), newline, string " return uw_unit_v;", newline, -- cgit v1.2.3 From 06464bd07cb1efbc9df4ca650978c14f4c20390a Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Thu, 12 Nov 2015 16:36:35 -0500 Subject: Fix committing multiple stores/flushes. Locking is WIP. --- include/urweb/types_cpp.h | 3 +- include/urweb/urweb_cpp.h | 4 +- src/c/urweb.c | 108 +++++++++++++++++++++++++++------------------- src/lru_cache.sml | 8 ++-- 4 files changed, 72 insertions(+), 51 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index c4af2866..82f8d30a 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -121,6 +121,7 @@ typedef struct { // Caching +#include #include "uthash.h" typedef struct uw_Sqlcache_Value { @@ -132,7 +133,7 @@ typedef struct uw_Sqlcache_Value { typedef struct uw_Sqlcache_Entry uw_Sqlcache_Entry; typedef struct uw_Sqlcache_Cache { - //pthread_rwlock_t *lock; + pthread_rwlock_t lock; uw_Sqlcache_Entry *table; unsigned long timeInvalid; unsigned long timeNow; diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 3e70b4ac..2c032e7b 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -406,8 +406,8 @@ void uw_Basis_writec(struct uw_context *, char); // Sqlcache. -uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *, char **); -void *uw_Sqlcache_store(uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *); +uw_Sqlcache_Value *uw_Sqlcache_check(struct uw_context *, uw_Sqlcache_Cache *, char **); +void *uw_Sqlcache_store(struct uw_context *, uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *); void *uw_Sqlcache_flush(struct uw_context *, uw_Sqlcache_Cache *, char **); #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index 4db019fe..4afc7297 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -424,11 +424,12 @@ typedef struct { void (*free)(void*); } global; -typedef struct uw_Sqlcache_Inval { +typedef struct uw_Sqlcache_Update { uw_Sqlcache_Cache *cache; char **keys; - struct uw_Sqlcache_Inval *next; -} uw_Sqlcache_Inval; + uw_Sqlcache_Value *value; + struct uw_Sqlcache_Update *next; +} uw_Sqlcache_Update; struct uw_context { uw_app *app; @@ -497,7 +498,8 @@ struct uw_context { // Sqlcache. int numRecording; int recordingOffset; - uw_Sqlcache_Inval *inval; + uw_Sqlcache_Update *cacheUpdate; + uw_Sqlcache_Update *cacheUpdateTail; int remoteSock; }; @@ -508,6 +510,7 @@ size_t uw_heap_max = SIZE_MAX; size_t uw_script_max = SIZE_MAX; uw_context uw_init(int id, uw_loggers *lg) { + puts("Initializing"); uw_context ctx = malloc(sizeof(struct uw_context)); ctx->app = NULL; @@ -585,7 +588,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->numRecording = 0; ctx->recordingOffset = 0; - ctx->inval = NULL; + ctx->cacheUpdate = NULL; + ctx->cacheUpdateTail = NULL; ctx->remoteSock = -1; @@ -4629,10 +4633,9 @@ char *uw_Sqlcache_keyCopy(char *buf, char *key) { } // The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn". -// TODO: strlen(key) = buf - key? -uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { - //pthread_rwlock_rdlock(cache->lock); +uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + pthread_rwlock_rdlock(&cache->lock); size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4644,18 +4647,20 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_Sqlcache_Cache *cache, char **keys) { entry = uw_Sqlcache_find(cache, key, len, 1); if (!entry) { free(key); + pthread_rwlock_unlock(&cache->lock); return NULL; } timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid); } free(key); + // TODO: pass back copy of value and free it in the generated code... or use uw_malloc? uw_Sqlcache_Value *value = entry->value; - //pthread_rwlock_unlock(cache->lock); + pthread_rwlock_unlock(&cache->lock); return value && value->timeValid > timeInvalid ? value : NULL; } -void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { - //pthread_rwlock_wrlock(cache->lock); +void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { + pthread_rwlock_wrlock(&cache->lock); size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4669,7 +4674,7 @@ void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value entry = malloc(sizeof(uw_Sqlcache_Entry)); entry->key = strdup(key); entry->value = NULL; - entry->timeInvalid = 0; // ASK: is this okay? + entry->timeInvalid = 0; uw_Sqlcache_add(cache, entry, len); } } @@ -4677,10 +4682,11 @@ void uw_Sqlcache_store(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value uw_Sqlcache_freeValue(entry->value); entry->value = value; entry->value->timeValid = timeNow; - //pthread_rwlock_unlock(cache->lock); + pthread_rwlock_unlock(&cache->lock); } void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { + pthread_rwlock_wrlock(&cache->lock); size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4709,55 +4715,69 @@ void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { free(key); // All the keys were non-null and the relevant entry is present, so we delete it. uw_Sqlcache_delete(cache, entry); + pthread_rwlock_unlock(&cache->lock); } -void uw_Sqlcache_flushFree(void *data, int dontCare) { - uw_Sqlcache_Inval *inval = (uw_Sqlcache_Inval *)data; - while (inval) { - char** keys = inval->keys; - size_t numKeys = inval->cache->numKeys; +void uw_Sqlcache_freeUpdate(void *data, int dontCare) { + uw_context ctx = (uw_context)data; + uw_Sqlcache_Update *update = ctx->cacheUpdate; + while (update) { + char** keys = update->keys; + size_t numKeys = update->cache->numKeys; while (numKeys-- > 0) { free(keys[numKeys]); } free(keys); - uw_Sqlcache_Inval *nextInval = inval->next; - free(inval); - inval = nextInval; + // Don't free [update->value]: it's in the cache now! + uw_Sqlcache_Update *nextUpdate = update->next; + free(update); + update = nextUpdate; } -} - -void uw_Sqlcache_flushCommit(void *data) { - uw_Sqlcache_Inval *inval = (uw_Sqlcache_Inval *)data; - while (inval) { - uw_Sqlcache_Cache *cache = inval->cache; - char **keys = inval->keys; - uw_Sqlcache_flushCommitOne(cache, keys); - inval = inval->next; + ctx->cacheUpdate = NULL; + ctx->cacheUpdateTail = NULL; +} + +void uw_Sqlcache_commitUpdate(void *data) { + uw_context ctx = (uw_context)data; + uw_Sqlcache_Update *update = ctx->cacheUpdate; + while (update) { + uw_Sqlcache_Cache *cache = update->cache; + char **keys = update->keys; + if (update->value) { + uw_Sqlcache_storeCommitOne(cache, keys, update->value); + } else { + uw_Sqlcache_flushCommitOne(cache, keys); + } + update = update->next; } } char **uw_Sqlcache_copyKeys(char **keys, size_t numKeys) { char **copy = malloc(sizeof(char *) * numKeys); while (numKeys-- > 0) { - char * k = keys[numKeys]; + char *k = keys[numKeys]; copy[numKeys] = k ? strdup(k) : NULL; } return copy; } -void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { - //pthread_rwlock_wrlock(cache->lock); - uw_Sqlcache_Inval *inval = malloc(sizeof(uw_Sqlcache_Inval)); - inval->cache = cache; - inval->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys); - inval->next = NULL; - if (ctx->inval) { - // An invalidation is already registered, so just extend it. - ctx->inval->next = inval; +void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { + uw_Sqlcache_Update *update = malloc(sizeof(uw_Sqlcache_Update)); + update->cache = cache; + update->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys); + update->value = value; + update->next = NULL; + if (ctx->cacheUpdateTail) { + // An update is already registered, so just extend it. + ctx->cacheUpdateTail->next = update; } else { - uw_register_transactional(ctx, inval, uw_Sqlcache_flushCommit, NULL, uw_Sqlcache_flushFree); + ctx->cacheUpdate = update; + uw_register_transactional(ctx, ctx, uw_Sqlcache_commitUpdate, NULL, uw_Sqlcache_freeUpdate); } - // [ctx->inval] should always point to the last invalidation. - ctx->inval = inval; - //pthread_rwlock_unlock(cache->lock); + ctx->cacheUpdateTail = update; +} + +void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + // A flush is represented in the queue as storing NULL. + uw_Sqlcache_store(ctx, cache, keys, NULL); } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 9d65420b..b6ffe700 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -65,8 +65,8 @@ fun setupQuery {index, params} = in Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), - (* newline, *) - (* string " .lock = PTHREAD_RWLOCK_INITIALIZER,", *) + newline, + string " .lock = PTHREAD_RWLOCK_INITIALIZER,", newline, string " .table = NULL,", newline, @@ -85,7 +85,7 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_Value *v = uw_Sqlcache_check(cache" ^ i ^ ", ks);"), + string (" uw_Sqlcache_Value *v = uw_Sqlcache_check(ctx, cache" ^ i ^ ", ks);"), newline, (* If the output is null, it means we had too much recursion, so it's a miss. *) string " if (v && v->output != NULL) {", @@ -123,7 +123,7 @@ fun setupQuery {index, params} = newline, string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline, - string (" uw_Sqlcache_store(cache" ^ i ^ ", ks, v);"), + string (" uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"), newline, string " return uw_unit_v;", newline, -- cgit v1.2.3 From c38edb9bd5c21bcc1d21979d40ec8e9d638b6e9c Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 13 Nov 2015 01:04:32 -0500 Subject: Fix issue with one-element caches. Locking still WIP. --- src/c/urweb.c | 95 ++++++++++++++++++++++------------ src/cache.sml | 9 ++-- src/lru_cache.sml | 29 ++++++----- src/sqlcache.sml | 149 ++++++++++++++++++++++++++++++++++++------------------ src/toy_cache.sml | 5 +- 5 files changed, 189 insertions(+), 98 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 4afc7297..02e17a0b 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4641,18 +4641,27 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, c char *buf = key; time_t timeInvalid = cache->timeInvalid; uw_Sqlcache_Entry *entry; - while (numKeys-- > 0) { - buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); - size_t len = buf - key; - entry = uw_Sqlcache_find(cache, key, len, 1); + if (numKeys == 0) { + entry = cache->table; if (!entry) { free(key); pthread_rwlock_unlock(&cache->lock); return NULL; } - timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid); + } else { + while (numKeys-- > 0) { + buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 1); + if (!entry) { + free(key); + pthread_rwlock_unlock(&cache->lock); + return NULL; + } + timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid); + } + free(key); } - free(key); // TODO: pass back copy of value and free it in the generated code... or use uw_malloc? uw_Sqlcache_Value *value = entry->value; pthread_rwlock_unlock(&cache->lock); @@ -4666,19 +4675,30 @@ void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcac char *buf = key; time_t timeNow = uw_Sqlcache_getTimeNow(cache); uw_Sqlcache_Entry *entry; - while (numKeys-- > 0) { - buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); - size_t len = buf - key; - entry = uw_Sqlcache_find(cache, key, len, 1); + if (numKeys == 0) { + entry = cache->table; if (!entry) { entry = malloc(sizeof(uw_Sqlcache_Entry)); entry->key = strdup(key); entry->value = NULL; entry->timeInvalid = 0; - uw_Sqlcache_add(cache, entry, len); + cache->table = entry; } + } else { + while (numKeys-- > 0) { + buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 1); + if (!entry) { + entry = malloc(sizeof(uw_Sqlcache_Entry)); + entry->key = strdup(key); + entry->value = NULL; + entry->timeInvalid = 0; + uw_Sqlcache_add(cache, entry, len); + } + } + free(key); } - free(key); uw_Sqlcache_freeValue(entry->value); entry->value = value; entry->value->timeValid = timeNow; @@ -4692,29 +4712,40 @@ void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { char *buf = key; time_t timeNow = uw_Sqlcache_getTimeNow(cache); uw_Sqlcache_Entry *entry; - while (numKeys-- > 0) { - char *k = keys[numKeys]; - if (!k) { - if (entry) { - entry->timeInvalid = timeNow; - } else { - // Haven't found an entry yet, so the first key was null. - cache->timeInvalid = timeNow; - } - free(key); - return; + if (numKeys == 0) { + puts("flush cache of height 0"); + entry = cache->table; + if (entry) { + uw_Sqlcache_freeValue(entry->value); + entry->value = NULL; } - buf = uw_Sqlcache_keyCopy(buf, k); - size_t len = buf - key; - entry = uw_Sqlcache_find(cache, key, len, 0); - if (!entry) { - free(key); - return; + } else { + while (numKeys-- > 0) { + char *k = keys[numKeys]; + if (!k) { + if (entry) { + entry->timeInvalid = timeNow; + } else { + // Haven't found an entry yet, so the first key was null. + cache->timeInvalid = timeNow; + } + free(key); + pthread_rwlock_unlock(&cache->lock); + return; + } + buf = uw_Sqlcache_keyCopy(buf, k); + size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 0); + if (!entry) { + free(key); + pthread_rwlock_unlock(&cache->lock); + return; + } } + free(key); + // All the keys were non-null and the relevant entry is present, so we delete it. + uw_Sqlcache_delete(cache, entry); } - free(key); - // All the keys were non-null and the relevant entry is present, so we delete it. - uw_Sqlcache_delete(cache, entry); pthread_rwlock_unlock(&cache->lock); } diff --git a/src/cache.sml b/src/cache.sml index 8de22e0d..015c3ff1 100644 --- a/src/cache.sml +++ b/src/cache.sml @@ -2,13 +2,14 @@ structure Cache = struct type cache = {(* Takes a query ID and parameters (and, for store, the value to - store) and gives an FFI call that checks, stores, or flushes the - relevant entry. The parameters are strings for check and store and - optional strings for flush because some parameters might not be - fixed. *) + store) and gives an FFI call that checks, stores, or flushes the + relevant entry. The parameters are strings for check and store and + optional strings for flush because some parameters might not be + fixed. *) check : int * Mono.exp list -> Mono.exp', store : int * Mono.exp list * Mono.exp -> Mono.exp', flush : int * Mono.exp list -> Mono.exp', + lock : int * bool (* true = write, false = read *) -> Mono.exp', (* Generates C needed for FFI calls in check, store, and flush. *) setupGlobal : Print.PD.pp_desc, setupQuery : {index : int, params : int} -> Print.PD.pp_desc} diff --git a/src/lru_cache.sml b/src/lru_cache.sml index b6ffe700..b66becb7 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -24,6 +24,9 @@ fun store (index, keys, value) = fun flush (index, keys) = ffiAppCache' ("flush", index, withTyp optionStringTyp keys) +fun lock (index, write) = + ffiAppCache' ((if write then "w" else "r") ^ "lock", index, []) + (* Cjr *) @@ -157,18 +160,18 @@ fun toyIfNoKeys numKeys implLru implToy args = else implLru args val cache = - let - val {check = toyCheck, - store = toyStore, - flush = toyFlush, - setupQuery = toySetupQuery, - ...} = ToyCache.cache - in - {check = toyIfNoKeys (length o #2) check toyCheck, - store = toyIfNoKeys (length o #2) store toyStore, - flush = toyIfNoKeys (length o #2) flush toyFlush, - setupQuery = toyIfNoKeys #params setupQuery toySetupQuery, - setupGlobal = setupGlobal} - end + (* let *) + (* val {check = toyCheck, *) + (* store = toyStore, *) + (* flush = toyFlush, *) + (* setupQuery = toySetupQuery, *) + (* ...} = ToyCache.cache *) + (* in *) + (* {check = toyIfNoKeys (length o #2) check toyCheck, *) + (* store = toyIfNoKeys (length o #2) store toyStore, *) + (* flush = toyIfNoKeys (length o #2) flush toyFlush, *) + {check = check, store = store, flush = flush, lock = lock, + setupQuery = setupQuery, setupGlobal = setupGlobal} + (* end *) end diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 5a748496..2b3b80ae 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -1,6 +1,9 @@ structure Sqlcache :> SQLCACHE = struct -open Mono + +(*********************) +(* General Utilities *) +(*********************) structure IK = struct type ord_key = int val compare = Int.compare end structure IS = IntBinarySet @@ -8,10 +11,9 @@ structure IM = IntBinaryMap structure SK = struct type ord_key = string val compare = String.compare end structure SS = BinarySetFn(SK) structure SM = BinaryMapFn(SK) +structure IIMM = MultimapFn(structure KeyMap = IM structure ValSet = IS) structure SIMM = MultimapFn(structure KeyMap = SM structure ValSet = IS) -(* ASK: how do we deal with heap reallocation? *) - fun id x = x fun iterate f n x = if n < 0 @@ -20,6 +22,35 @@ fun iterate f n x = if n < 0 then x else iterate f (n-1) (f x) +(* From the MLton wiki. *) +infix 3 <\ fun x <\ f = fn y => f (x, y) (* Left section *) +infix 3 \> fun f \> y = f y (* Left application *) + +fun mapFst f (x, y) = (f x, y) + +(* Option monad. *) +fun obind (x, f) = Option.mapPartial f x +fun oguard (b, x) = if b then x else NONE +fun omap f = fn SOME x => SOME (f x) | _ => NONE +fun omap2 f = fn (SOME x, SOME y) => SOME (f (x,y)) | _ => NONE +fun osequence ys = List.foldr (omap2 op::) (SOME []) ys + +fun indexOf test = + let + fun f n = + fn [] => NONE + | (x::xs) => if test x then SOME n else f (n+1) xs + in + f 0 + end + + +(************) +(* Settings *) +(************) + +open Mono + (* Filled in by [addFlushing]. *) val ffiInfoRef : {index : int, params : int} list ref = ref [] @@ -59,6 +90,11 @@ val alwaysConsolidateRef = ref true fun setAlwaysConsolidate b = alwaysConsolidateRef := b fun getAlwaysConsolidate () = !alwaysConsolidateRef + +(************************) +(* Really Useful Things *) +(************************) + (* Used to have type context for local variables in MonoUtil functions. *) val doBind = fn (env, MonoUtil.Exp.RelE (x, t)) => MonoEnv.pushERel env x t NONE @@ -79,36 +115,26 @@ fun obindDebug printer (x, f) = NONE => (printer (); NONE) | y => y -(*********************) -(* General Utilities *) -(*********************) - -(* From the MLton wiki. *) -infix 3 <\ fun x <\ f = fn y => f (x, y) (* Left section *) -infix 3 \> fun f \> y = f y (* Left application *) -fun mapFst f (x, y) = (f x, y) - -(* Option monad. *) -fun obind (x, f) = Option.mapPartial f x -fun oguard (b, x) = if b then x else NONE -fun omap f = fn SOME x => SOME (f x) | _ => NONE -fun omap2 f = fn (SOME x, SOME y) => SOME (f (x,y)) | _ => NONE -fun osequence ys = List.foldr (omap2 op::) (SOME []) ys +(*******************) +(* Effect Analysis *) +(*******************) -fun indexOf test = +(* TODO: test this. *) +fun transitiveAnalysis doVal state (decls, _) = let - fun f n = - fn [] => NONE - | (x::xs) => if test x then SOME n else f (n+1) xs + val doDecl = + fn ((DVal v, _), state) => doVal (v, state) + (* Pass over the list of values a number of times equal to its size, + making sure whatever property we're testing propagates everywhere + it should. This is analagous to the Bellman-Ford algorithm. *) + | ((DValRec vs, _), state) => + iterate (fn state => List.foldl doVal state vs) (length vs) state + | (_, state) => state in - f 0 + List.foldl doDecl state decls end -(*******************) -(* Effect Analysis *) -(*******************) - (* Makes an exception for [EWrite] (which is recorded when caching). *) fun effectful (effs : IS.set) = let @@ -151,24 +177,13 @@ fun effectful (effs : IS.set) = end (* TODO: test this. *) -fun effectfulDecls (decls, _) = - let - fun doVal ((_, name, _, e, _), effs) = - if effectful effs MonoEnv.empty e - then IS.add (effs, name) - else effs - val doDecl = - fn ((DVal v, _), effs) => doVal (v, effs) - (* Repeat the list of declarations a number of times equal to its size, - making sure effectfulness propagates everywhere it should. This is - analagous to the Bellman-Ford algorithm. *) - | ((DValRec vs, _), effs) => - List.foldl doVal effs (List.concat (List.map (fn _ => vs) vs)) - (* ASK: any other cases? *) - | (_, effs) => effs - in - List.foldl doDecl IS.empty decls - end +fun effectfulDecls file = + transitiveAnalysis (fn ((_, name, _, e, _), effs) => + if effectful effs MonoEnv.empty e + then IS.add (effs, name) + else effs) + IS.empty + file (*********************************) @@ -1080,9 +1095,7 @@ fun typOfExp' (env : MonoEnv.env) : exp' -> typ option = | ERecord fields => SOME (TRecord (map (fn (s, _, t) => (s, t)) fields), dummyLoc) | EField (e, s) => (case typOfExp env e of SOME (TRecord fields, _) => - (case List.find (fn (s', _) => s = s') fields of - SOME (_, t) => SOME t - | _ => NONE) + omap #2 (List.find (fn (s', _) => s = s') fields) | _ => NONE) | ECase (_, _, {result, ...}) => SOME result | EStrcat _ => SOME (TFfi ("Basis", "string"), dummyLoc) @@ -1414,6 +1427,46 @@ fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state end +(***********) +(* Locking *) +(***********) + +(* TODO: do this less evil-ly by not relying on specific FFI names, please? *) +fun locksNeeded file = + transitiveAnalysis + (fn ((_, name, _, e, _), state) => + MonoUtil.Exp.fold + {typ = #2, + exp = fn (EFfiApp ("Sqlcache", x, _), state as {store, flush}) => + (case Int.fromString (String.extract (x, 5, NONE)) of + NONE => raise Match + | SOME index => + if String.isPrefix "store" x + then {store = IIMM.insert (store, name, index), flush = flush} + else if String.isPrefix "flush" x + then {store = store, flush = IIMM.insert (flush, name, index)} + else state) + | _ => state} + state + e) + {store = IIMM.empty, flush = IIMM.empty} + file + +fun exports (decls, _) = + List.foldl (fn ((DExport (_, _, n, _, _, _), _), ns) => IS.add (ns, n) + | ((DTask _, _), _) => raise Fail "Sqlcache doesn't yet support tasks." + | (_, ns) => ns) + IS.empty + decls + +(* fun addLocking file = *) +(* let *) +(* val whichLocks = locksNeeded file *) +(* val needsLocks = exports file *) +(* in *) + +(* end *) + (************************) (* Compiler Entry Point *) (************************) diff --git a/src/toy_cache.sml b/src/toy_cache.sml index 377cae01..5c5aa459 100644 --- a/src/toy_cache.sml +++ b/src/toy_cache.sml @@ -24,6 +24,9 @@ fun store (index, keys, value) = fun flush (index, keys) = ffiAppCache' ("flush", index, withTyp optionStringTyp keys) +fun lock (index, keys) = + raise Fail "ToyCache doesn't yet implement lock" + (* Cjr *) @@ -198,7 +201,7 @@ val setupGlobal = string "/* No global setup for toy cache. */" (* Bundled up. *) -val cache = {check = check, store = store, flush = flush, +val cache = {check = check, store = store, flush = flush, lock = lock, setupQuery = setupQuery, setupGlobal = setupGlobal} end -- cgit v1.2.3 From d67e2a35789c5e4c7ad603c15d2acdc826fcdc76 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 13 Nov 2015 01:05:22 -0500 Subject: Remove debugging print statement. --- src/c/urweb.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 02e17a0b..778adacc 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4713,7 +4713,6 @@ void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { time_t timeNow = uw_Sqlcache_getTimeNow(cache); uw_Sqlcache_Entry *entry; if (numKeys == 0) { - puts("flush cache of height 0"); entry = cache->table; if (entry) { uw_Sqlcache_freeValue(entry->value); -- cgit v1.2.3 From bad52a2868ff0551ac0199fd8124f81f9623391e Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 13 Nov 2015 11:03:09 -0500 Subject: Finish locking, but it's not yet tested rigorously. --- include/urweb/types_cpp.h | 3 +- include/urweb/urweb_cpp.h | 2 + src/c/urweb.c | 143 ++++++++++++++++++++++++++++++---------------- src/lru_cache.sml | 20 ++++++- src/sqlcache.sml | 51 ++++++++++++----- 5 files changed, 154 insertions(+), 65 deletions(-) (limited to 'src/c/urweb.c') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 82f8d30a..ce0f2825 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -133,7 +133,8 @@ typedef struct uw_Sqlcache_Value { typedef struct uw_Sqlcache_Entry uw_Sqlcache_Entry; typedef struct uw_Sqlcache_Cache { - pthread_rwlock_t lock; + pthread_rwlock_t lockOut; + pthread_rwlock_t lockIn; uw_Sqlcache_Entry *table; unsigned long timeInvalid; unsigned long timeNow; diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 2c032e7b..916fbbf9 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -406,6 +406,8 @@ void uw_Basis_writec(struct uw_context *, char); // Sqlcache. +void *uw_Sqlcache_rlock(struct uw_context *, uw_Sqlcache_Cache *); +void *uw_Sqlcache_wlock(struct uw_context *, uw_Sqlcache_Cache *); uw_Sqlcache_Value *uw_Sqlcache_check(struct uw_context *, uw_Sqlcache_Cache *, char **); void *uw_Sqlcache_store(struct uw_context *, uw_Sqlcache_Cache *, char **, uw_Sqlcache_Value *); void *uw_Sqlcache_flush(struct uw_context *, uw_Sqlcache_Cache *, char **); diff --git a/src/c/urweb.c b/src/c/urweb.c index 778adacc..6a48e95e 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -366,6 +366,9 @@ void uw_global_init() { uw_global_custom(); uw_init_crypto(); + + // Fast non-cryptographic strength randomness for Sqlcache. + srandom(clock()); } void uw_app_init(uw_app *app) { @@ -431,6 +434,11 @@ typedef struct uw_Sqlcache_Update { struct uw_Sqlcache_Update *next; } uw_Sqlcache_Update; +typedef struct uw_Sqlcache_Unlock { + pthread_rwlock_t *lock; + struct uw_Sqlcache_Unlock *next; +} uw_Sqlcache_Unlock; + struct uw_context { uw_app *app; int id; @@ -500,6 +508,7 @@ struct uw_context { int recordingOffset; uw_Sqlcache_Update *cacheUpdate; uw_Sqlcache_Update *cacheUpdateTail; + uw_Sqlcache_Unlock *cacheUnlock; int remoteSock; }; @@ -4556,7 +4565,7 @@ typedef struct uw_Sqlcache_Entry { UT_hash_handle hh; } uw_Sqlcache_Entry; -void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) { +static void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) { if (value) { free(value->result); free(value->output); @@ -4564,7 +4573,7 @@ void uw_Sqlcache_freeValue(uw_Sqlcache_Value *value) { } } -void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) { +static void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) { if (entry) { free(entry->key); uw_Sqlcache_freeValue(entry->value); @@ -4573,14 +4582,14 @@ void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) { } // TODO: pick a number. -unsigned int uw_Sqlcache_maxSize = 1234567890; +static unsigned int uw_Sqlcache_maxSize = 1234567890; -void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry) { +static void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry) { HASH_DEL(cache->table, entry); uw_Sqlcache_freeEntry(entry); } -uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t len, int bump) { +static uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t len, int bump) { uw_Sqlcache_Entry *entry = NULL; HASH_FIND(hh, cache->table, key, len, entry); if (entry && bump) { @@ -4592,7 +4601,7 @@ uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t return entry; } -void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, size_t len) { +static void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, size_t len) { HASH_ADD_KEYPTR(hh, cache->table, entry->key, len, entry); if (HASH_COUNT(cache->table) > uw_Sqlcache_maxSize) { // Deletes the first element of the cache. @@ -4600,17 +4609,17 @@ void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, size_t } } -unsigned long uw_Sqlcache_getTimeNow(uw_Sqlcache_Cache *cache) { +static unsigned long uw_Sqlcache_getTimeNow(uw_Sqlcache_Cache *cache) { return ++cache->timeNow; } -unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) { +static unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) { return x > y ? x : y; } -char uw_Sqlcache_keySep = '_'; +static char uw_Sqlcache_keySep = '_'; -char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) { +static char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) { size_t len = 0; while (numKeys-- > 0) { char* k = keys[numKeys]; @@ -4627,7 +4636,7 @@ char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) { return buf; } -char *uw_Sqlcache_keyCopy(char *buf, char *key) { +static char *uw_Sqlcache_keyCopy(char *buf, char *key) { *buf++ = uw_Sqlcache_keySep; return stpcpy(buf, key); } @@ -4635,7 +4644,12 @@ char *uw_Sqlcache_keyCopy(char *buf, char *key) { // The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn". uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { - pthread_rwlock_rdlock(&cache->lock); + int doBump = random() % 1024 == 0; + if (doBump) { + pthread_rwlock_wrlock(&cache->lockIn); + } else { + pthread_rwlock_rdlock(&cache->lockIn); + } size_t numKeys = cache->numKeys; char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; @@ -4645,46 +4659,49 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, c entry = cache->table; if (!entry) { free(key); - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); return NULL; } } else { while (numKeys-- > 0) { buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); size_t len = buf - key; - entry = uw_Sqlcache_find(cache, key, len, 1); + entry = uw_Sqlcache_find(cache, key, len, doBump); if (!entry) { free(key); - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); return NULL; } timeInvalid = uw_Sqlcache_timeMax(timeInvalid, entry->timeInvalid); } free(key); } - // TODO: pass back copy of value and free it in the generated code... or use uw_malloc? uw_Sqlcache_Value *value = entry->value; - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); + // ASK: though the argument isn't trivial, this is safe, right? + // Returning outside the lock is safe because updates happen at commit time. + // Those are the only times the returned value or its strings can get freed. + // Handler output is a new string, so it's safe to free this at commit time. return value && value->timeValid > timeInvalid ? value : NULL; } -void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { - pthread_rwlock_wrlock(&cache->lock); +static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { + pthread_rwlock_wrlock(&cache->lockIn); size_t numKeys = cache->numKeys; - char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); - char *buf = key; time_t timeNow = uw_Sqlcache_getTimeNow(cache); uw_Sqlcache_Entry *entry; if (numKeys == 0) { entry = cache->table; if (!entry) { entry = malloc(sizeof(uw_Sqlcache_Entry)); - entry->key = strdup(key); + entry->key = NULL; entry->value = NULL; entry->timeInvalid = 0; cache->table = entry; } } else { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; while (numKeys-- > 0) { buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); size_t len = buf - key; @@ -4702,23 +4719,23 @@ void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcac uw_Sqlcache_freeValue(entry->value); entry->value = value; entry->value->timeValid = timeNow; - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); } -void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { - pthread_rwlock_wrlock(&cache->lock); +static void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { + pthread_rwlock_wrlock(&cache->lockIn); size_t numKeys = cache->numKeys; - char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); - char *buf = key; - time_t timeNow = uw_Sqlcache_getTimeNow(cache); - uw_Sqlcache_Entry *entry; if (numKeys == 0) { - entry = cache->table; + uw_Sqlcache_Entry *entry = cache->table; if (entry) { uw_Sqlcache_freeValue(entry->value); entry->value = NULL; } } else { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; + time_t timeNow = uw_Sqlcache_getTimeNow(cache); + uw_Sqlcache_Entry *entry = NULL; while (numKeys-- > 0) { char *k = keys[numKeys]; if (!k) { @@ -4729,15 +4746,16 @@ void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { cache->timeInvalid = timeNow; } free(key); - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); return; } buf = uw_Sqlcache_keyCopy(buf, k); size_t len = buf - key; entry = uw_Sqlcache_find(cache, key, len, 0); if (!entry) { + // Nothing in the cache to flush. free(key); - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); return; } } @@ -4745,10 +4763,25 @@ void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { // All the keys were non-null and the relevant entry is present, so we delete it. uw_Sqlcache_delete(cache, entry); } - pthread_rwlock_unlock(&cache->lock); + pthread_rwlock_unlock(&cache->lockIn); +} + +static void uw_Sqlcache_commit(void *data) { + uw_context ctx = (uw_context)data; + uw_Sqlcache_Update *update = ctx->cacheUpdate; + while (update) { + uw_Sqlcache_Cache *cache = update->cache; + char **keys = update->keys; + if (update->value) { + uw_Sqlcache_storeCommitOne(cache, keys, update->value); + } else { + uw_Sqlcache_flushCommitOne(cache, keys); + } + update = update->next; + } } -void uw_Sqlcache_freeUpdate(void *data, int dontCare) { +static void uw_Sqlcache_free(void *data, int dontCare) { uw_context ctx = (uw_context)data; uw_Sqlcache_Update *update = ctx->cacheUpdate; while (update) { @@ -4765,24 +4798,38 @@ void uw_Sqlcache_freeUpdate(void *data, int dontCare) { } ctx->cacheUpdate = NULL; ctx->cacheUpdateTail = NULL; + uw_Sqlcache_Unlock *unlock = ctx->cacheUnlock; + while (unlock) { + pthread_rwlock_unlock(unlock->lock); + uw_Sqlcache_Unlock *nextUnlock = unlock->next; + free(unlock); + unlock = nextUnlock; + } + ctx->cacheUnlock = NULL; } -void uw_Sqlcache_commitUpdate(void *data) { - uw_context ctx = (uw_context)data; - uw_Sqlcache_Update *update = ctx->cacheUpdate; - while (update) { - uw_Sqlcache_Cache *cache = update->cache; - char **keys = update->keys; - if (update->value) { - uw_Sqlcache_storeCommitOne(cache, keys, update->value); - } else { - uw_Sqlcache_flushCommitOne(cache, keys); - } - update = update->next; +static void uw_Sqlcache_pushUnlock(uw_context ctx, pthread_rwlock_t *lock) { + if (!ctx->cacheUnlock) { + // Just need one registered commit for both updating and unlocking. + uw_register_transactional(ctx, ctx, uw_Sqlcache_commit, NULL, uw_Sqlcache_free); } + uw_Sqlcache_Unlock *unlock = malloc(sizeof(uw_Sqlcache_Unlock)); + unlock->lock = lock; + unlock->next = ctx->cacheUnlock; + ctx->cacheUnlock = unlock; +} + +void uw_Sqlcache_rlock(uw_context ctx, uw_Sqlcache_Cache *cache) { + pthread_rwlock_rdlock(&cache->lockOut); + uw_Sqlcache_pushUnlock(ctx, &cache->lockOut); +} + +void uw_Sqlcache_wlock(uw_context ctx, uw_Sqlcache_Cache *cache) { + pthread_rwlock_wrlock(&cache->lockOut); + uw_Sqlcache_pushUnlock(ctx, &cache->lockOut); } -char **uw_Sqlcache_copyKeys(char **keys, size_t numKeys) { +static char **uw_Sqlcache_copyKeys(char **keys, size_t numKeys) { char **copy = malloc(sizeof(char *) * numKeys); while (numKeys-- > 0) { char *k = keys[numKeys]; @@ -4798,11 +4845,9 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw update->value = value; update->next = NULL; if (ctx->cacheUpdateTail) { - // An update is already registered, so just extend it. ctx->cacheUpdateTail->next = update; } else { ctx->cacheUpdate = update; - uw_register_transactional(ctx, ctx, uw_Sqlcache_commitUpdate, NULL, uw_Sqlcache_freeUpdate); } ctx->cacheUpdateTail = update; } diff --git a/src/lru_cache.sml b/src/lru_cache.sml index b66becb7..0276de91 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -69,7 +69,9 @@ fun setupQuery {index, params} = Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), newline, - string " .lock = PTHREAD_RWLOCK_INITIALIZER,", + string " .lockIn = PTHREAD_RWLOCK_INITIALIZER,", + newline, + string " .lockOut = PTHREAD_RWLOCK_INITIALIZER,", newline, string " .table = NULL,", newline, @@ -83,6 +85,22 @@ fun setupQuery {index, params} = newline, newline, + string ("static void uw_Sqlcache_rlock" ^ i ^ "(uw_context ctx) {"), + newline, + string (" uw_Sqlcache_rlock(ctx, cache" ^ i ^ ");"), + newline, + string "}", + newline, + newline, + + string ("static void uw_Sqlcache_wlock" ^ i ^ "(uw_context ctx) {"), + newline, + string (" uw_Sqlcache_wlock(ctx, cache" ^ i ^ ");"), + newline, + string "}", + newline, + newline, + string ("static uw_Basis_string uw_Sqlcache_check" ^ i), string ("(uw_context ctx" ^ typedArgs ^ ") {"), newline, diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 2b3b80ae..6583dc91 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -913,7 +913,7 @@ val conflictMaps = ConflictMaps.conflictMaps (* Program Instrumentation Utilities *) (*************************************) -val {check, store, flush, ...} = getCache () +val {check, store, flush, lock, ...} = getCache () val dummyTyp = (TRecord [], dummyLoc) @@ -1431,7 +1431,7 @@ fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state (* Locking *) (***********) -(* TODO: do this less evil-ly by not relying on specific FFI names, please? *) +(* TODO: do this less evilly by not relying on specific FFI names, please? *) fun locksNeeded file = transitiveAnalysis (fn ((_, name, _, e, _), state) => @@ -1439,14 +1439,14 @@ fun locksNeeded file = {typ = #2, exp = fn (EFfiApp ("Sqlcache", x, _), state as {store, flush}) => (case Int.fromString (String.extract (x, 5, NONE)) of - NONE => raise Match + NONE => state | SOME index => - if String.isPrefix "store" x - then {store = IIMM.insert (store, name, index), flush = flush} - else if String.isPrefix "flush" x + if String.isPrefix "flush" x then {store = store, flush = IIMM.insert (flush, name, index)} + else if String.isPrefix "store" x + then {store = IIMM.insert (store, name, index), flush = flush} else state) - | _ => state} + | (_, state) => state} state e) {store = IIMM.empty, flush = IIMM.empty} @@ -1459,13 +1459,36 @@ fun exports (decls, _) = IS.empty decls -(* fun addLocking file = *) -(* let *) -(* val whichLocks = locksNeeded file *) -(* val needsLocks = exports file *) -(* in *) +fun wrapLocks (locks, (exp', loc)) = + case exp' of + EAbs (s, t1, t2, exp) => (EAbs (s, t1, t2, wrapLocks (locks, exp)), loc) + | _ => (List.foldr (fn (l, e') => sequence [lock l, e']) exp' locks, loc) + +fun addLocking file = + let + val {store, flush} = locksNeeded file + fun locks n = + let + val wlocks = IIMM.findSet (flush, n) + val rlocks = IIMM.findSet (store, n) + val ls = map (fn i => (i, true)) (IS.listItems wlocks) + @ map (fn i => (i, false)) (IS.listItems (IS.difference (rlocks, wlocks))) + in + ListMergeSort.sort (fn ((i, _), (j, _)) => i > j) ls + end + val expts = exports file + fun doVal (v as (x, n, t, exp, s)) = + if IS.member (expts, n) + then (x, n, t, wrapLocks ((locks n), exp), s) + else v + val doDecl = + fn (DVal v, loc) => (DVal (doVal v), loc) + | (DValRec vs, loc) => (DValRec (map doVal vs), loc) + | decl => decl + in + mapFst (map doDecl) file + end -(* end *) (************************) (* Compiler Entry Point *) @@ -1494,7 +1517,7 @@ fun insertAfterDatatypes ((decls, sideInfo), newDecls) = (datatypes @ newDecls @ others, sideInfo) end -val go' = addFlushing o addCaching o simplifySql o inlineSql +val go' = addLocking o addFlushing o addCaching o simplifySql o inlineSql fun go file = let -- cgit v1.2.3 From 39804bcf37a35ca6a2cb5e49849ce9453c9025bc Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Tue, 17 Nov 2015 02:44:37 -0500 Subject: Make cache flushes happen immediately instead of at end of transaction. --- src/c/urweb.c | 90 ++++++++++++++++++++++++++++---------------------------- src/sqlcache.sml | 2 +- 2 files changed, 46 insertions(+), 46 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 6a48e95e..c1cfe94c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4585,8 +4585,10 @@ static void uw_Sqlcache_freeEntry(uw_Sqlcache_Entry* entry) { static unsigned int uw_Sqlcache_maxSize = 1234567890; static void uw_Sqlcache_delete(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry) { - HASH_DEL(cache->table, entry); - uw_Sqlcache_freeEntry(entry); + if (entry) { + HASH_DEL(cache->table, entry); + uw_Sqlcache_freeEntry(entry); + } } static uw_Sqlcache_Entry *uw_Sqlcache_find(uw_Sqlcache_Cache *cache, char *key, size_t len, int bump) { @@ -4723,47 +4725,6 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw } static void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { - pthread_rwlock_wrlock(&cache->lockIn); - size_t numKeys = cache->numKeys; - if (numKeys == 0) { - uw_Sqlcache_Entry *entry = cache->table; - if (entry) { - uw_Sqlcache_freeValue(entry->value); - entry->value = NULL; - } - } else { - char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); - char *buf = key; - time_t timeNow = uw_Sqlcache_getTimeNow(cache); - uw_Sqlcache_Entry *entry = NULL; - while (numKeys-- > 0) { - char *k = keys[numKeys]; - if (!k) { - if (entry) { - entry->timeInvalid = timeNow; - } else { - // Haven't found an entry yet, so the first key was null. - cache->timeInvalid = timeNow; - } - free(key); - pthread_rwlock_unlock(&cache->lockIn); - return; - } - buf = uw_Sqlcache_keyCopy(buf, k); - size_t len = buf - key; - entry = uw_Sqlcache_find(cache, key, len, 0); - if (!entry) { - // Nothing in the cache to flush. - free(key); - pthread_rwlock_unlock(&cache->lockIn); - return; - } - } - free(key); - // All the keys were non-null and the relevant entry is present, so we delete it. - uw_Sqlcache_delete(cache, entry); - } - pthread_rwlock_unlock(&cache->lockIn); } static void uw_Sqlcache_commit(void *data) { @@ -4853,6 +4814,45 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw } void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { - // A flush is represented in the queue as storing NULL. - uw_Sqlcache_store(ctx, cache, keys, NULL); + // A flush has to happen immediately so that subsequent stores in the same transaction fail. + // This is safe to do because we will always call [uw_Sqlcache_wlock] earlier. + // If the transaction fails, the only harm done is a few extra cache misses. + pthread_rwlock_wrlock(&cache->lockIn); + size_t numKeys = cache->numKeys; + if (numKeys == 0) { + uw_Sqlcache_Entry *entry = cache->table; + if (entry) { + uw_Sqlcache_freeValue(entry->value); + entry->value = NULL; + } + } else { + char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); + char *buf = key; + time_t timeNow = uw_Sqlcache_getTimeNow(cache); + while (numKeys-- > 0) { + char *k = keys[numKeys]; + if (!k) { + size_t len = buf - key; + if (len == 0) { + // The first key was null. + cache->timeInvalid = timeNow; + } else { + uw_Sqlcache_Entry *entry = uw_Sqlcache_find(cache, key, len, 0); + if (entry) { + entry->timeInvalid = timeNow; + } + } + free(key); + pthread_rwlock_unlock(&cache->lockIn); + return; + } + buf = uw_Sqlcache_keyCopy(buf, k); + } + // All the keys were non-null, so we delete the pointed-to entry. + size_t len = buf - key; + uw_Sqlcache_Entry *entry = uw_Sqlcache_find(cache, key, len, 0); + free(key); + uw_Sqlcache_delete(cache, entry); + } + pthread_rwlock_unlock(&cache->lockIn); } diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 481acbeb..a8ef647b 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -1,4 +1,4 @@ -structure Sqlcache (* DEBUG :> SQLCACHE *) = struct +structure Sqlcache :> SQLCACHE = struct (*********************) -- cgit v1.2.3 From 7a49a90f8b092e1c2e58d3e754578cff3bf06b18 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 19 Nov 2015 10:31:47 -0500 Subject: Fix a few C memory bugs --- src/c/urweb.c | 10 ++++++---- src/lru_cache.sml | 16 +++++++++------- 2 files changed, 15 insertions(+), 11 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index c1cfe94c..945a6890 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -602,6 +602,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->remoteSock = -1; + ctx->cacheUnlock = NULL; + return ctx; } @@ -3681,7 +3683,7 @@ failure_kind uw_initialize(uw_context ctx) { if (r == 0) { uw_ensure_transaction(ctx); ctx->app->initializer(ctx); - if (ctx->app->db_commit(ctx)) + if (uw_commit(ctx)) uw_error(ctx, FATAL, "Error running SQL COMMIT"); } @@ -4626,7 +4628,7 @@ static char *uw_Sqlcache_allocKeyBuffer(char **keys, size_t numKeys) { while (numKeys-- > 0) { char* k = keys[numKeys]; if (!k) { - // Can only happen when flushihg, in which case we don't need anything past the null key. + // Can only happen when flushing, in which case we don't need anything past the null key. break; } // Leave room for separator. @@ -4695,7 +4697,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw if (numKeys == 0) { entry = cache->table; if (!entry) { - entry = malloc(sizeof(uw_Sqlcache_Entry)); + entry = calloc(1, sizeof(uw_Sqlcache_Entry)); entry->key = NULL; entry->value = NULL; entry->timeInvalid = 0; @@ -4709,7 +4711,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw size_t len = buf - key; entry = uw_Sqlcache_find(cache, key, len, 1); if (!entry) { - entry = malloc(sizeof(uw_Sqlcache_Entry)); + entry = calloc(1, sizeof(uw_Sqlcache_Entry)); entry->key = strdup(key); entry->value = NULL; entry->timeInvalid = 0; diff --git a/src/lru_cache.sml b/src/lru_cache.sml index e9ed5f73..5c05b261 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -111,16 +111,16 @@ fun setupQuery {index, params} = (* If the output is null, it means we had too much recursion, so it's a miss. *) string " if (v && v->output != NULL) {", newline, - (* string (" puts(\"SQLCACHE: hit " ^ i ^ ".\");"), *) - (* newline, *) + (*string (" puts(\"SQLCACHE: hit " ^ i ^ ".\");"), + newline,*) string " uw_write(ctx, v->output);", newline, string " return v->result;", newline, string " } else {", newline, - (* string (" puts(\"SQLCACHE: miss " ^ i ^ ".\");"), *) - (* newline, *) + (*string (" puts(\"SQLCACHE: miss " ^ i ^ ".\");"), + newline,*) string " uw_recordingStart(ctx);", newline, string " return NULL;", @@ -136,14 +136,16 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_Value *v = malloc(sizeof(uw_Sqlcache_Value));"), + string (" uw_Sqlcache_Value *v = calloc(1, sizeof(uw_Sqlcache_Value));"), newline, string " v->result = strdup(s);", newline, string " v->output = uw_recordingRead(ctx);", newline, - (* string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), *) - (* newline, *) + string " v->timeValid = 0;", + newline, + (*string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), + newline,*) string (" uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"), newline, string " return uw_unit_v;", -- cgit v1.2.3 From 30dd885d1fc3013be0e3c2a45b2e0117f684f40a Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 19 Nov 2015 13:18:58 -0500 Subject: Fix a read-after-free bug using a timestamp check --- src/c/urweb.c | 9 ++++++--- src/lru_cache.sml | 4 +--- 2 files changed, 7 insertions(+), 6 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 945a6890..093a5294 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4720,9 +4720,11 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw } free(key); } - uw_Sqlcache_freeValue(entry->value); - entry->value = value; - entry->value->timeValid = timeNow; + if (entry->value && entry->value->timeValid < value->timeValid) { + uw_Sqlcache_freeValue(entry->value); + entry->value = value; + entry->value->timeValid = timeNow; + } pthread_rwlock_unlock(&cache->lockIn); } @@ -4807,6 +4809,7 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw update->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys); update->value = value; update->next = NULL; + value->timeValid = uw_Sqlcache_getTimeNow(cache); if (ctx->cacheUpdateTail) { ctx->cacheUpdateTail->next = update; } else { diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 5c05b261..851b4ccb 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -136,14 +136,12 @@ fun setupQuery {index, params} = newline, string (" char *ks[] = {" ^ revArgs ^ "};"), newline, - string (" uw_Sqlcache_Value *v = calloc(1, sizeof(uw_Sqlcache_Value));"), + string (" uw_Sqlcache_Value *v = malloc(sizeof(uw_Sqlcache_Value));"), newline, string " v->result = strdup(s);", newline, string " v->output = uw_recordingRead(ctx);", newline, - string " v->timeValid = 0;", - newline, (*string (" puts(\"SQLCACHE: stored " ^ i ^ ".\");"), newline,*) string (" uw_Sqlcache_store(ctx, cache" ^ i ^ ", ks, v);"), -- cgit v1.2.3 From 027ffcf5b2e3f71a42857547b17b0824d38a3f85 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 19 Nov 2015 16:02:04 -0500 Subject: Fix condition for installing new cache entries --- src/c/urweb.c | 26 +++++++++++++++----------- src/lru_cache.sml | 10 +++++++++- tests/fib.ur | 10 ++++++++++ 3 files changed, 34 insertions(+), 12 deletions(-) create mode 100644 tests/fib.ur (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 093a5294..54135666 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -504,8 +504,8 @@ struct uw_context { size_t output_buffer_size; // Sqlcache. - int numRecording; - int recordingOffset; + int numRecording, recordingCapacity; + int *recordingOffsets; uw_Sqlcache_Update *cacheUpdate; uw_Sqlcache_Update *cacheUpdateTail; uw_Sqlcache_Unlock *cacheUnlock; @@ -596,7 +596,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->output_buffer_size = 1; ctx->numRecording = 0; - ctx->recordingOffset = 0; + ctx->recordingCapacity = 0; + ctx->recordingOffsets = malloc(0); ctx->cacheUpdate = NULL; ctx->cacheUpdateTail = NULL; @@ -669,6 +670,8 @@ void uw_free(uw_context ctx) { free(ctx->output_buffer); + free(ctx->recordingOffsets); + free(ctx); } @@ -692,6 +695,7 @@ void uw_reset_keep_error_message(uw_context ctx) { ctx->usedSig = 0; ctx->needsResig = 0; ctx->remoteSock = -1; + ctx->numRecording = 0; } void uw_reset_keep_request(uw_context ctx) { @@ -1739,17 +1743,16 @@ void uw_write(uw_context ctx, const char* s) { } void uw_recordingStart(uw_context ctx) { - if (ctx->numRecording++ == 0) { - ctx->recordingOffset = ctx->page.front - ctx->page.start; + if (ctx->numRecording == ctx->recordingCapacity) { + ++ctx->recordingCapacity; + ctx->recordingOffsets = realloc(ctx->recordingOffsets, sizeof(int) * ctx->recordingCapacity); } + ctx->recordingOffsets[ctx->numRecording] = ctx->page.front - ctx->page.start; + ++ctx->numRecording; } char *uw_recordingRead(uw_context ctx) { - // Only the outermost recorder can read unless the recording is empty. - char *recording = ctx->page.start + ctx->recordingOffset; - if (--ctx->numRecording > 0 && recording != ctx->page.front) { - return NULL; - } + char *recording = ctx->page.start + ctx->recordingOffsets[--ctx->numRecording]; return strdup(recording); } @@ -4709,6 +4712,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw while (numKeys-- > 0) { buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); size_t len = buf - key; + entry = uw_Sqlcache_find(cache, key, len, 1); if (!entry) { entry = calloc(1, sizeof(uw_Sqlcache_Entry)); @@ -4720,7 +4724,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw } free(key); } - if (entry->value && entry->value->timeValid < value->timeValid) { + if (!entry->value || entry->value->timeValid < value->timeValid) { uw_Sqlcache_freeValue(entry->value); entry->value = value; entry->value->timeValid = timeNow; diff --git a/src/lru_cache.sml b/src/lru_cache.sml index 851b4ccb..81000458 100644 --- a/src/lru_cache.sml +++ b/src/lru_cache.sml @@ -65,6 +65,7 @@ fun setupQuery {index, params} = val revArgs = paramRepeatRev (fn p => "p" ^ p) ", " + val argNums = List.tabulate (params, fn i => "p" ^ Int.toString i) in Print.box [string ("static uw_Sqlcache_Cache cacheStruct" ^ i ^ " = {"), @@ -119,7 +120,12 @@ fun setupQuery {index, params} = newline, string " } else {", newline, - (*string (" puts(\"SQLCACHE: miss " ^ i ^ ".\");"), + (*string (" printf(\"SQLCACHE: miss " ^ i ^ " " ^ String.concatWith ", " (List.tabulate (params, fn _ => "%s")) ^ ".\\n\""), + (case argNums of + [] => Print.box [] + | _ => Print.box [string ", ", + p_list string argNums]), + string ");", newline,*) string " uw_recordingStart(ctx);", newline, @@ -159,6 +165,8 @@ fun setupQuery {index, params} = newline, string (" uw_Sqlcache_flush(ctx, cache" ^ i ^ ", ks);"), newline, + (*string (" puts(\"SQLCACHE: flushed " ^ i ^ ".\");"), + newline,*) string " return uw_unit_v;", newline, string "}", diff --git a/tests/fib.ur b/tests/fib.ur new file mode 100644 index 00000000..9d7fd340 --- /dev/null +++ b/tests/fib.ur @@ -0,0 +1,10 @@ +fun fib n = + if n = 0 then + 0 + else if n = 1 then + 1 + else + fib (n - 1) + fib (n - 2) + +fun main n : transaction page = + return {[fib n]} -- cgit v1.2.3 From 081f815b457cdfe759b733a9adc18aab32127e45 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 20 Nov 2015 10:51:43 -0500 Subject: Tiny concurrency bugfix (race condition on cache->timeNow). --- src/c/urweb.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 54135666..12009f02 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4617,7 +4617,8 @@ static void uw_Sqlcache_add(uw_Sqlcache_Cache *cache, uw_Sqlcache_Entry *entry, } static unsigned long uw_Sqlcache_getTimeNow(uw_Sqlcache_Cache *cache) { - return ++cache->timeNow; + // TODO: verify that this makes time comparisons do the Right Thing. + return cache->timeNow++; } static unsigned long uw_Sqlcache_timeMax(unsigned long x, unsigned long y) { @@ -4689,7 +4690,7 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, c // Returning outside the lock is safe because updates happen at commit time. // Those are the only times the returned value or its strings can get freed. // Handler output is a new string, so it's safe to free this at commit time. - return value && value->timeValid > timeInvalid ? value : NULL; + return value && timeInvalid < value->timeValid ? value : NULL; } static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw_Sqlcache_Value *value) { @@ -4712,7 +4713,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw while (numKeys-- > 0) { buf = uw_Sqlcache_keyCopy(buf, keys[numKeys]); size_t len = buf - key; - + entry = uw_Sqlcache_find(cache, key, len, 1); if (!entry) { entry = calloc(1, sizeof(uw_Sqlcache_Entry)); @@ -4813,7 +4814,8 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw update->keys = uw_Sqlcache_copyKeys(keys, cache->numKeys); update->value = value; update->next = NULL; - value->timeValid = uw_Sqlcache_getTimeNow(cache); + // Can't use [uw_Sqlcache_getTimeNow] because it modifies state and we don't have the lock. + value->timeValid = cache->timeNow; if (ctx->cacheUpdateTail) { ctx->cacheUpdateTail->next = update; } else { -- cgit v1.2.3 From 0271786bacdf9c12a142367a479b24ba111ebd17 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 20 Nov 2015 11:51:14 -0500 Subject: Add read locks around time read in store. --- src/c/urweb.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/c/urweb.c') diff --git a/src/c/urweb.c b/src/c/urweb.c index 12009f02..a6639ef2 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4815,7 +4815,9 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw update->value = value; update->next = NULL; // Can't use [uw_Sqlcache_getTimeNow] because it modifies state and we don't have the lock. + pthread_rwlock_rdlock(&cache->lockIn); value->timeValid = cache->timeNow; + pthread_rwlock_unlock(&cache->lockIn); if (ctx->cacheUpdateTail) { ctx->cacheUpdateTail->next = update; } else { -- cgit v1.2.3