X-Git-Url: http://git.annexia.org/?p=virt-mem.git;a=blobdiff_plain;f=lib%2Fvirt_mem_utils.ml;h=a1eab8ffc11366d6ffe4e6a717b2df173b09cdba;hp=db759dd981d3d1af072add3f3c3ba22e84ff787c;hb=2e1de51e35bea53ebece1a6fd6d6970534f4cbe9;hpb=5ce06c3326a2672e82dc656b35eb7a3e6616539a

diff --git a/lib/virt_mem_utils.ml b/lib/virt_mem_utils.ml
index db759dd..a1eab8f 100644
--- a/lib/virt_mem_utils.ml
+++ b/lib/virt_mem_utils.ml
@@ -1,3 +1,4 @@
+(** Common and utility functions. *)
 (* Memory info command for virtual domains.
    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
@@ -57,9 +58,9 @@ let architecture_of_string = function
 		  str)
 
 let endian_of_architecture = function
-  | I386 | X86_64 -> Bitmatch.LittleEndian
-  | IA64 -> Bitmatch.LittleEndian (* XXX usually? *)
-  | PPC | PPC64 | SPARC | SPARC64 -> Bitmatch.BigEndian
+  | I386 | X86_64 -> Bitstring.LittleEndian
+  | IA64 -> Bitstring.LittleEndian (* XXX usually? *)
+  | PPC | PPC64 | SPARC | SPARC64 -> Bitstring.BigEndian
 
 type wordsize =
   | W32 | W64
@@ -78,9 +79,8 @@ let bits_of_wordsize = function
 let bytes_of_wordsize = function
   | W32 -> 4 | W64 -> 8
 
-(* Returns (count, value) in order of highest frequency occurring in the
- * list.
- *)
+(** Returns (count, value) in order of highest frequency occurring in the
+    list. *)
 let frequency xs =
   let xs = List.sort compare xs in
   let rec loop = function
@@ -95,3 +95,72 @@ let frequency xs =
   in
   let xs = loop xs in
   List.rev (List.sort compare xs)
+
+(** Like the Unix uniq(1) command. *)
+let rec uniq ?(cmp = Pervasives.compare) = function
+  | [] -> []
+  | [x] -> [x]
+  | x :: y :: xs when cmp x y = 0 ->
+      uniq (x :: xs)
+  | x :: y :: xs ->
+      x :: uniq (y :: xs)
+
+(** Like the Unix pipeline 'sort|uniq'. *)
+let sort_uniq ?cmp xs =
+  let xs = ExtList.List.sort ?cmp xs in
+  let xs = uniq ?cmp xs in
+  xs
+
+(** Pad a string to a fixed width (from virt-top, but don't truncate). *)
+let pad width str =
+  let n = String.length str in
+  if n >= width then str
+  else (* if n < width then *) str ^ String.make (width-n) ' '
+
+(* Truncate an OCaml string at the first ASCII NUL character, ie. as
+ * if it were a C string.
+ *)
+let truncate_c_string str =
+  try
+    let i = String.index str '\000' in
+    String.sub str 0 i
+  with
+    Not_found -> str
+
+(** General binary tree type.  Data 'a is stored in the leaves and 'b
+    is stored in the nodes. *)
+type ('a,'b) binary_tree =
+  | Leaf of 'a
+  | Node of ('a,'b) binary_tree * 'b * ('a,'b) binary_tree
+
+(** Print out the binary tree in graphviz dot format. *)
+let print_binary_tree leaf_printer node_printer tree =
+  (* Assign a unique, fixed label to each node. *)
+  let label =
+    let i = ref 0 in
+    let hash = Hashtbl.create 13 in
+    fun node ->
+      try Hashtbl.find hash node
+      with Not_found ->
+	let i = incr i; !i in
+	let label = "n" ^ string_of_int i in
+	Hashtbl.add hash node label;
+	label
+  in
+  (* Recursively generate the graphviz file. *)
+  let rec print = function
+    | (Leaf a as leaf) ->
+	eprintf "  %s [shape=box, label=\"%s\"];\n"
+	  (label leaf) (leaf_printer a)
+    | (Node (left,b,right) as node) ->
+	eprintf "  %s [label=\"%s\"];\n"
+	  (label node) (node_printer b);
+	eprintf "  %s -> %s [tailport=sw];\n" (label node) (label left);
+	eprintf "  %s -> %s [tailport=se];\n" (label node) (label right);
+	print left;
+	print right;
+  in
+  eprintf "/* Use 'dot -Tpng foo.dot > foo.png' to convert to a png file. */\n";
+  eprintf "digraph G {\n";
+  print tree;
+  eprintf "}\n%!"