1 (** Common and utility functions. *)
2 (* Memory info command for virtual domains.
3 (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
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 General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 Common & utility functions.
25 let ( +^ ) = Int64.add
26 let ( -^ ) = Int64.sub
27 let ( *^ ) = Int64.mul
28 let ( /^ ) = Int64.div
29 let ( &^ ) = Int64.logand
30 let ( |^ ) = Int64.logor
33 | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64
35 let string_of_architecture = function
42 | SPARC64 -> "sparc64"
44 let architecture_of_string = function
46 String.length str = 4 &&
47 (str.[0] = 'i' || str.[0] = 'I') &&
48 (str.[1] >= '3' && str.[1] <= '6') &&
49 str.[2] = '8' && str.[3] = '6' -> I386
50 | "x86_64" | "X86_64" | "x86-64" | "X86-64" -> X86_64
51 | "ia64" | "IA64" -> IA64
52 | "ppc" | "PPC" | "ppc32" | "PPC32" -> PPC
53 | "ppc64" | "PPC64" -> PPC64
54 | "sparc" | "SPARC" | "sparc32" | "SPARC32" -> SPARC
55 | "sparc64" | "SPARC64" -> SPARC64
57 failwith (sprintf "architecture_of_string: %s: unknown architecture"
60 let endian_of_architecture = function
61 | I386 | X86_64 -> Bitstring.LittleEndian
62 | IA64 -> Bitstring.LittleEndian (* XXX usually? *)
63 | PPC | PPC64 | SPARC | SPARC64 -> Bitstring.BigEndian
68 let wordsize_of_architecture = function
77 let bits_of_wordsize = function
78 | W32 -> 32 | W64 -> 64
79 let bytes_of_wordsize = function
82 (** Returns (count, value) in order of highest frequency occurring in the
85 let xs = List.sort compare xs in
86 let rec loop = function
89 | x :: y :: xs when x = y ->
90 let rest = loop (y :: xs) in
91 let (count, _), rest = List.hd rest, List.tl rest in
97 List.rev (List.sort compare xs)
99 (** Like the Unix uniq(1) command. *)
100 let rec uniq ?(cmp = Pervasives.compare) = function
103 | x :: y :: xs when cmp x y = 0 ->
108 (** Like the Unix pipeline 'sort|uniq'. *)
109 let sort_uniq ?cmp xs =
110 let xs = ExtList.List.sort ?cmp xs in
111 let xs = uniq ?cmp xs in
114 (** Pad a string to a fixed width (from virt-top, but don't truncate). *)
116 let n = String.length str in
117 if n >= width then str
118 else (* if n < width then *) str ^ String.make (width-n) ' '
120 (* Truncate an OCaml string at the first ASCII NUL character, ie. as
121 * if it were a C string.
123 let truncate_c_string str =
125 let i = String.index str '\000' in
130 (** General binary tree type. Data 'a is stored in the leaves and 'b
131 is stored in the nodes. *)
132 type ('a,'b) binary_tree =
134 | Node of ('a,'b) binary_tree * 'b * ('a,'b) binary_tree
136 (** Print out the binary tree in graphviz dot format. *)
137 let print_binary_tree leaf_printer node_printer tree =
138 (* Assign a unique, fixed label to each node. *)
141 let hash = Hashtbl.create 13 in
143 try Hashtbl.find hash node
145 let i = incr i; !i in
146 let label = "n" ^ string_of_int i in
147 Hashtbl.add hash node label;
150 (* Recursively generate the graphviz file. *)
151 let rec print = function
152 | (Leaf a as leaf) ->
153 eprintf " %s [shape=box, label=\"%s\"];\n"
154 (label leaf) (leaf_printer a)
155 | (Node (left,b,right) as node) ->
156 eprintf " %s [label=\"%s\"];\n"
157 (label node) (node_printer b);
158 eprintf " %s -> %s [tailport=sw];\n" (label node) (label left);
159 eprintf " %s -> %s [tailport=se];\n" (label node) (label right);
163 eprintf "/* Use 'dot -Tpng foo.dot > foo.png' to convert to a png file. */\n";
164 eprintf "digraph G {\n";