(** Common and utility functions. *) (* Memory info command for virtual domains. (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Common & utility functions. *) open Printf let ( +^ ) = Int64.add let ( -^ ) = Int64.sub let ( *^ ) = Int64.mul let ( /^ ) = Int64.div let ( &^ ) = Int64.logand let ( |^ ) = Int64.logor type architecture = | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64 let string_of_architecture = function | I386 -> "i386" | X86_64 -> "x86_64" | IA64 -> "ia64" | PPC -> "ppc" | PPC64 -> "ppc64" | SPARC -> "sparc" | SPARC64 -> "sparc64" let architecture_of_string = function | str when String.length str = 4 && (str.[0] = 'i' || str.[0] = 'I') && (str.[1] >= '3' && str.[1] <= '6') && str.[2] = '8' && str.[3] = '6' -> I386 | "x86_64" | "X86_64" | "x86-64" | "X86-64" -> X86_64 | "ia64" | "IA64" -> IA64 | "ppc" | "PPC" | "ppc32" | "PPC32" -> PPC | "ppc64" | "PPC64" -> PPC64 | "sparc" | "SPARC" | "sparc32" | "SPARC32" -> SPARC | "sparc64" | "SPARC64" -> SPARC64 | str -> failwith (sprintf "architecture_of_string: %s: unknown architecture" str) let endian_of_architecture = function | I386 | X86_64 -> Bitstring.LittleEndian | IA64 -> Bitstring.LittleEndian (* XXX usually? *) | PPC | PPC64 | SPARC | SPARC64 -> Bitstring.BigEndian type wordsize = | W32 | W64 let wordsize_of_architecture = function | I386 -> W32 | X86_64 -> W64 | IA64 -> W64 | PPC -> W32 | PPC64 -> W64 | SPARC -> W32 | SPARC64 -> W64 let bits_of_wordsize = function | W32 -> 32 | W64 -> 64 let bytes_of_wordsize = function | W32 -> 4 | W64 -> 8 (** 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 | [] -> [] | [x] -> [1, x] | x :: y :: xs when x = y -> let rest = loop (y :: xs) in let (count, _), rest = List.hd rest, List.tl rest in (count+1, y) :: rest | x :: xs -> (1, x) :: loop 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%!"