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.FStructPointer struct_name | PP.FListHeadPointer struct_name)
31 when List.mem struct_name names -> ShapeField
32 (* .. anything else is a content field: *)
34 | PP.FListHeadPointer _
36 | PP.FAnonListHeadPointer
38 | PP.FString _ -> ContentField
40 type shape_field_struct = {
43 sf_fields : PP.field list;
46 and content_field_struct = {
49 cf_fields : PP.field list;
55 pa_endian : Bitstring.endian;
56 pa_fields : Pahole_parser.field list;
57 pa_shape_field_struct : shape_field_struct;
58 pa_content_field_struct : content_field_struct;
61 let endian_of_architecture arch =
62 if String.starts_with arch "i386" ||
63 String.starts_with arch "i486" ||
64 String.starts_with arch "i586" ||
65 String.starts_with arch "i686" ||
66 String.starts_with arch "x86_64" ||
67 String.starts_with arch "x86-64" then
68 Bitstring.LittleEndian
69 else if String.starts_with arch "ia64" then
70 Bitstring.LittleEndian (* XXX usually? *)
71 else if String.starts_with arch "ppc" then
73 else if String.starts_with arch "sparc" then
76 failwith (sprintf "endian_of_architecture: cannot parse %S" arch)
83 (* Minimization of shape fields & content fields. *)
85 let cmp { PP.field_name = n1 } { PP.field_name = n2 } = compare n1 n2
87 let hash_values h = Hashtbl.fold (fun _ v vs -> v :: vs) h []
89 let minimize_shape_field_structs struct_name names kernels =
90 let h = Hashtbl.create 13 in
91 let rh = Hashtbl.create 13 in
93 let only_shape_fields =
95 fun { PP.field_type = typ } ->
96 classify_field names typ = ShapeField
100 let name_of i = sprintf "%s_shape_fields_%d" struct_name i in
103 fun ({ PP.kernel_version = version },
104 { PP.struct_fields = fields; struct_name = name_check }) ->
105 assert (struct_name = name_check);
106 let fields = List.sort ~cmp (only_shape_fields fields) in
107 let key = List.map (fun { PP.field_name = name } -> name) fields in
109 try Hashtbl.find h key
112 let sf = { sf_i = i; sf_name = name_of i; sf_fields = fields } in
113 Hashtbl.add h key sf;
115 Hashtbl.add rh version sf
118 let sfs = hash_values h in
121 let minimize_content_field_structs struct_name names kernels =
122 let h = Hashtbl.create 13 in
123 let rh = Hashtbl.create 13 in
125 let only_content_fields =
127 fun { PP.field_type = typ } ->
128 classify_field names typ = ContentField
132 let name_of i = sprintf "%s_content_fields_%d" struct_name i in
135 fun ({ PP.kernel_version = version },
136 { PP.struct_fields = fields; struct_name = name_check }) ->
137 assert (struct_name = name_check);
138 let fields = List.sort ~cmp (only_content_fields fields) in
139 let key = List.map (fun { PP.field_name = name } -> name) fields in
141 try Hashtbl.find h key
144 let cf = { cf_i = i; cf_name = name_of i; cf_fields = fields } in
145 Hashtbl.add h key cf;
147 Hashtbl.add rh version cf
150 let cfs = hash_values h in
153 let minimize_parsers struct_name kernels sfhash cfhash =
154 let h = Hashtbl.create 13 in
155 let rh = Hashtbl.create 13 in
157 let name_of i = sprintf "%s_parser_%d" struct_name i in
160 fun ({ PP.kernel_version = version; arch = arch },
161 { PP.struct_fields = fields; struct_name = name_check }) ->
162 assert (struct_name = name_check);
163 let endian = endian_of_architecture arch in
164 let key = endian, fields in
166 try Hashtbl.find h key
170 try Hashtbl.find sfhash version
171 with Not_found -> assert false in
173 try Hashtbl.find cfhash version
174 with Not_found -> assert false in
175 let pa = { pa_i = i; pa_name = name_of i; pa_fields = fields;
177 pa_shape_field_struct = sf;
178 pa_content_field_struct = cf } in
179 Hashtbl.add h key pa;
181 Hashtbl.add rh version pa
184 let pas = hash_values h in