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.
25 module PP = Pahole_parser
27 type f_class = ShapeField | ContentField
29 let classify_field names = function
30 | PP.FListHeadPointer None -> ShapeField
31 | (PP.FStructPointer struct_name
32 | PP.FListHeadPointer (Some (struct_name, _)))
33 when List.mem struct_name names -> ShapeField
34 (* .. anything else is a content field: *)
36 | PP.FListHeadPointer _
38 | PP.FAnonListHeadPointer
40 | PP.FString _ -> ContentField
42 type shape_field_struct = {
45 sf_fields : (string * PP.f_type) list;
48 and content_field_struct = {
51 cf_fields : (string * PP.f_type) list;
57 pa_endian : Bitstring.endian;
58 pa_structure : Pahole_parser.structure;
59 pa_shape_field_struct : shape_field_struct;
60 pa_content_field_struct : content_field_struct;
63 and sfhash = (string, shape_field_struct) Hashtbl.t
64 and cfhash = (string, content_field_struct) Hashtbl.t
65 and pahash = (string, parser_) Hashtbl.t
67 let endian_of_architecture arch =
68 if String.starts_with arch "i386" ||
69 String.starts_with arch "i486" ||
70 String.starts_with arch "i586" ||
71 String.starts_with arch "i686" ||
72 String.starts_with arch "x86_64" ||
73 String.starts_with arch "x86-64" then
74 Bitstring.LittleEndian
75 else if String.starts_with arch "ia64" then
76 Bitstring.LittleEndian (* XXX usually? *)
77 else if String.starts_with arch "ppc" then
79 else if String.starts_with arch "sparc" then
82 failwith (sprintf "endian_of_architecture: cannot parse %S" arch)
89 (* Minimization of shape fields & content fields. *)
91 let cmp (n1,_) (n2,_) = compare n1 n2
93 let hash_values h = Hashtbl.fold (fun _ v vs -> v :: vs) h []
95 let minimize_shape_field_structs struct_name names kernels =
96 let h = Hashtbl.create 13 in
97 let rh = Hashtbl.create 13 in
99 let only_shape_fields =
101 fun { PP.field_name = name; field_type = typ } ->
102 if classify_field names typ = ShapeField then Some (name, typ)
107 let name_of i = sprintf "%s_shape_fields_%d" struct_name i in
110 fun ({ PP.kernel_version = version },
111 { PP.struct_fields = fields; struct_name = name_check }) ->
112 assert (struct_name = name_check);
113 let fields = List.sort ~cmp (only_shape_fields fields) in
114 let key = List.map fst fields in
116 try Hashtbl.find h key
119 let sf = { sf_i = i; sf_name = name_of i; sf_fields = fields } in
120 Hashtbl.add h key sf;
122 Hashtbl.add rh version sf
125 let sfs = hash_values h in
128 let minimize_content_field_structs struct_name names kernels =
129 let h = Hashtbl.create 13 in
130 let rh = Hashtbl.create 13 in
132 let only_content_fields =
134 fun { PP.field_name = name; field_type = typ } ->
135 if classify_field names typ = ContentField then Some (name, typ)
140 let name_of i = sprintf "%s_content_fields_%d" struct_name i in
143 fun ({ PP.kernel_version = version },
144 { PP.struct_fields = fields; struct_name = name_check }) ->
145 assert (struct_name = name_check);
146 let fields = List.sort ~cmp (only_content_fields fields) in
147 let key = List.map fst fields in
149 try Hashtbl.find h key
152 let cf = { cf_i = i; cf_name = name_of i; cf_fields = fields } in
153 Hashtbl.add h key cf;
155 Hashtbl.add rh version cf
158 let cfs = hash_values h in
161 let minimize_parsers struct_name kernels sfhash cfhash =
162 let h = Hashtbl.create 13 in
163 let rh = Hashtbl.create 13 in
165 (* Do not change - see Code_generation.re_subst. *)
166 let name_of i = sprintf "%s_parser_%d" struct_name i in
169 fun ({ PP.kernel_version = version; arch = arch },
170 ({ PP.struct_fields = fields; struct_name = name_check }
172 assert (struct_name = name_check);
173 let endian = endian_of_architecture arch in
174 let key = endian, fields in
176 try Hashtbl.find h key
180 try Hashtbl.find sfhash version
181 with Not_found -> assert false in
183 try Hashtbl.find cfhash version
184 with Not_found -> assert false in
185 let pa = { pa_i = i; pa_name = name_of i;
187 pa_structure = structure;
188 pa_shape_field_struct = sf;
189 pa_content_field_struct = cf } in
190 Hashtbl.add h key pa;
192 Hashtbl.add rh version pa
195 let pas = hash_values h in