1 (* Memory info 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.
20 (* This program takes the kernel database (in kernels/ in toplevel
21 directory) and generates parsing code for the various structures
22 in the kernel that we are interested in.
24 The output programs -- *.ml, *.mli files of generated code -- go
25 into lib/ at the toplevel, eg. lib/virt_mem_kernels.ml
27 The stuff at the top of this file determine what structures
32 good_fields : string list;
33 field_metadata : (string * field_metadata_t) list;
35 and field_metadata_t =
36 | VoidPointerIsReally of string
37 | ListHeadIsReally of (string * string) option
39 (*----------------------------------------------------------------------
40 * This controls what structures & fields we will parse out.
41 *----------------------------------------------------------------------*)
44 good_fields = [ "tasks'next"; "tasks'prev";
45 "run_list'next"; "run_list'prev";
46 "state"; "prio"; "static_prio"; "normal_prio";
49 "tasks'next", ListHeadIsReally None;
50 "tasks'prev", ListHeadIsReally None;
51 "run_list'next", ListHeadIsReally None;
52 "run_list'prev", ListHeadIsReally None;
56 good_fields = [ "dev_list'prev"; "dev_list'next"; "next";
58 "name"; "flags"; "operstate"; "mtu"; "perm_addr";
61 "dev_list'next", ListHeadIsReally None;
62 "dev_list'prev", ListHeadIsReally None;
63 "ip_ptr", VoidPointerIsReally "in_device";
64 "ip6_ptr", VoidPointerIsReally "inet6_dev";
68 good_fields = [ "dev_base_head'next"; "dev_base_head'prev" ];
70 "dev_base_head'next", ListHeadIsReally (Some ("net_device", "dev_list"));
71 "dev_base_head'prev", ListHeadIsReally (Some ("net_device", "dev_list"));
75 good_fields = [ "ifa_list" ];
79 good_fields = [ "addr_list" ];
83 good_fields = [ "ifa_next"; "ifa_local"; "ifa_address";
84 "ifa_mask"; "ifa_broadcast" ];
88 good_fields = [ "prefix_len"; "lst_next" ];
103 module PP = Pahole_parser
104 module SC = Struct_classify
105 module CG = Code_generation
107 let (//) = Filename.concat
109 (* Start of the main program. *)
111 let quick = ref false in
112 let anon_args = ref [] in
114 let argspec = Arg.align [
115 "--quick", Arg.Set quick, " Quick mode (just for testing)";
118 let anon_arg str = anon_args := str :: !anon_args in
120 compile-kerneldb: Turn kernels database into code modules.
123 compile-kerneldb [-options] <kerneldb> <outputdir>
125 For example, from the top level of the virt-mem source tree:
126 compile-kerneldb kernels/ lib/
130 Arg.parse argspec anon_arg usage;
132 let quick = !quick in
133 let anon_args = List.rev !anon_args in
135 let kernelsdir, outputdir =
139 eprintf "compile-kerneldb <kerneldb> <outputdir>\n";
142 (* Read in the list of kernels from the kerneldb. *)
143 let kernels = PP.list_kernels kernelsdir in
145 (* In quick mode, just process the first few kernels. *)
146 let kernels = if quick then List.take 10 kernels else kernels in
148 let good_struct_names = List.map fst good_structs in
150 (* Load in the structures. *)
151 let nr_kernels = List.length kernels in
152 let kernels = List.mapi (
154 printf "Loading kernel data file %d/%d\r%!" (i+1) nr_kernels;
156 let structures = PP.load_structures info good_struct_names in
161 (* Keep only the good fields. *)
162 let kernels = List.map (
163 fun (info, structures) ->
164 let structures = List.map (
165 fun (struct_name, structure) ->
166 let { good_fields = good_fields } =
167 List.assoc struct_name good_structs in
168 let fields = List.filter (
169 fun { PP.field_name = name } -> List.mem name good_fields
170 ) structure.PP.struct_fields in
171 struct_name, { structure with PP.struct_fields = fields }
176 (* Turn anonymous list_head and void * pointers into pointers to
177 * known structure types, where we have that meta-information.
179 let kernels = List.map (
180 fun (info, structures) ->
181 let structures = List.map (
182 fun (struct_name, structure) ->
183 let { field_metadata = metadata } =
184 List.assoc struct_name good_structs in
185 let fields = structure.PP.struct_fields in
186 let fields = List.map (
187 fun ({ PP.field_name = name; PP.field_type = typ } as field) ->
189 let meta = List.assoc name metadata in
192 | ListHeadIsReally s, PP.FAnonListHeadPointer ->
193 PP.FListHeadPointer s
194 | VoidPointerIsReally s, PP.FVoidPointer ->
197 { field with PP.field_type = typ }
201 struct_name, { structure with PP.struct_fields = fields }
208 fun (info, structures) ->
209 printf "\n%s ----------\n" (PP.string_of_info info);
211 fun (_, structure) ->
212 printf "%s\n\n" (PP.string_of_structure structure);
216 (* First output file is a simple list of kernels, to support the
217 * 'virt-mem --list-kernels' option.
220 let _loc = Loc.ghost in
222 let versions = List.map (
223 fun ({ PP.kernel_version = version }, _) -> version
226 (* Sort them in reverse because we are going to generate the
227 * final list in reverse.
229 let cmp a b = compare b a in
230 let versions = List.sort ~cmp versions in
233 List.fold_left (fun xs version -> <:expr< $str:version$ :: $xs$ >>)
234 <:expr< [] >> versions in
236 let code = <:str_item<
240 let output_file = outputdir // "virt_mem_kernels.ml" in
241 printf "Writing list of kernels to %s ...\n%!" output_file;
242 Printers.OCaml.print_implem ~output_file code in
244 (* We want to track single structures as they have changed over
245 * time, ie. over kernel versions. Transpose our dataset so we are
246 * looking at structures over time.
248 let structures = PP.transpose good_struct_names kernels in
250 let kernels = () in ignore (kernels); (* garbage collect *)
254 fun (struct_name, kernels) ->
255 let all_fields = PP.get_fields kernels in
256 (struct_name, (kernels, all_fields))
261 fun (struct_name, (kernels, all_fields)) ->
262 printf "struct %s:\n" struct_name;
263 printf " structure occurs in %d kernel versions\n"
264 (List.length kernels);
265 printf " union of fields found:\n";
267 fun (field_name, field_type) ->
268 printf " %s %s\n" (PP.string_of_f_type field_type) field_name
272 (* Now perform the minimization step for each structure.
273 * We do separate minimization for:
274 * - shape field structures
275 * - content field structures
280 fun (struct_name, (kernels, all_fields)) ->
282 SC.minimize_shape_field_structs struct_name good_struct_names
286 SC.minimize_content_field_structs struct_name good_struct_names
290 SC.minimize_parsers struct_name kernels sfhash cfhash in
292 (struct_name, (kernels, all_fields,
293 sflist, sfhash, cflist, cfhash, palist, pahash))
299 (kernels, all_fields,
300 sflist, sfhash, cflist, cfhash, palist, pahash)) ->
301 printf "struct %s:\n" struct_name;
303 printf " shape field structures:\n";
305 fun { SC.sf_name = name; sf_fields = fields } ->
306 printf " type %s = {\n" name;
308 fun { PP.field_name = name; field_type = typ } ->
309 printf " %s %s;\n" (PP.string_of_f_type typ) name
314 printf " content field structures:\n";
316 fun { SC.cf_name = name; cf_fields = fields } ->
317 printf " type %s = {\n" name;
319 fun { PP.field_name = name; field_type = typ } ->
320 printf " %s %s;\n" (PP.string_of_f_type typ) name
325 printf " parsers:\n";
327 fun { SC.pa_name = name;
328 pa_shape_field_struct = sf;
329 pa_content_field_struct = cf } ->
330 printf " let %s = ...\n" name;
331 printf " -> (%s, %s)\n" sf.SC.sf_name cf.SC.cf_name
335 (* Now let's generate some code. *)
336 let implem_types, interf_types =
340 (_, _, sflist, _, cflist, _, _, _)) ->
341 (struct_name, sflist, cflist)
345 let implem_parsers, interf_parsers, subst_parsers =
346 CG.generate_parsers (
348 fun (struct_name, (_, _, _, _, _, _, palist, _)) ->
349 (struct_name, palist)
353 (* Output the generated code. *)
354 let output_file = outputdir // "kernel.mli" in
355 printf "Writing kernel data interface to %s ...\n%!" output_file;
356 CG.output_interf ~output_file interf_types interf_parsers;
358 let output_file = outputdir // "kernel.ml" in
359 printf "Writing kernel data parsers to %s ...\n%!" output_file;
360 CG.output_implem ~output_file implem_types implem_parsers subst_parsers;