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; XXX point to 'next *)
51 "run_list'next", ListHeadIsReally None;
52 (*"run_list'prev", ListHeadIsReally None; XXX point to 'next *)
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; XXX point to 'next *)
63 "ip_ptr", VoidPointerIsReally "in_device";
64 "ip6_ptr", VoidPointerIsReally "inet6_dev";
68 good_fields = [ "dev_base_head'next"; "dev_base_head'prev" ];
71 ListHeadIsReally (Some ("net_device", "dev_list'next"));
73 ListHeadIsReally (Some ("net_device", "dev_list'next"));
77 good_fields = [ "ifa_list" ];
81 good_fields = [ "addr_list" ];
85 good_fields = [ "ifa_next"; "ifa_local"; "ifa_address";
86 "ifa_mask"; "ifa_broadcast" ];
90 good_fields = [ "prefix_len"; "lst_next" ];
105 module PP = Pahole_parser
106 module MM = Minimizer
107 module CG = Code_generation
109 let (//) = Filename.concat
111 (* Start of the main program. *)
113 let quick = ref false in
114 let anon_args = ref [] in
116 let argspec = Arg.align [
117 "--quick", Arg.Set quick, " Quick mode (just for testing)";
120 let anon_arg str = anon_args := str :: !anon_args in
122 compile-kerneldb: Turn kernels database into code modules.
125 compile-kerneldb [-options] <kerneldb> <outputdir>
127 For example, from the top level of the virt-mem source tree:
128 compile-kerneldb kernels/ lib/
132 Arg.parse argspec anon_arg usage;
134 let quick = !quick in
135 let anon_args = List.rev !anon_args in
137 let kernelsdir, outputdir =
141 eprintf "compile-kerneldb <kerneldb> <outputdir>\n";
144 (* Read in the list of kernels from the kerneldb. *)
145 let kernels = PP.list_kernels kernelsdir in
147 (* In quick mode, just process the first few kernels. *)
148 let kernels = if quick then List.take 10 kernels else kernels in
150 let good_struct_names = List.map fst good_structs in
152 (* Load in the structures. *)
153 let nr_kernels = List.length kernels in
154 let kernels = List.mapi (
156 printf "Loading kernel data file %d/%d\r%!" (i+1) nr_kernels;
158 let structures = PP.load_structures info good_struct_names in
163 (* Keep only the good fields. *)
164 let kernels = List.map (
165 fun (info, structures) ->
166 let structures = List.map (
167 fun (struct_name, structure) ->
168 let { good_fields = good_fields } =
169 List.assoc struct_name good_structs in
170 let fields = List.filter (
171 fun { PP.field_name = name } -> List.mem name good_fields
172 ) structure.PP.struct_fields in
173 struct_name, { structure with PP.struct_fields = fields }
178 (* Turn anonymous list_head and void * pointers into pointers to
179 * known structure types, where we have that meta-information.
181 let kernels = List.map (
182 fun (info, structures) ->
183 let structures = List.map (
184 fun (struct_name, structure) ->
185 let { field_metadata = metadata } =
186 List.assoc struct_name good_structs in
187 let fields = structure.PP.struct_fields in
188 let fields = List.map (
189 fun ({ PP.field_name = name; PP.field_type = typ } as field) ->
191 let meta = List.assoc name metadata in
194 | ListHeadIsReally s, PP.FAnonListHeadPointer ->
195 PP.FListHeadPointer s
196 | VoidPointerIsReally s, PP.FVoidPointer ->
199 { field with PP.field_type = typ }
203 struct_name, { structure with PP.struct_fields = fields }
210 fun (info, structures) ->
211 printf "\n%s ----------\n" (PP.string_of_info info);
213 fun (_, structure) ->
214 printf "%s\n\n" (PP.string_of_structure structure);
218 (* First output file is a simple list of kernels, to support the
219 * 'virt-mem --list-kernels' option.
222 let _loc = Loc.ghost in
224 let versions = List.map (
225 fun ({ PP.kernel_version = version }, _) -> version
228 (* Sort them in reverse because we are going to generate the
229 * final list in reverse.
231 let cmp a b = compare b a in
232 let versions = List.sort ~cmp versions in
235 List.fold_left (fun xs version -> <:expr< $str:version$ :: $xs$ >>)
236 <:expr< [] >> versions in
238 let code = <:str_item<
242 let output_file = outputdir // "virt_mem_kernels.ml" in
243 printf "Writing list of kernels to %s ...\n%!" output_file;
244 Printers.OCaml.print_implem ~output_file code in
246 (* We want to track single structures as they have changed over
247 * time, ie. over kernel versions. Transpose our dataset so we are
248 * looking at structures over time.
250 let structures = PP.transpose good_struct_names kernels in
252 let kernels = () in ignore (kernels); (* garbage collect *)
256 fun (struct_name, kernels) ->
257 let all_fields = PP.get_fields kernels in
258 (struct_name, (kernels, all_fields))
263 fun (struct_name, (kernels, all_fields)) ->
264 printf "struct %s:\n" struct_name;
265 printf " structure occurs in %d kernel versions\n"
266 (List.length kernels);
267 printf " union of fields found:\n";
269 fun (field_name, (field_type, always_available)) ->
270 printf " %s %s /* %s */\n"
271 (PP.string_of_f_type field_type) field_name
272 (if always_available then "always" else "optional")
276 (* Now perform the minimization step for parsers. *)
279 fun (struct_name, (kernels, all_fields)) ->
280 let palist, pahash = MM.minimize_parsers struct_name kernels in
282 (struct_name, (kernels, all_fields, palist, pahash))
288 (kernels, all_fields, palist, pahash)) ->
289 printf "struct %s:\n" struct_name;
291 printf " parsers:\n";
293 fun { MM.pa_name = name; pa_structure = structure } ->
294 printf " let %s bits =\n" name;
296 fun ({ PP.field_name = name; field_type = typ }) ->
297 printf " %s %s;\n" (PP.string_of_f_type typ) name
298 ) structure.PP.struct_fields;
302 (* Now let's generate some code. *)
303 let implem_types, interf_types =
306 fun (struct_name, (_, all_fields, _, _)) ->
307 (struct_name, all_fields)
311 let implem_offsets, interf_offsets =
312 CG.generate_offsets (
314 fun (struct_name, (kernels, all_fields, _, _)) ->
315 (struct_name, (kernels, all_fields))
319 let (implem_parsers, interf_parsers), subst_parsers =
320 CG.generate_parsers (
322 fun (struct_name, (_, all_fields, palist, _)) ->
323 (struct_name, (all_fields, palist))
327 let implem_version_maps, interf_version_maps =
328 CG.generate_version_maps (
330 fun (struct_name, (kernels, _, _, pahash)) ->
331 (struct_name, (kernels, pahash))
335 let implem_followers, interf_followers =
336 CG.generate_followers good_struct_names (
338 fun (struct_name, (_, all_fields, _, _)) -> (struct_name, all_fields)
342 (* Output the generated code. *)
343 let output_file = outputdir // "kernel.mli" in
344 printf "Writing kernel data interface to %s ...\n%!" output_file;
345 CG.output_interf ~output_file
346 interf_types interf_offsets interf_parsers
347 interf_version_maps interf_followers;
349 let output_file = outputdir // "kernel.ml" in
350 printf "Writing kernel data parsers to %s ...\n%!" output_file;
351 CG.output_implem ~output_file
352 implem_types implem_offsets implem_parsers subst_parsers
353 implem_version_maps implem_followers;