--- /dev/null
+(* 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.
+ *)
+
+open ExtList
+open ExtString
+
+open Printf
+
+module PP = Pahole_parser
+
+type f_class = ShapeField | ContentField
+
+let classify_field names = function
+ | (PP.FStructPointer struct_name | PP.FListHeadPointer struct_name)
+ when List.mem struct_name names -> ShapeField
+ (* .. anything else is a content field: *)
+ | PP.FStructPointer _
+ | PP.FListHeadPointer _
+ | PP.FVoidPointer
+ | PP.FAnonListHeadPointer
+ | PP.FInteger
+ | PP.FString _ -> ContentField
+
+type shape_field_struct = {
+ sf_i : int;
+ sf_name : string;
+ sf_fields : PP.field list;
+}
+
+and content_field_struct = {
+ cf_i : int;
+ cf_name : string;
+ cf_fields : PP.field list;
+}
+
+and parser_ = {
+ pa_i : int;
+ pa_name : string;
+ pa_endian : Bitstring.endian;
+ pa_fields : Pahole_parser.field list;
+ pa_shape_field_struct : shape_field_struct;
+ pa_content_field_struct : content_field_struct;
+}
+
+let endian_of_architecture arch =
+ if String.starts_with arch "i386" ||
+ String.starts_with arch "i486" ||
+ String.starts_with arch "i586" ||
+ String.starts_with arch "i686" ||
+ String.starts_with arch "x86_64" ||
+ String.starts_with arch "x86-64" then
+ Bitstring.LittleEndian
+ else if String.starts_with arch "ia64" then
+ Bitstring.LittleEndian (* XXX usually? *)
+ else if String.starts_with arch "ppc" then
+ Bitstring.BigEndian
+ else if String.starts_with arch "sparc" then
+ Bitstring.BigEndian
+ else
+ failwith (sprintf "endian_of_architecture: cannot parse %S" arch)
+
+let unique =
+ let i = ref 0 in
+ fun () ->
+ incr i; !i
+
+(* Minimization of shape fields & content fields. *)
+
+let cmp { PP.field_name = n1 } { PP.field_name = n2 } = compare n1 n2
+
+let hash_values h = Hashtbl.fold (fun _ v vs -> v :: vs) h []
+
+let minimize_shape_field_structs struct_name names kernels =
+ let h = Hashtbl.create 13 in
+ let rh = Hashtbl.create 13 in
+
+ let only_shape_fields =
+ List.filter (
+ fun { PP.field_type = typ } ->
+ classify_field names typ = ShapeField
+ )
+ in
+
+ let name_of i = sprintf "%s_shape_fields_%d" struct_name i in
+
+ List.iter (
+ fun ({ PP.kernel_version = version },
+ { PP.struct_fields = fields; struct_name = name_check }) ->
+ assert (struct_name = name_check);
+ let fields = List.sort ~cmp (only_shape_fields fields) in
+ let key = List.map (fun { PP.field_name = name } -> name) fields in
+ let sf =
+ try Hashtbl.find h key
+ with Not_found ->
+ let i = unique () in
+ let sf = { sf_i = i; sf_name = name_of i; sf_fields = fields } in
+ Hashtbl.add h key sf;
+ sf in
+ Hashtbl.add rh version sf
+ ) kernels;
+
+ let sfs = hash_values h in
+ sfs, rh
+
+let minimize_content_field_structs struct_name names kernels =
+ let h = Hashtbl.create 13 in
+ let rh = Hashtbl.create 13 in
+
+ let only_content_fields =
+ List.filter (
+ fun { PP.field_type = typ } ->
+ classify_field names typ = ContentField
+ )
+ in
+
+ let name_of i = sprintf "%s_content_fields_%d" struct_name i in
+
+ List.iter (
+ fun ({ PP.kernel_version = version },
+ { PP.struct_fields = fields; struct_name = name_check }) ->
+ assert (struct_name = name_check);
+ let fields = List.sort ~cmp (only_content_fields fields) in
+ let key = List.map (fun { PP.field_name = name } -> name) fields in
+ let cf =
+ try Hashtbl.find h key
+ with Not_found ->
+ let i = unique () in
+ let cf = { cf_i = i; cf_name = name_of i; cf_fields = fields } in
+ Hashtbl.add h key cf;
+ cf in
+ Hashtbl.add rh version cf
+ ) kernels;
+
+ let cfs = hash_values h in
+ cfs, rh
+
+let minimize_parsers struct_name kernels sfhash cfhash =
+ let h = Hashtbl.create 13 in
+ let rh = Hashtbl.create 13 in
+
+ let name_of i = sprintf "%s_parser_%d" struct_name i in
+
+ List.iter (
+ fun ({ PP.kernel_version = version; arch = arch },
+ { PP.struct_fields = fields; struct_name = name_check }) ->
+ assert (struct_name = name_check);
+ let endian = endian_of_architecture arch in
+ let key = endian, fields in
+ let pa =
+ try Hashtbl.find h key
+ with Not_found ->
+ let i = unique () in
+ let sf =
+ try Hashtbl.find sfhash version
+ with Not_found -> assert false in
+ let cf =
+ try Hashtbl.find cfhash version
+ with Not_found -> assert false in
+ let pa = { pa_i = i; pa_name = name_of i; pa_fields = fields;
+ pa_endian = endian;
+ pa_shape_field_struct = sf;
+ pa_content_field_struct = cf } in
+ Hashtbl.add h key pa;
+ pa in
+ Hashtbl.add rh version pa
+ ) kernels;
+
+ let pas = hash_values h in
+ pas, rh
git.annexia.org / virt-mem.git / blobdiff