1(*
2 * Copyright (c) 2017 Citrix Systems Ltd.
3 *
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU Lesser General Public License as published
6 * by the Free Software Foundation; version 2.1 only. with the special
7 * exception on linking described in file LICENSE.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 * GNU Lesser General Public License for more details.
13 *)
14
15type history_record = {
16	con: Connection.t;   (* connection that made a change *)
17	tid: int;            (* transaction id of the change (may be Transaction.none) *)
18	before: Store.t;     (* the store before the change *)
19	after: Store.t;      (* the store after the change *)
20	finish_count: int64; (* the commit-count at which the transaction finished *)
21}
22
23let history : history_record list ref = ref []
24
25(* Called from periodic_ops to ensure we don't discard symbols that are still needed. *)
26(* There is scope for optimisation here, since in consecutive commits one commit's `after`
27 * is the same thing as the next commit's `before`, but not all commits in history are
28 * consecutive. *)
29let mark_symbols () =
30	(* There are gaps where dom0's commits are missing. Otherwise we could assume that
31	 * each element's `before` is the same thing as the next element's `after`
32	 * since the next element is the previous commit *)
33	List.iter (fun hist_rec ->
34			Store.mark_symbols hist_rec.before;
35			Store.mark_symbols hist_rec.after;
36		)
37		!history
38
39(* Keep only enough commit-history to protect the running transactions that we are still tracking *)
40(* There is scope for optimisation here, replacing List.filter with something more efficient,
41 * probably on a different list-like structure. *)
42let trim ?txn () =
43	Transaction.trim_short_running_transactions txn;
44	history := match Transaction.oldest_short_running_transaction () with
45	| None -> [] (* We have no open transaction, so no history is needed *)
46	| Some (_, txn) -> (
47		(* keep records with finish_count recent enough to be relevant *)
48		List.filter (fun r -> r.finish_count > txn.Transaction.start_count) !history
49	)
50
51let end_transaction txn con tid commit =
52	let success = Connection.end_transaction con tid commit in
53	trim ~txn ();
54	success
55
56let push (x: history_record) =
57	let dom = x.con.Connection.dom in
58	match dom with
59	| None -> () (* treat socket connections as always free to conflict *)
60	| Some d -> if not (Domain.is_free_to_conflict d) then history := x :: !history
61
62(* Find the connections from records since commit-count [since] for which [f record] returns [true] *)
63let filter_connections ~ignore ~since ~f =
64	(* The "mem" call is an optimisation, to avoid calling f if we have picked con already. *)
65	(* Using a hash table rather than a list is to optimise the "mem" call. *)
66	List.fold_left (fun acc hist_rec ->
67		if hist_rec.finish_count > since
68		&& not (hist_rec.con == ignore)
69		&& not (Hashtbl.mem acc hist_rec.con)
70		&& f hist_rec
71		then Hashtbl.replace acc hist_rec.con ();
72		acc
73	) (Hashtbl.create 1023) !history
74