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