1 (* Memory info command for virtual domains.
2 (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 Common & utility functions.
24 let ( +^ ) = Int64.add
25 let ( -^ ) = Int64.sub
26 let ( *^ ) = Int64.mul
27 let ( /^ ) = Int64.div
28 let ( &^ ) = Int64.logand
29 let ( |^ ) = Int64.logor
32 | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64
34 let string_of_architecture = function
41 | SPARC64 -> "sparc64"
43 let architecture_of_string = function
45 String.length str = 4 &&
46 (str.[0] = 'i' || str.[0] = 'I') &&
47 (str.[1] >= '3' && str.[1] <= '6') &&
48 str.[2] = '8' && str.[3] = '6' -> I386
49 | "x86_64" | "X86_64" | "x86-64" | "X86-64" -> X86_64
50 | "ia64" | "IA64" -> IA64
51 | "ppc" | "PPC" | "ppc32" | "PPC32" -> PPC
52 | "ppc64" | "PPC64" -> PPC64
53 | "sparc" | "SPARC" | "sparc32" | "SPARC32" -> SPARC
54 | "sparc64" | "SPARC64" -> SPARC64
56 failwith (sprintf "architecture_of_string: %s: unknown architecture"
59 let endian_of_architecture = function
60 | I386 | X86_64 -> Bitstring.LittleEndian
61 | IA64 -> Bitstring.LittleEndian (* XXX usually? *)
62 | PPC | PPC64 | SPARC | SPARC64 -> Bitstring.BigEndian
67 let wordsize_of_architecture = function
76 let bits_of_wordsize = function
77 | W32 -> 32 | W64 -> 64
78 let bytes_of_wordsize = function
81 (* 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 let rec uniq ?(cmp = Pervasives.compare) = function
102 | x :: y :: xs when cmp x y = 0 ->
107 let sort_uniq ?cmp xs =
108 let xs = ExtList.List.sort ?cmp xs in
109 let xs = uniq ?cmp xs in
112 (* Pad a string to a fixed width (from virt-top, but don't truncate). *)
114 let n = String.length str in
115 if n >= width then str
116 else (* if n < width then *) str ^ String.make (width-n) ' '
118 (* General binary tree type. Data 'a is stored in the leaves and 'b
119 * is stored in the nodes.
121 type ('a,'b) binary_tree =
123 | Node of ('a,'b) binary_tree * 'b * ('a,'b) binary_tree
125 (* This prints out the binary tree in graphviz dot format. *)
126 let print_binary_tree leaf_printer node_printer tree =
127 (* Assign a unique, fixed label to each node. *)
130 let hash = Hashtbl.create 13 in
132 try Hashtbl.find hash node
134 let i = incr i; !i in
135 let label = "n" ^ string_of_int i in
136 Hashtbl.add hash node label;
139 (* Recursively generate the graphviz file. *)
140 let rec print = function
141 | (Leaf a as leaf) ->
142 eprintf " %s [shape=box, label=\"%s\"];\n"
143 (label leaf) (leaf_printer a)
144 | (Node (left,b,right) as node) ->
145 eprintf " %s [label=\"%s\"];\n"
146 (label node) (node_printer b);
147 eprintf " %s -> %s [tailport=sw];\n" (label node) (label left);
148 eprintf " %s -> %s [tailport=se];\n" (label node) (label right);
152 eprintf "/* Use 'dot -Tpng foo.dot > foo.png' to convert to a png file. */\n";
153 eprintf "digraph G {\n";