)
!history
+(* Keep only enough commit-history to protect the running transactions that we are still tracking *)
+(* There is scope for optimisation here, replacing List.filter with something more efficient,
+ * probably on a different list-like structure. *)
+let trim () =
+ history := match Transaction.oldest_short_running_transaction () with
+ | None -> [] (* We have no open transaction, so no history is needed *)
+ | Some (_, txn) -> (
+ (* keep records with finish_count recent enough to be relevant *)
+ List.filter (fun r -> r.finish_count > txn.Transaction.start_count) !history
+ )
+
+let end_transaction txn con tid commit =
+ let success = Connection.end_transaction con tid commit in
+ Transaction.end_transaction txn;
+ trim ();
+ success
+
let push (x: history_record) =
let dom = x.con.Connection.dom in
match dom with
false
| Transaction.Full(id, oldstore, cstore) ->
let tid = Connection.start_transaction c cstore in
- let new_t = Transaction.make tid cstore in
+ let new_t = Transaction.make ~internal:true tid cstore in
let con = sprintf "r(%d):%s" id (Connection.get_domstr c) in
let perform_exn (request, response) =
write_access_log ~ty:request.Packet.ty ~tid ~con ~data:request.Packet.data;
in
let success =
let commit = if commit then Some (fun con trans -> transaction_replay con trans domains cons) else None in
- Connection.end_transaction con (Transaction.get_id t) commit in
+ History.end_transaction t con (Transaction.get_id t) commit in
if not success then
raise Transaction_again;
if commit then begin
mutable read_lowpath: Store.Path.t option;
mutable write_lowpath: Store.Path.t option;
}
+let get_id t = match t.ty with No -> none | Full (id, _, _) -> id
let counter = ref 0L
-let make id store =
+(* Scope for optimisation: different data-structure and functions to search/filter it *)
+let short_running_txns = ref []
+
+let oldest_short_running_transaction () =
+ let rec last = function
+ | [] -> None
+ | [x] -> Some x
+ | x :: xs -> last xs
+ in last !short_running_txns
+
+let end_transaction txn =
+ let cutoff = Unix.gettimeofday () -. !Define.conflict_max_history_seconds in
+ short_running_txns := List.filter
+ (function (start_time, tx) -> start_time >= cutoff && tx != txn)
+ !short_running_txns
+
+let make ?(internal=false) id store =
let ty = if id = none then No else Full(id, Store.copy store, store) in
- {
+ let txn = {
ty = ty;
start_count = !counter;
store = if id = none then store else Store.copy store;
operations = [];
read_lowpath = None;
write_lowpath = None;
- }
+ } in
+ if id <> none && not internal then (
+ let now = Unix.gettimeofday () in
+ short_running_txns := (now, txn) :: !short_running_txns
+ );
+ txn
-let get_id t = match t.ty with No -> none | Full (id, _, _) -> id
let get_store t = t.store
let get_paths t = t.paths