let incr_ops con = con.stat_nb_ops <- con.stat_nb_ops + 1
-let mark_symbols con =
- Hashtbl.iter (fun _ t -> Store.mark_symbols (Transaction.get_store t)) con.transactions
-
let stats con =
Hashtbl.length con.watches, con.stat_nb_ops
let history : history_record list ref = ref []
-(* Called from periodic_ops to ensure we don't discard symbols that are still needed. *)
-(* There is scope for optimisation here, since in consecutive commits one commit's `after`
- * is the same thing as the next commit's `before`, but not all commits in history are
- * consecutive. *)
-let mark_symbols () =
- (* There are gaps where dom0's commits are missing. Otherwise we could assume that
- * each element's `before` is the same thing as the next element's `after`
- * since the next element is the previous commit *)
- List.iter (fun hist_rec ->
- Store.mark_symbols hist_rec.before;
- Store.mark_symbols hist_rec.after;
- )
- !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 exists node childname =
let childname = Symbol.of_string childname in
- List.exists (fun n -> n.name = childname) node.children
+ List.exists (fun n -> Symbol.equal n.name childname) node.children
let find node childname =
let childname = Symbol.of_string childname in
- List.find (fun n -> n.name = childname) node.children
+ List.find (fun n -> Symbol.equal n.name childname) node.children
let replace_child node child nchild =
(* this is the on-steroid version of the filter one-replace one *)
let rec replace_one_in_list l =
match l with
| [] -> []
- | h :: tl when h.name = child.name -> nchild :: tl
+ | h :: tl when Symbol.equal h.name child.name -> nchild :: tl
| h :: tl -> h :: replace_one_in_list tl
in
{ node with children = (replace_one_in_list node.children) }
let rec delete_one_in_list l =
match l with
| [] -> raise Not_found
- | h :: tl when h.name = sym -> tl
+ | h :: tl when Symbol.equal h.name sym -> tl
| h :: tl -> h :: delete_one_in_list tl
in
{ node with children = (delete_one_in_list node.children) }
quota = Quota.copy store.quota;
}
-let mark_symbols store =
- Node.recurse (fun node -> Symbol.mark_as_used node.Node.name) store.root
-
let incr_transaction_coalesce store =
store.stat_transaction_coalesce <- store.stat_transaction_coalesce + 1
let incr_transaction_abort store =
* GNU Lesser General Public License for more details.
*)
-type t = int
+module WeakTable = Weak.Make(struct
+ type t = string
+ let equal (x:string) (y:string) = (x = y)
+ let hash = Hashtbl.hash
+end)
-type 'a record = { data: 'a; mutable garbage: bool }
-let int_string_tbl : (int,string record) Hashtbl.t = Hashtbl.create 1024
-let string_int_tbl : (string,int) Hashtbl.t = Hashtbl.create 1024
+type t = string
-let created_counter = ref 0
-let used_counter = ref 0
+let tbl = WeakTable.create 1024
-let count = ref 0
-let rec fresh () =
- if Hashtbl.mem int_string_tbl !count
- then begin
- incr count;
- fresh ()
- end else
- !count
+let of_string s = WeakTable.merge tbl s
+let to_string s = s
-let new_record v = { data=v; garbage=false }
-
-let of_string name =
- if Hashtbl.mem string_int_tbl name
- then begin
- incr used_counter;
- Hashtbl.find string_int_tbl name
- end else begin
- let i = fresh () in
- incr created_counter;
- Hashtbl.add string_int_tbl name i;
- Hashtbl.add int_string_tbl i (new_record name);
- i
- end
-
-let to_string i =
- (Hashtbl.find int_string_tbl i).data
-
-let mark_all_as_unused () =
- Hashtbl.iter (fun _ v -> v.garbage <- true) int_string_tbl
-
-let mark_as_used symb =
- let record1 = Hashtbl.find int_string_tbl symb in
- record1.garbage <- false
-
-let garbage () =
- let records = Hashtbl.fold (fun symb record accu ->
- if record.garbage then (symb, record.data) :: accu else accu
- ) int_string_tbl [] in
- let remove (int,string) =
- Hashtbl.remove int_string_tbl int;
- Hashtbl.remove string_int_tbl string
- in
- created_counter := 0;
- used_counter := 0;
- List.iter remove records
+let equal a b =
+ (* compare using physical equality, both members have to be part of the above weak table *)
+ a == b
let stats () =
- Hashtbl.length string_int_tbl
-
-let created () = !created_counter
-let used () = !used_counter
+ let len, entries, _, _, _, _ = WeakTable.stats tbl in
+ len, entries
val to_string : t -> string
(** Convert a symbol into a string. *)
-(** {6 Garbage Collection} *)
-
-(** Symbols need to be regulary garbage collected. The following steps should be followed:
-- mark all the knowns symbols as unused (with [mark_all_as_unused]);
-- mark all the symbols really usefull as used (with [mark_as_used]); and
-- finally, call [garbage] *)
-
-val mark_all_as_unused : unit -> unit
-val mark_as_used : t -> unit
-val garbage : unit -> unit
+val equal: t -> t -> bool
+(** Compare two symbols for equality *)
(** {6 Statistics } *)
-val stats : unit -> int
-(** Get the number of used symbols. *)
-
-val created : unit -> int
-(** Returns the number of symbols created since the last GC. *)
+val stats : unit -> int * int
+(** Get the table size and number of entries. *)
-val used : unit -> int
-(** Returns the number of existing symbols used since the last GC *)
let periodic_ops now =
debug "periodic_ops starting";
- (* we garbage collect the string->int dictionary after a sizeable amount of operations,
- * there's no need to be really fast even if we got loose
- * objects since names are often reuse.
- *)
- if Symbol.created () > 1000 || Symbol.used () > 20000
- then begin
- Symbol.mark_all_as_unused ();
- Store.mark_symbols store;
- Connections.iter cons Connection.mark_symbols;
- History.mark_symbols ();
- Symbol.garbage ()
- end;
(* scan all the xs rings as a safenet for ill-behaved clients *)
if !ring_scan_interval >= 0 && now > (!last_scan_time +. float !ring_scan_interval) then
let (lanon, lanon_ops, lanon_watchs,
ldom, ldom_ops, ldom_watchs) = Connections.stats cons in
let store_nodes, store_abort, store_coalesce = Store.stats store in
- let symtbl_len = Symbol.stats () in
+ let symtbl_len, symtbl_entries = Symbol.stats () in
info "store stat: nodes(%d) t-abort(%d) t-coalesce(%d)"
store_nodes store_abort store_coalesce;
- info "sytbl stat: %d" symtbl_len;
+ info "sytbl stat: length(%d) entries(%d)" symtbl_len symtbl_entries;
info " con stat: anonymous(%d, %d o, %d w) domains(%d, %d o, %d w)"
lanon lanon_ops lanon_watchs ldom ldom_ops ldom_watchs;
info " mem stat: minor(%.0f) promoted(%.0f) major(%.0f) heap(%d w, %d c) live(%d w, %d b) free(%d w, %d b)"
projects / xen.git / commitdiff