1(* 2 * Copyright (C) 2006-2007 XenSource Ltd. 3 * Copyright (C) 2008 Citrix Ltd. 4 * Author Thomas Gazagnaire <thomas.gazagnaire@eu.citrix.com> 5 * 6 * This program is free software; you can redistribute it and/or modify 7 * it under the terms of the GNU Lesser General Public License as published 8 * by the Free Software Foundation; version 2.1 only. with the special 9 * exception on linking described in file LICENSE. 10 * 11 * This program is distributed in the hope that it will be useful, 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 * GNU Lesser General Public License for more details. 15 *) 16 17type t = int 18 19type 'a record = { data: 'a; mutable garbage: bool } 20let int_string_tbl : (int,string record) Hashtbl.t = Hashtbl.create 1024 21let string_int_tbl : (string,int) Hashtbl.t = Hashtbl.create 1024 22 23let created_counter = ref 0 24let used_counter = ref 0 25 26let count = ref 0 27let rec fresh () = 28 if Hashtbl.mem int_string_tbl !count 29 then begin 30 incr count; 31 fresh () 32 end else 33 !count 34 35let new_record v = { data=v; garbage=false } 36 37let of_string name = 38 if Hashtbl.mem string_int_tbl name 39 then begin 40 incr used_counter; 41 Hashtbl.find string_int_tbl name 42 end else begin 43 let i = fresh () in 44 incr created_counter; 45 Hashtbl.add string_int_tbl name i; 46 Hashtbl.add int_string_tbl i (new_record name); 47 i 48 end 49 50let to_string i = 51 (Hashtbl.find int_string_tbl i).data 52 53let mark_all_as_unused () = 54 Hashtbl.iter (fun _ v -> v.garbage <- true) int_string_tbl 55 56let mark_as_used symb = 57 let record1 = Hashtbl.find int_string_tbl symb in 58 record1.garbage <- false 59 60let garbage () = 61 let records = Hashtbl.fold (fun symb record accu -> 62 if record.garbage then (symb, record.data) :: accu else accu 63 ) int_string_tbl [] in 64 let remove (int,string) = 65 Hashtbl.remove int_string_tbl int; 66 Hashtbl.remove string_int_tbl string 67 in 68 created_counter := 0; 69 used_counter := 0; 70 List.iter remove records 71 72let stats () = 73 Hashtbl.length string_int_tbl 74 75let created () = !created_counter 76let used () = !used_counter 77