From 62b4fb5d778b12af1ed90c4f7934a34e10e1ba9d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Dynamic version, working. --- MANIFEST | 5 +- extract/codegen/.depend | 20 +- extract/codegen/Makefile.in | 2 +- extract/codegen/code_generation.ml | 661 ++++++----- extract/codegen/code_generation.mli | 34 +- extract/codegen/compile_kerneldb.ml | 125 +-- extract/codegen/kerneldb_to_parser.ml | 794 -------------- extract/codegen/minimizer.ml | 87 ++ extract/codegen/minimizer.mli | 59 + extract/codegen/pahole_parser.ml | 21 +- extract/codegen/pahole_parser.mli | 9 +- extract/codegen/struct_classify.ml | 196 ---- extract/codegen/struct_classify.mli | 180 --- lib/Makefile.in | 7 - lib/kernel.ml | 1940 +++++++++++++++++++-------------- lib/kernel.mli | 93 +- lib/virt_mem.ml | 9 +- lib/virt_mem_kernels.ml | 12 +- 18 files changed, 1817 insertions(+), 2437 deletions(-) delete mode 100644 extract/codegen/kerneldb_to_parser.ml create mode 100644 extract/codegen/minimizer.ml create mode 100644 extract/codegen/minimizer.mli delete mode 100644 extract/codegen/struct_classify.ml delete mode 100644 extract/codegen/struct_classify.mli diff --git a/MANIFEST b/MANIFEST index 382d878..469d488 100644 --- a/MANIFEST +++ b/MANIFEST @@ -8,11 +8,10 @@ extract/codegen/.depend extract/codegen/code_generation.ml extract/codegen/code_generation.mli extract/codegen/compile_kerneldb.ml -extract/codegen/kerneldb_to_parser.ml +extract/codegen/minimizer.ml +extract/codegen/minimizer.mli extract/codegen/pahole_parser.ml extract/codegen/pahole_parser.mli -extract/codegen/struct_classify.ml -extract/codegen/struct_classify.mli extract/codegen/Makefile.in extract/fedora-koji/.depend extract/fedora-koji/fedora_koji_download_kernels.ml diff --git a/extract/codegen/.depend b/extract/codegen/.depend index e51636c..6a6360f 100644 --- a/extract/codegen/.depend +++ b/extract/codegen/.depend @@ -1,16 +1,12 @@ -code_generation.cmi: struct_classify.cmi pahole_parser.cmi -struct_classify.cmi: pahole_parser.cmi -code_generation.cmo: struct_classify.cmi pahole_parser.cmi \ - code_generation.cmi -code_generation.cmx: struct_classify.cmx pahole_parser.cmx \ - code_generation.cmi -compile_kerneldb.cmo: struct_classify.cmi pahole_parser.cmi \ - code_generation.cmi -compile_kerneldb.cmx: struct_classify.cmx pahole_parser.cmx \ - code_generation.cmx +code_generation.cmi: pahole_parser.cmi minimizer.cmi +minimizer.cmi: pahole_parser.cmi +code_generation.cmo: pahole_parser.cmi minimizer.cmi code_generation.cmi +code_generation.cmx: pahole_parser.cmx minimizer.cmx code_generation.cmi +compile_kerneldb.cmo: pahole_parser.cmi minimizer.cmi code_generation.cmi +compile_kerneldb.cmx: pahole_parser.cmx minimizer.cmx code_generation.cmx kerneldb_to_parser.cmo: pahole_parser.cmi kerneldb_to_parser.cmx: pahole_parser.cmx +minimizer.cmo: pahole_parser.cmi minimizer.cmi +minimizer.cmx: pahole_parser.cmx minimizer.cmi pahole_parser.cmo: pahole_parser.cmi pahole_parser.cmx: pahole_parser.cmi -struct_classify.cmo: pahole_parser.cmi struct_classify.cmi -struct_classify.cmx: pahole_parser.cmx struct_classify.cmi diff --git a/extract/codegen/Makefile.in b/extract/codegen/Makefile.in index a46541d..b7d1632 100644 --- a/extract/codegen/Makefile.in +++ b/extract/codegen/Makefile.in @@ -36,7 +36,7 @@ OCAMLOPTLIBS = -linkpkg camlp4lib.cmxa TARGETS = compile-kerneldb.opt OBJS = pahole_parser.cmo \ - struct_classify.cmo \ + minimizer.cmo \ code_generation.cmo \ compile_kerneldb.cmo XOBJS = $(OBJS:.cmo=.cmx) diff --git a/extract/codegen/code_generation.ml b/extract/codegen/code_generation.ml index d76aa4a..41254d8 100644 --- a/extract/codegen/code_generation.ml +++ b/extract/codegen/code_generation.ml @@ -26,7 +26,7 @@ open ExtString open Printf module PP = Pahole_parser -module SC = Struct_classify +module MM = Minimizer let rec uniq ?(cmp = Pervasives.compare) = function [] -> [] @@ -82,15 +82,27 @@ let concat_exprs exprs = let concat_record_fields fields = match fields with - | [] -> assert false - | f :: fs -> - List.fold_left (fun fs f -> <:ctyp< $fs$ ; $f$ >>) f fs + | [] -> assert false + | f :: fs -> + List.fold_left (fun fs f -> <:ctyp< $fs$ ; $f$ >>) f fs let concat_record_bindings rbs = match rbs with - | [] -> assert false - | rb :: rbs -> - List.fold_left (fun rbs rb -> <:rec_binding< $rbs$ ; $rb$ >>) rb rbs + | [] -> assert false + | rb :: rbs -> + List.fold_left (fun rbs rb -> <:rec_binding< $rbs$ ; $rb$ >>) rb rbs + +let concat_bindings bs = + match bs with + | [] -> assert false + | b :: bs -> + List.fold_left (fun bs b -> <:binding< $bs$ and $b$ >>) b bs + +let concat_sum_types ts = + match ts with + | [] -> assert false + | t :: ts -> + List.fold_left (fun ts t -> <:ctyp< $ts$ | $t$ >>) t ts let build_record rbs = Ast.ExRec (_loc, rbs, Ast.ExNil _loc) @@ -109,74 +121,90 @@ let build_tuple_from_patts patts = Ast.PaTup (_loc, List.fold_left (fun xs x -> Ast.PaCom (_loc, x, xs)) x xs) +(* Helper functions to store things in a fixed-length tuple very efficiently. + * Note that the tuple length must be >= 2. + *) +type tuple = string list + +let tuple_create fields : tuple = fields + +(* Generates 'let _, _, resultpatt, _ = tupleexpr in body'. *) +let tuple_generate_extract fields field resultpatt tupleexpr body = + let patts = List.map ( + fun name -> if name = field then resultpatt else <:patt< _ >> + ) fields in + let result = build_tuple_from_patts patts in + <:expr< let $result$ = $tupleexpr$ in $body$ >> + +(* Generates '(fieldexpr1, fieldexpr2, ...)'. *) +let tuple_generate_construct fieldexprs = + build_tuple_from_exprs fieldexprs + type code = Ast.str_item * Ast.sig_item let ocaml_type_of_field_type = function - | PP.FInteger -> <:ctyp< int64 >> - | PP.FString _ -> <:ctyp< string >> - | PP.FStructPointer _ | PP.FVoidPointer - | PP.FAnonListHeadPointer | PP.FListHeadPointer _ -> + | PP.FInteger, true -> <:ctyp< int64 >> + | PP.FInteger, false -> <:ctyp< int64 option >> + | PP.FString _, true -> <:ctyp< string >> + | PP.FString _, false -> <:ctyp< string option >> + | PP.FStructPointer _, true | PP.FVoidPointer, true + | PP.FAnonListHeadPointer, true | PP.FListHeadPointer _, true -> <:ctyp< Virt_mem_mmap.addr >> + | PP.FStructPointer _, false | PP.FVoidPointer, false + | PP.FAnonListHeadPointer, false | PP.FListHeadPointer _, false -> + <:ctyp< Virt_mem_mmap.addr option >> let generate_types xs = - let strs = List.map ( - fun (struct_name, sflist, cflist) -> - let sflist = List.map ( - fun { SC.sf_name = sf_name; sf_fields = fields } -> - if fields <> [] then ( - let fields = List.map ( - fun (name, t) -> - match t with - | PP.FListHeadPointer _ -> - (* A list head turns into three fields, the pointer, - * the offset within current struct, and the adjustment - * (offset within destination struct). - *) - let t = ocaml_type_of_field_type t in - [ <:ctyp< $lid:sf_name^"_"^name$ : $t$ >>; - <:ctyp< $lid:sf_name^"_"^name^"_offset"$ : int >>; - <:ctyp< $lid:sf_name^"_"^name^"_adjustment"$ : int >> ] - | _ -> - let t = ocaml_type_of_field_type t in - [ <:ctyp< $lid:sf_name^"_"^name$ : $t$ >> ] - ) fields in - let fields = List.concat fields in - let fields = concat_record_fields fields in - - <:str_item< - type $lid:sf_name$ = { $fields$ } - >> - ) else - <:str_item< type $lid:sf_name$ = unit >> - ) sflist in - let sflist = concat_str_items sflist in - - let cflist = List.map ( - fun { SC.cf_name = cf_name; cf_fields = fields } -> - if fields <> [] then ( - let fields = List.map ( - fun (name, t) -> - let t = ocaml_type_of_field_type t in - <:ctyp< $lid:cf_name^"_"^name$ : $t$ >> - ) fields in - let fields = concat_record_fields fields in - - <:str_item< - type $lid:cf_name$ = { $fields$ } - >> - ) else - <:str_item< type $lid:cf_name$ = unit >> - ) cflist in - let cflist = concat_str_items cflist in + let types = List.map ( + fun (struct_name, all_fields) -> + let fields = List.map ( + fun (name, (typ, always_available)) -> + match typ with + | PP.FListHeadPointer _ -> + (* A list head turns into three fields, the pointer, + * the offset within current struct, and the adjustment + * (offset within destination struct). + *) + let t = ocaml_type_of_field_type (typ, always_available) in + [ <:ctyp< $lid:struct_name^"_"^name$ : $t$ >>; + <:ctyp< $lid:struct_name^"_"^name^"_offset"$ : int >>; + <:ctyp< $lid:struct_name^"_"^name^"_adjustment"$ : int >> ] + | _ -> + let t = ocaml_type_of_field_type (typ, always_available) in + [ <:ctyp< $lid:struct_name^"_"^name$ : $t$ >> ] + ) all_fields in + let fields = List.concat fields in + let fields = concat_record_fields fields in <:str_item< - type ('a, 'b) $lid:struct_name$ = 'a * 'b ;; - $sflist$ - $cflist$ + type $lid:struct_name$ = { $fields$ } + >>, + <:sig_item< + type $lid:struct_name$ = { $fields$ } >> ) xs in - concat_str_items strs, <:sig_item< >> + (* Generate a sum-type which can use to store any type of kernel + * structure, ie. Task_struct | Net_device | ... + *) + let types = types @ [ + let constrs = + List.map ( + fun (struct_name, _) -> + let struct_name_uc = String.capitalize struct_name in + <:ctyp< $uid:struct_name_uc$ of $lid:struct_name$ >> + ) xs in + let constrs = concat_sum_types constrs in + <:str_item< + type kernel_struct = $constrs$ + >>, + <:sig_item< + type kernel_struct = $constrs$ + >> + ] in + + let strs, sigs = List.split types in + concat_str_items strs, concat_sig_items sigs let generate_offsets xs = (* Only need to generate the offset_of_* functions for fields @@ -190,7 +218,9 @@ let generate_offsets xs = List.filter_map ( function | (_, - PP.FListHeadPointer ((Some (struct_name, field_name)) as f)) -> + (PP.FListHeadPointer + ((Some (struct_name, field_name)) as f), + _)) -> f | _ -> None @@ -252,10 +282,10 @@ let generate_offsets xs = let generate_parsers xs = let strs = List.map ( - fun (struct_name, palist) -> + fun (struct_name, (all_fields, palist)) -> let palist = List.map ( - fun { SC.pa_name = pa_name } -> + fun { MM.pa_name = pa_name } -> <:str_item< let $lid:pa_name$ kernel_version bits = $str:pa_name$ >> @@ -276,12 +306,10 @@ let generate_parsers xs = *) let subs = Hashtbl.create 13 in List.iter ( - fun (struct_name, palist) -> + fun (struct_name, (all_fields, palist)) -> List.iter ( - fun ({ SC.pa_name = pa_name; - pa_endian = endian; pa_structure = structure; - pa_shape_field_struct = sf; - pa_content_field_struct = cf }) -> + fun ({ MM.pa_name = pa_name; + pa_endian = endian; pa_structure = structure }) -> (* Generate the code to match this structure. *) let endian = match endian with @@ -319,73 +347,109 @@ let generate_parsers xs = ) structure.PP.struct_fields ) in - let shape_assignments = + let assignments = List.map ( - fun (field_name, field_type) -> - - (* Go and look up the field offset in the correct kernel. *) - let { PP.field_offset = offset } = - List.find (fun { PP.field_name = name } -> field_name = name) - structure.PP.struct_fields in - - (* Generate assignment code. List_heads are treated - * specially because they have an implicit adjustment. - *) - match field_type with - | PP.FListHeadPointer None -> - sprintf "%s_%s = %s; + fun (field_name, (field_type, always_available)) -> + if always_available then ( + (* Go and look up the field offset in the correct kernel. *) + let { PP.field_offset = offset } = + List.find (fun { PP.field_name = name } -> + field_name = name) + structure.PP.struct_fields in + + (* Generate assignment code. List_heads are treated + * specially because they have an implicit adjustment. + *) + match field_type with + | PP.FListHeadPointer None -> + sprintf "%s_%s = %s; %s_%s_offset = %d; %s_%s_adjustment = %d" - sf.SC.sf_name field_name field_name - sf.SC.sf_name field_name offset - sf.SC.sf_name field_name offset - - | PP.FListHeadPointer (Some (other_struct_name, - other_field_name)) -> - (* A reference to a field in another structure. We don't - * know the offset until runtime, so we have to call - * offset_of__ to find it. + struct_name field_name field_name + struct_name field_name offset + struct_name field_name offset + + | PP.FListHeadPointer (Some (other_struct_name, + other_field_name)) -> + (* A reference to a field in another structure. We don't + * know the offset until runtime, so we have to call + * offset_of__ to find it. + *) + sprintf "%s_%s = %s; + %s_%s_offset = %d; + %s_%s_adjustment = offset_of_%s_%s kernel_version" + struct_name field_name field_name + struct_name field_name offset (* in this struct *) + struct_name field_name (* ... & in other struct*) + other_struct_name other_field_name + + | _ -> + sprintf "%s_%s = %s" struct_name field_name field_name + ) else ( + (* Field is optional. Is it available in this kernel + * version? If so, get its offset, else throw Not_found. + *) + try + let { PP.field_offset = offset } = + List.find (fun { PP.field_name = name } -> + field_name = name) + structure.PP.struct_fields in + + (* Generate assignment code. List_heads are treated + * specially because they have an implicit adjustment. *) - sprintf "%s_%s = %s; + match field_type with + | PP.FListHeadPointer None -> + sprintf "%s_%s = Some %s; + %s_%s_offset = %d; + %s_%s_adjustment = %d" + struct_name field_name field_name + struct_name field_name offset + struct_name field_name offset + + | PP.FListHeadPointer (Some (other_struct_name, + other_field_name)) -> + (* A reference to a field in another structure. We + * don't know the offset until runtime, so we have + * to call offset_of__ to find it. + *) + sprintf "%s_%s = Some %s; %s_%s_offset = %d; %s_%s_adjustment = offset_of_%s_%s kernel_version" - sf.SC.sf_name field_name field_name - sf.SC.sf_name field_name offset (* in this struct *) - sf.SC.sf_name field_name (* ... & in other struct*) - other_struct_name other_field_name - - | _ -> - sprintf "%s_%s = %s" sf.SC.sf_name field_name field_name - ) sf.SC.sf_fields in - - let shape_assignments = - if shape_assignments = [] then "()" - else - "{ " ^ String.concat ";\n " shape_assignments ^ " }" in - - let content_assignments = - List.map ( - fun (field_name, _) -> - sprintf "%s_%s = %s" cf.SC.cf_name field_name field_name - ) cf.SC.cf_fields in - - let content_assignments = - if content_assignments = [] then "()" - else - "{ " ^ String.concat ";\n " content_assignments ^ " }" in + struct_name field_name field_name + struct_name field_name offset(*in this struct *) + struct_name field_name (*... & in other struct*) + other_struct_name other_field_name + + | _ -> + sprintf "%s_%s = Some %s" + struct_name field_name field_name + with + Not_found -> + (* Field is not available in this kernel version. *) + match field_type with + | PP.FListHeadPointer _ -> + sprintf "%s_%s = None; + %s_%s_offset = -1; + %s_%s_adjustment = -1" + struct_name field_name + struct_name field_name + struct_name field_name + | _ -> + sprintf "%s_%s = None" struct_name field_name + ) + ) all_fields in + + let assignments = String.concat ";\n " assignments in let code = sprintf " bitmatch bits with | { %s } -> - let s = - %s in - let c = - %s in - (s, c) + { %s } | { _ } -> raise (Virt_mem_types.ParseError (%S, %S, match_err))" - patterns shape_assignments content_assignments + patterns assignments struct_name pa_name in Hashtbl.add subs pa_name code @@ -394,238 +458,165 @@ let generate_parsers xs = (strs, <:sig_item< >>), subs -(* Helper functions to store things in a fixed-length tuple very efficiently. - * Note that the tuple length must be >= 2. - *) -type tuple = string list - -let tuple_create fields : tuple = fields +let generate_version_maps xs = + (* size_of_ kernel_version *) + let strs = List.map ( + fun (struct_name, (kernels, _)) -> + let map = + List.fold_right ( + fun ({ PP.kernel_version = version }, + { PP.struct_total_size = size }) map -> + <:expr< + StringMap.add $str:version$ $`int:size$ $map$ + >> + ) kernels <:expr< StringMap.empty >> in -(* Generates 'let _, _, resultpatt, _ = tupleexpr in body'. *) -let tuple_generate_extract fields field resultpatt tupleexpr body = - let patts = List.map ( - fun name -> if name = field then resultpatt else <:patt< _ >> - ) fields in - let result = build_tuple_from_patts patts in - <:expr< let $result$ = $tupleexpr$ in $body$ >> + <:str_item< + let $lid:"size_of_"^struct_name$ = + let map = $map$ in + fun kernel_version -> + try StringMap.find kernel_version map + with Not_found -> + unknown_kernel_version kernel_version $str:struct_name$ + >> + ) xs in -(* Generates '(fieldexpr1, fieldexpr2, ...)'. *) -let tuple_generate_construct fieldexprs = - build_tuple_from_exprs fieldexprs + (* parser_of_ kernel_version *) + let strs = strs @ List.map ( + fun (struct_name, (kernels, pahash)) -> + let map = + List.fold_right ( + fun ({ PP.kernel_version = version }, _) map -> + let { MM.pa_name = pa_name } = Hashtbl.find pahash version in + <:expr< + StringMap.add $str:version$ $lid:pa_name$ $map$ + >> + ) kernels <:expr< StringMap.empty >> in -type follower_t = - | Missing of string | Follower of string | KernelVersion of string + <:str_item< + let $lid:"parser_of_"^struct_name$ = + let map = $map$ in + fun kernel_version -> + try StringMap.find kernel_version map + with Not_found -> + unknown_kernel_version kernel_version $str:struct_name$ + >> + ) xs in -let generate_followers xs = - (* Tuple of follower functions, just a list of struct_names. *) - let follower_tuple = tuple_create (List.map fst xs) in + concat_str_items strs, <:sig_item< >> - (* A shape-follow function for every structure/shape. *) - let strs = List.map ( - fun (struct_name, (_, sflist, _, _)) -> - List.map ( - fun { SC.sf_name = sf_name; sf_fields = fields } -> - let body = List.fold_right ( - fun (name, typ) body -> - let follower_name = - match typ with - | PP.FListHeadPointer None -> struct_name - | PP.FListHeadPointer (Some (struct_name, _)) -> struct_name - | PP.FStructPointer struct_name -> struct_name - | _ -> assert false in +let generate_followers names xs = + (* A follower function for every structure. *) + let bindings = List.map ( + fun (struct_name, all_fields) -> + let followers = List.fold_right ( + fun (name, (typ, always_available)) rest -> + let is_shape_field = + match typ with + | PP.FListHeadPointer None -> true + | PP.FListHeadPointer (Some (struct_name, _)) + | PP.FStructPointer struct_name + when List.mem struct_name names -> true + | _ -> false in + if not is_shape_field then rest + else ( + let dest_struct_name = + match typ with + | PP.FListHeadPointer None -> struct_name + | PP.FListHeadPointer (Some (struct_name, _)) -> struct_name + | PP.FStructPointer struct_name -> struct_name + | _ -> assert false in + let body = match typ with | PP.FListHeadPointer _ -> - tuple_generate_extract follower_tuple follower_name - <:patt< f >> <:expr< followers >> - <:expr< + <:expr< (* For list head pointers, add the address of the base * of this virtual structure to the map, then adjust * the pointer. *) - let offset = shape.$lid:sf_name^"_"^name^"_offset"$ - and adj = shape.$lid:sf_name^"_"^name^"_adjustment"$ in + let offset = data.$lid:struct_name^"_"^name^"_offset"$ + and adj = data.$lid:struct_name^"_"^name^"_adjustment"$ in let offset = Int64.of_int offset and adj = Int64.of_int adj in (* 'addr' is base of the virtual struct *) let addr = Int64.sub (Int64.add addr offset) adj in - let map = AddrMap.add addr ($str:follower_name$, 0) map in - let out_addr = - Int64.sub shape.$lid:sf_name^"_"^name$ adj in let map = - f load followers map out_addr in - $body$ + AddrMap.add addr ($str:dest_struct_name$, None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = + $lid:dest_struct_name^"_follower"$ + kernel_version load map dest_addr in + map >> | PP.FStructPointer _ -> - tuple_generate_extract follower_tuple follower_name - <:patt< f >> <:expr< followers >> - <:expr< + <:expr< let map = - f load followers map shape.$lid:sf_name^"_"^name$ in - $body$ + $lid:dest_struct_name^"_follower"$ + kernel_version load map dest_addr in + map >> - | _ -> assert false - ) fields <:expr< map >> in - - <:str_item< - let $lid:sf_name^"_follower"$ load followers map addr shape = - $body$ - >> - ) sflist - ) xs in - let strs = List.concat strs in + | _ -> assert false in - (* A follower function for every kernel version / structure. When this - * function is called starting at some known root, it will load every - * reachable kernel structure. - *) - let strs = - let common = - (* Share as much common code as possible to minimize generated - * code size and benefit i-cache. - *) - <:str_item< - let kv_follower kernel_version struct_name total_size - parserfn followerfn - load followers map addr = - if addr <> 0L && not (AddrMap.mem addr map) then ( - let map = AddrMap.add addr (struct_name, total_size) map in - let bits = load struct_name addr total_size in - let shape, _ = parserfn kernel_version bits in - followerfn load followers map addr shape - ) - else map - >> in - - let fs = - List.map ( - fun (struct_name, (kernels, _, sfhash, pahash)) -> - List.map ( - fun ({ PP.kernel_version = version; kv_i = kv_i }, - { PP.struct_total_size = total_size }) -> - let { SC.pa_name = pa_name } = Hashtbl.find pahash version in - let { SC.sf_name = sf_name } = Hashtbl.find sfhash version in - - let fname = sprintf "%s_kv%d_follower" struct_name kv_i in - - <:str_item< - let $lid:fname$ = - kv_follower - $str:version$ $str:struct_name$ $`int:total_size$ - $lid:pa_name$ $lid:sf_name^"_follower"$ + if always_available then + <:expr< + let dest_addr = data.$lid:struct_name^"_"^name$ in + let map = $body$ in + $rest$ >> - ) kernels - ) xs in - - let strs = strs @ [ common ] @ List.concat fs in - strs in - - (* A map from kernel versions to follower functions. - * - * For each struct, we have a list of kernel versions which contain - * that struct. Some kernels are missing a particular struct, so - * that is turned into a ParseError exception. - *) - let strs = - let nr_kernels = - List.fold_left max 0 - (List.map (fun (_, (kernels, _, _, _)) -> List.length kernels) xs) in - let nr_structs = List.length xs in - let array = Array.make_matrix nr_kernels (nr_structs+1) (Missing "") in - List.iteri ( - fun si (struct_name, _) -> - for i = 0 to nr_kernels - 1 do - array.(i).(si+1) <- Missing struct_name - done - ) xs; - List.iteri ( - fun si (struct_name, (kernels, _, _, _)) -> - List.iter ( - fun ({ PP.kernel_version = version; kv_i = kv_i }, _) -> - array.(kv_i).(0) <- KernelVersion version; - array.(kv_i).(si+1) <- - Follower (sprintf "%s_kv%d_follower" struct_name kv_i) - ) kernels - ) xs; - - let array = Array.map ( - fun row -> - match Array.to_list row with - | [] | (Missing _|Follower _) :: _ -> assert false - | KernelVersion kernel_version :: followers -> kernel_version, followers - ) array in - - let map = List.fold_left ( - fun map (kernel_version, followers) -> - let followers = List.map ( - function - | Follower fname -> - <:expr< $lid:fname$ >> - - (* no follower for this kernel/struct combination *) - | Missing struct_name -> + else <:expr< - fun _ _ _ _ -> - raise ( - Virt_mem_types.ParseError ( - $str:struct_name$, "follower_map", struct_missing_err - ) - ) + let map = + match data.$lid:struct_name^"_"^name$ with + | None -> map + | Some dest_addr -> $body$ in + $rest$ >> - | KernelVersion _ -> assert false - ) followers in - let followers = tuple_generate_construct followers in - - <:expr< StringMap.add $str:kernel_version$ $followers$ $map$ >> - ) <:expr< StringMap.empty >> (Array.to_list array) in - - let str = - <:str_item< - let follower_map = $map$ - >> in - strs @ [ str ] in - - (* Finally a publicly exposed follower function for each structure. *) - let strs = - let fs = - List.map ( - fun (struct_name, (kernels, _, _, _)) -> - let fname = sprintf "%s_follower" struct_name in - - let body = - tuple_generate_extract follower_tuple struct_name - <:patt< f >> <:expr< followers >> - <:expr< f load followers AddrMap.empty addr >> in - - <:str_item< - let $lid:fname$ kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with Not_found -> - unknown_kernel_version kernel_version $str:struct_name$ in - $body$ - >> - ) xs in - - strs @ fs in - - let sigs = - List.map ( - fun (struct_name, _) -> - <:sig_item< - val $lid:struct_name^"_follower"$ : - kernel_version -> - (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> - (string * int) AddrMap.t - >> - ) xs in + ) + ) all_fields <:expr< map >> in + + let struct_name_uc = String.capitalize struct_name in + + <:binding< + $lid:struct_name^"_follower"$ kernel_version load map addr = + if addr <> 0L && not (AddrMap.mem addr map) then ( + let parser_ = $lid:"parser_of_"^struct_name$ kernel_version in + let total_size = $lid:"size_of_"^struct_name$ kernel_version in + let bits = load $str:struct_name$ addr total_size in + let data = parser_ kernel_version bits in + let map = AddrMap.add + addr ($str:struct_name$, + Some (total_size, bits, $uid:struct_name_uc$ data)) + map in + $followers$ + ) + else map + >> + ) xs in + let bindings = concat_bindings bindings in + let strs = <:str_item< let rec $bindings$ >> in + + (* Function signatures for the interface. *) + let sigs = List.map ( + fun (struct_name, _) -> + <:sig_item< + val $lid:struct_name^"_follower"$ : + kernel_version -> + (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> + (string * (int * Bitstring.bitstring * kernel_struct) option) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * (int * Bitstring.bitstring * kernel_struct) option) + AddrMap.t + >> + ) xs in + let sigs = concat_sig_items sigs in - concat_str_items strs, concat_sig_items sigs + strs, sigs -let output_interf ~output_file types offsets parsers followers = +let output_interf ~output_file types offsets parsers version_maps followers = (* Some standard code that appears at the top of the interface file. *) let prologue = <:sig_item< @@ -649,7 +640,8 @@ let output_interf ~output_file types offsets parsers followers = >> in let sigs = - concat_sig_items [ prologue; types; offsets; parsers; followers ] in + concat_sig_items [ prologue; types; offsets; parsers; + version_maps; followers ] in Printers.OCaml.print_interf ~output_file sigs; ignore (Sys.command (sprintf "wc -l %s" (Filename.quote output_file))) @@ -657,7 +649,8 @@ let output_interf ~output_file types offsets parsers followers = (* Finally generate the output files. *) let re_subst = Pcre.regexp "^(.*)\"(\\w+_parser_\\d+)\"(.*)$" -let output_implem ~output_file types offsets parsers parser_subs followers = +let output_implem ~output_file types offsets parsers parser_subs + version_maps followers = (* Some standard code that appears at the top of the implementation file. *) let prologue = <:str_item< @@ -667,10 +660,9 @@ let output_implem ~output_file types offsets parsers parser_subs followers = type kernel_version = string ;; let match_err = "failed to match kernel structure" ;; - let struct_missing_err = "struct does not exist in this kernel version" ;; let unknown_kernel_version version struct_name = - invalid_arg (Printf.sprintf "%s: unknown kernel version or + invalid_arg (sprintf "%s: unknown kernel version or struct %s is not supported in this kernel. Try a newer version of virt-mem, or if the guest is not from a supported Linux distribution, see this page about adding support: @@ -681,7 +673,8 @@ supported Linux distribution, see this page about adding support: >> in let strs = - concat_str_items [ prologue; types; offsets; parsers; followers ] in + concat_str_items [ prologue; types; offsets; parsers; + version_maps; followers ] in (* Write the new implementation to .ml.new file. *) let new_output_file = output_file ^ ".new" in diff --git a/extract/codegen/code_generation.mli b/extract/codegen/code_generation.mli index e359647..b803e71 100644 --- a/extract/codegen/code_generation.mli +++ b/extract/codegen/code_generation.mli @@ -36,13 +36,10 @@ type code = val generate_types : (string - * Struct_classify.shape_field_struct list - * Struct_classify.content_field_struct list) list -> + * (string * (Pahole_parser.f_type * bool)) list) list -> code - (** [generate_types structures] generates the internal - types used to store variants of each structure, including: - - shape field structures - - content field structures + (** [generate_types structures] generates the + types used to store each structure. *) (** {2 Generate offset functions} @@ -56,7 +53,7 @@ val generate_types : val generate_offsets : (string * ((Pahole_parser.info * Pahole_parser.structure) list - * (string * Pahole_parser.f_type) list)) list -> + * (string * (Pahole_parser.f_type * bool)) list)) list -> code (** [generate_offsets] generates the offset functions. *) @@ -66,7 +63,9 @@ val generate_offsets : into our internal types. *) -val generate_parsers : (string * Struct_classify.parser_ list) list -> +val generate_parsers : + (string * ((string * (Pahole_parser.f_type * bool)) list + * Minimizer.parser_ list)) list -> code * (string, string) Hashtbl.t (** [generate_parsers] generates the parser functions. @@ -76,6 +75,18 @@ val generate_parsers : (string * Struct_classify.parser_ list) list -> by the contents of the returned hash table in {!output_implem}. *) +(** {2 Generate version maps} + + The version maps are functions such as [size_of_ kernel_version] + which return some aspects of the structures and fields that + depend at runtime on the kernel version. +*) + +val generate_version_maps : + (string * ((Pahole_parser.info * Pahole_parser.structure) list + * (string, Minimizer.parser_) Hashtbl.t)) list -> + code + (** {2 Generate followers} The "followers" are functions which recursively follow every @@ -86,9 +97,8 @@ val generate_parsers : (string * Struct_classify.parser_ list) list -> *) val generate_followers : - (string * ((Pahole_parser.info * Pahole_parser.structure) list - * Struct_classify.shape_field_struct list - * Struct_classify.sfhash * Struct_classify.pahash)) list -> + string list -> + (string * (string * (Pahole_parser.f_type * bool)) list) list -> code (** [generate_followers] generates the follower functions. *) @@ -99,6 +109,7 @@ val output_interf : output_file:string -> Camlp4.PreCast.Syntax.Ast.sig_item -> Camlp4.PreCast.Syntax.Ast.sig_item -> Camlp4.PreCast.Syntax.Ast.sig_item -> + Camlp4.PreCast.Syntax.Ast.sig_item -> unit (** Output the interface file. *) @@ -108,5 +119,6 @@ val output_implem : output_file:string -> Camlp4.PreCast.Syntax.Ast.str_item -> (string, string) Hashtbl.t -> Camlp4.PreCast.Syntax.Ast.str_item -> + Camlp4.PreCast.Syntax.Ast.str_item -> unit (** Output the implementation file. *) diff --git a/extract/codegen/compile_kerneldb.ml b/extract/codegen/compile_kerneldb.ml index b9d3306..f5fc099 100644 --- a/extract/codegen/compile_kerneldb.ml +++ b/extract/codegen/compile_kerneldb.ml @@ -92,36 +92,7 @@ let good_structs = [ }; ] -(*---------------------------------------------------------------------- - * These are the code fragments which run over kernel structures. - *----------------------------------------------------------------------*) - -let fragments = [ - <:str_item< - let get_net_devices net_device = - let rec loop dev acc = - let ipv4 = net_device.ip_ptr.ifa_list in - let ipv4_addresses = - let rec loop2 ipv4 acc = - let addr = ipv4.ifa_address :: acc in - let ipv4 = ipv4.ifa_next in - loop2 ipv4 - in - loop ipv4 [] in - let acc = ipv4_addresses :: acc in - let next = get_net_devices net_device.dev_list'next in - if next <> net_device then loop next - else acc - >>; - - <:str_item< - let get_net_devices_from_init_net net = - get_net_devices net.dev_base_head'next - >>; - -] - -let debug = false +let debug = true open Camlp4.PreCast open Syntax @@ -132,7 +103,7 @@ open ExtString open Printf module PP = Pahole_parser -module SC = Struct_classify +module MM = Minimizer module CG = Code_generation let (//) = Filename.concat @@ -295,71 +266,36 @@ Options: (List.length kernels); printf " union of fields found:\n"; List.iter ( - fun (field_name, field_type) -> - printf " %s %s\n" (PP.string_of_f_type field_type) field_name + fun (field_name, (field_type, always_available)) -> + printf " %s %s /* %s */\n" + (PP.string_of_f_type field_type) field_name + (if always_available then "always" else "optional") ) all_fields ) structures; - (* Now perform the minimization step for each structure. - * We do separate minimization for: - * - shape field structures - * - content field structures - * - parsers - *) + (* Now perform the minimization step for parsers. *) let structures = List.map ( fun (struct_name, (kernels, all_fields)) -> - let sflist, sfhash = - SC.minimize_shape_field_structs struct_name good_struct_names - kernels in - - let cflist, cfhash = - SC.minimize_content_field_structs struct_name good_struct_names - kernels in - - let palist, pahash = - SC.minimize_parsers struct_name kernels sfhash cfhash in + let palist, pahash = MM.minimize_parsers struct_name kernels in - (struct_name, (kernels, all_fields, - sflist, sfhash, cflist, cfhash, palist, pahash)) + (struct_name, (kernels, all_fields, palist, pahash)) ) structures in if debug then List.iter ( fun (struct_name, - (kernels, all_fields, - sflist, sfhash, cflist, cfhash, palist, pahash)) -> + (kernels, all_fields, palist, pahash)) -> printf "struct %s:\n" struct_name; - printf " shape field structures:\n"; - List.iter ( - fun { SC.sf_name = name; sf_fields = fields } -> - printf " type %s = {\n" name; - List.iter ( - fun (name, typ) -> - printf " %s %s;\n" (PP.string_of_f_type typ) name - ) fields; - printf " }\n"; - ) sflist; - - printf " content field structures:\n"; + printf " parsers:\n"; List.iter ( - fun { SC.cf_name = name; cf_fields = fields } -> - printf " type %s = {\n" name; + fun { MM.pa_name = name; pa_structure = structure } -> + printf " let %s bits =\n" name; List.iter ( - fun (name, typ) -> + fun ({ PP.field_name = name; field_type = typ }) -> printf " %s %s;\n" (PP.string_of_f_type typ) name - ) fields; - printf " }\n"; - ) cflist; - - printf " parsers:\n"; - List.iter ( - fun { SC.pa_name = name; - pa_shape_field_struct = sf; - pa_content_field_struct = cf } -> - printf " let %s = ...\n" name; - printf " -> (%s, %s)\n" sf.SC.sf_name cf.SC.cf_name + ) structure.PP.struct_fields; ) palist ) structures; @@ -367,17 +303,15 @@ Options: let implem_types, interf_types = CG.generate_types ( List.map ( - fun (struct_name, - (_, _, sflist, _, cflist, _, _, _)) -> - (struct_name, sflist, cflist) + fun (struct_name, (_, all_fields, _, _)) -> + (struct_name, all_fields) ) structures ) in let implem_offsets, interf_offsets = CG.generate_offsets ( List.map ( - fun (struct_name, - (kernels, all_fields, _, _, _, _, _, _)) -> + fun (struct_name, (kernels, all_fields, _, _)) -> (struct_name, (kernels, all_fields)) ) structures ) in @@ -385,16 +319,23 @@ Options: let (implem_parsers, interf_parsers), subst_parsers = CG.generate_parsers ( List.map ( - fun (struct_name, (_, _, _, _, _, _, palist, _)) -> - (struct_name, palist) + fun (struct_name, (_, all_fields, palist, _)) -> + (struct_name, (all_fields, palist)) + ) structures + ) in + + let implem_version_maps, interf_version_maps = + CG.generate_version_maps ( + List.map ( + fun (struct_name, (kernels, _, _, pahash)) -> + (struct_name, (kernels, pahash)) ) structures ) in let implem_followers, interf_followers = - CG.generate_followers ( + CG.generate_followers good_struct_names ( List.map ( - fun (struct_name, (kernels, _, sflist, sfhash, _, _, _, pahash)) -> - (struct_name, (kernels, sflist, sfhash, pahash)) + fun (struct_name, (_, all_fields, _, _)) -> (struct_name, all_fields) ) structures ) in @@ -402,11 +343,13 @@ Options: let output_file = outputdir // "kernel.mli" in printf "Writing kernel data interface to %s ...\n%!" output_file; CG.output_interf ~output_file - interf_types interf_offsets interf_parsers interf_followers; + interf_types interf_offsets interf_parsers + interf_version_maps interf_followers; let output_file = outputdir // "kernel.ml" in printf "Writing kernel data parsers to %s ...\n%!" output_file; CG.output_implem ~output_file - implem_types implem_offsets implem_parsers subst_parsers implem_followers; + implem_types implem_offsets implem_parsers subst_parsers + implem_version_maps implem_followers; printf "Finished.\n" diff --git a/extract/codegen/kerneldb_to_parser.ml b/extract/codegen/kerneldb_to_parser.ml deleted file mode 100644 index 177d607..0000000 --- a/extract/codegen/kerneldb_to_parser.ml +++ /dev/null @@ -1,794 +0,0 @@ -(* Memory info 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. -*) - -(* This program takes the kernel database (in kernels/ in toplevel - directory) and generates parsing code for the various structures - in the kernel that we are interested in. - - The output programs -- *.ml, *.mli files of generated code -- go - into lib/ at the toplevel, eg. lib/kernel_task_struct.ml - - The stuff at the top of this file determine what structures - and fields we try to parse. -*) - -type struct_t = { - opener : string; (* String in pa_hole file which starts this struct. *) - closer : string; (* String in pa_hole file which ends this struct. *) - mandatory_struct : bool; (* Is this struct mandatory? *) - fields : (string * field_t) list; (* List of interesting fields. *) -} -and field_t = { - mandatory_field : bool; (* Is this field mandatory? *) - list_head_adjustment : bool; (* Only applies if the field points to a - * struct list_head: If true, then we do the - * list_head adjustment, so the field points - * to the start of the structure. If false, - * leave the pointer intact. The list_head - * adjustment only works if the list_head - * is in the same type of structure. - *) -} - -let ordinary_field = { mandatory_field = true; list_head_adjustment = true; } - -(*---------------------------------------------------------------------- - * This controls what structures & fields we will parse out. - *----------------------------------------------------------------------*) -let structs = [ - "task_struct", { - opener = "struct task_struct {"; closer = "};"; mandatory_struct = true; - fields = [ - "state", ordinary_field; - "prio", ordinary_field; - "normal_prio", ordinary_field; - "static_prio", ordinary_field; - "tasks'prev", ordinary_field; - "tasks'next", ordinary_field; - "mm", ordinary_field; - "active_mm", ordinary_field; - "comm", ordinary_field; - "pid", ordinary_field; - ] - }; -(* - "mm_struct", ( - "struct mm_struct {", "};", true, - [ ] - ); -*) - "net_device", { - opener = "struct net_device {"; closer = "};"; mandatory_struct = true; - fields = [ - "dev_list'prev", { mandatory_field = false; list_head_adjustment = true }; - "dev_list'next", { mandatory_field = false; list_head_adjustment = true }; - "next", { mandatory_field = false; list_head_adjustment = true }; - "name", ordinary_field; - "flags", ordinary_field; - "operstate", ordinary_field; - "mtu", ordinary_field; - "perm_addr", ordinary_field; - "addr_len", ordinary_field; - "ip_ptr", ordinary_field; - "ip6_ptr", ordinary_field; - ] - }; - "net", { - opener = "struct net {"; closer = "};"; mandatory_struct = false; - fields = [ - "dev_base_head'next", - (* Don't do list_head adjustment on this field, because it points - * to a net_device struct. - *) - { mandatory_field = true; list_head_adjustment = false }; - ] - }; - "in_device", { - opener = "struct in_device {"; closer = "};"; mandatory_struct = true; - fields = [ - "ifa_list", ordinary_field; - ]; - }; - "inet6_dev", { - opener = "struct inet6_dev {"; closer = "};"; mandatory_struct = true; - fields = [ - "addr_list", ordinary_field; - ]; - }; - "in_ifaddr", { - opener = "struct in_ifaddr {"; closer = "};"; mandatory_struct = true; - fields = [ - "ifa_next", ordinary_field; - "ifa_local", ordinary_field; - "ifa_address", ordinary_field; - "ifa_mask", ordinary_field; - "ifa_broadcast", ordinary_field; - ]; - }; - "inet6_ifaddr", { - opener = "struct inet6_ifaddr {"; closer = "};"; mandatory_struct = true; - fields = [ - (*"addr'in6_u'u6_addr8", ordinary_field;*) - "prefix_len", ordinary_field; - "lst_next", ordinary_field; - ]; - }; -] - -let debug = true - -open Camlp4.PreCast -open Syntax -(*open Ast*) - -open ExtList -open ExtString -open Printf - -module PP = Pahole_parser - -let (//) = Filename.concat - -(* Couple of handy camlp4 construction functions which do some - * things that ought to be easy/obvious but aren't. - * - * 'concat_str_items' concatenates a list of str_item together into - * one big str_item. - * - * 'concat_record_fields' concatenates a list of records fields into - * a record. The list must have at least one element. - * - * 'build_record' builds a record out of record fields. - * - * 'build_tuple_from_exprs' builds an arbitrary length tuple from - * a list of expressions of length >= 2. - * - * Thanks to bluestorm on #ocaml for getting these working. - *) -let concat_str_items _loc items = - match items with - | [] -> <:str_item< >> - | x :: xs -> - List.fold_left (fun xs x -> <:str_item< $xs$ $x$ >>) x xs - -let concat_sig_items _loc items = - match items with - | [] -> <:sig_item< >> - | x :: xs -> - List.fold_left (fun xs x -> <:sig_item< $xs$ $x$ >>) x xs - -let concat_record_fields _loc fields = - match fields with - | [] -> assert false - | f :: fs -> - List.fold_left (fun fs f -> <:ctyp< $fs$ ; $f$ >>) f fs - -let concat_record_bindings _loc rbs = - match rbs with - | [] -> assert false - | rb :: rbs -> - List.fold_left (fun rbs rb -> <:rec_binding< $rbs$ ; $rb$ >>) rb rbs - -let build_record _loc rbs = - Ast.ExRec (_loc, rbs, Ast.ExNil _loc) - -let build_tuple_from_exprs _loc exprs = - match exprs with - | [] | [_] -> assert false - | x :: xs -> - Ast.ExTup (_loc, - List.fold_left (fun xs x -> Ast.ExCom (_loc, x, xs)) x xs) - -let () = - let args = Array.to_list Sys.argv in - - let kernelsdir, outputdir = - match args with - | [_;kd;od] -> kd,od - | _ -> - let arg0 = Filename.basename Sys.executable_name in - eprintf "%s - Turn kernels database into code modules. - -Usage: - %s - -Example (from toplevel of virt-mem source tree): - %s kernels/ lib/ -" arg0 arg0 arg0; - exit 2 in - - let kernels = PP.list_kernels kernelsdir in - let nr_kernels = List.length kernels in - - let kernels = List.mapi ( - fun i info -> - printf "Loading kernel data file %d/%d\r%!" (i+1) nr_kernels; - - let struct_names = List.map fst structs in - let structures = PP.load_structures info struct_names in - - (* Make sure we got all the mandatory structures & fields. *) - List.iter ( - fun (struct_name, - { mandatory_struct = mandatory; fields = wanted_fields }) -> - try - let s = - List.find (fun s -> struct_name = s.PP.struct_name) - structures in - - (* Check we have all the mandatory fields. *) - let all_fields = s.PP.struct_fields in - List.iter ( - fun (wanted_field, { mandatory_field = mandatory }) -> - let got_it = - List.exists ( - fun { PP.field_name = name } -> name = wanted_field - ) all_fields in - if mandatory && not got_it then ( - eprintf "%s: structure %s is missing required field %s\n" - info.PP.basename struct_name wanted_field; - eprintf "fields found in this structure:\n"; - List.iter ( - fun { PP.field_name = name } -> eprintf "\t%s\n" name - ) all_fields; - exit 1 - ); - ) wanted_fields - - with Not_found -> - if mandatory then - failwith (sprintf "%s: structure %s not found in this kernel" - info.PP.basename struct_name) - ) structs; - - let structures = - List.map ( - fun ({ PP.struct_name = struct_name; PP.struct_fields = fields } - as structure) -> - let { fields = wanted_fields } = List.assoc struct_name structs in - - (* That got us all the fields, but we only care about - * the wanted_fields. - *) - let fields = List.filter ( - fun { PP.field_name = name } -> List.mem_assoc name wanted_fields - ) fields in - - (* Prefix all the field names with the structure name. *) - let fields = - List.map ( - fun ({ PP.field_name = name } as field) -> - let name = struct_name ^ "_" ^ name in - { field with PP.field_name = name } - ) fields in - { structure with PP.struct_fields = fields } - ) structures in - - (info, structures) - ) kernels in - - if debug then - List.iter ( - fun (info, structures) -> - printf "%s ----------\n" (PP.string_of_info info); - List.iter ( - fun structure -> - printf "%s\n\n" (PP.string_of_structure structure); - ) structures; - ) kernels; - - (* First output file is a simple list of kernels, to support the - * 'virt-mem --list-kernels' option. - *) - let () = - let _loc = Loc.ghost in - - let versions = List.map ( - fun ({ PP.kernel_version = version }, _) -> version - ) kernels in - - (* Sort them in reverse because we are going to generate the - * final list in reverse. - *) - let cmp a b = compare b a in - let versions = List.sort ~cmp versions in - - let xs = - List.fold_left (fun xs version -> <:expr< $str:version$ :: $xs$ >>) - <:expr< [] >> versions in - - let code = <:str_item< - let kernels = $xs$ - >> in - - let output_file = outputdir // "virt_mem_kernels.ml" in - printf "Writing list of kernels to %s ...\n%!" output_file; - Printers.OCaml.print_implem ~output_file code in - - (* We'll generate a code file for each structure type (eg. task_struct - * across all kernel versions), so rearrange 'kernels' for that purpose. - * - * XXX This loop is O(n^3), luckily n is small! - *) - let files = - List.map ( - fun (struct_name, _) -> - let kernels = - List.filter_map ( - fun (info, structures) -> - try - let structure = - List.find ( - fun { PP.struct_name = name } -> name = struct_name - ) structures in - Some (info, structure) - with Not_found -> - None - ) kernels in - - (* Sort the kernels, which makes the generated output more stable - * and makes patches more useful. - *) - let kernels = List.sort kernels in - - struct_name, kernels - ) structs in - - let kernels = () in ignore kernels; (* garbage collect *) - -(* - (* Get just the field types. - * - * It's plausible that a field with the same name has a different - * type between kernel versions, so we must check that didn't - * happen. - * - * This is complicated because of non-mandatory fields, which don't - * appear in every kernel version. - *) - let files = List.map ( - fun (struct_name, kernels) -> - let field_types = - (* Get the list of fields expected in this structure. *) - let { fields = struct_fields } = List.assoc struct_name structs in - - (* Get the list of fields that we found in each kernel version. *) - let found_fields = - List.flatten - (List.map (fun (_, _, _, (fields, _)) -> fields) kernels) in - - (* Determine a hash from each field name to the type. As we add - * fields, we might get a conflicting type (meaning the type - * changed between kernel versions). - *) - let hash = Hashtbl.create 13 in - - List.iter ( - fun (field_name, (typ, _, _)) -> - try - let field_type = Hashtbl.find hash field_name in - if typ <> field_type then - failwith (sprintf "%s.%s: structure field changed type between kernel versions" struct_name field_name); - with Not_found -> - Hashtbl.add hash field_name typ - ) found_fields; - - (* Now get a type for each structure field. *) - List.filter_map ( - fun (field_name, ft) -> - try - let field_name = struct_name ^ "_" ^ field_name in - let typ = Hashtbl.find hash field_name in - Some (field_name, (typ, ft)) - with Not_found -> - let msg = - sprintf "%s.%s: this field was not found in any kernel version" - struct_name field_name in - if ft.mandatory_field then failwith msg else prerr_endline msg; - None - ) struct_fields in - (struct_name, kernels, field_types) - ) files in - - (* To minimize generated code size, we want to fold together all - * structures where the particulars (eg. offsets, sizes, endianness) - * of the fields we care about are the same -- eg. between kernel - * versions which are very similar. - *) - 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) - in - - let files = - List.map ( - fun (struct_name, kernels, field_types) -> - let hash = Hashtbl.create 13 in - let i = ref 0 in - let xs = ref [] in - let kernels = - List.map ( - fun (basename, version, arch, (fields, total_size)) -> - let key = endian_of_architecture arch, fields in - let j = - try Hashtbl.find hash key - with Not_found -> - incr i; - xs := (!i, key) :: !xs; Hashtbl.add hash key !i; - !i in - (basename, version, arch, total_size, j) - ) kernels in - let parsers = List.rev !xs in - struct_name, kernels, field_types, parsers - ) files in - - (* How much did we save by sharing? *) - if debug then - List.iter ( - fun (struct_name, kernels, _, parsers) -> - printf "struct %s:\n" struct_name; - printf " number of kernel versions: %d\n" (List.length kernels); - printf " number of parser functions needed after sharing: %d\n" - (List.length parsers) - ) files; - - (* Extend the parsers fields by adding on any optional fields which - * are not actually present in the specific kernel. - *) - let files = - List.map ( - fun (struct_name, kernels, field_types, parsers) -> - let parsers = List.map ( - fun (i, (endian, fields)) -> - let fields_not_present = - List.filter_map ( - fun (field_name, _) -> - if List.mem_assoc field_name fields then None - else Some field_name - ) field_types in - (i, (endian, fields, fields_not_present)) - ) parsers in - (struct_name, kernels, field_types, parsers) - ) files in - - (* Let's generate some code! *) - let files = - List.map ( - fun (struct_name, kernels, field_types, parsers) -> - (* Dummy location required - there are no real locations for - * output files. - *) - let _loc = Loc.ghost in - - (* The structure type. *) - let struct_type, struct_sig = - let fields = List.map ( - function - | (name, (`Int, { mandatory_field = true })) -> - <:ctyp< $lid:name$ : int64 >> - | (name, (`Int, { mandatory_field = false })) -> - <:ctyp< $lid:name$ : int64 option >> - | (name, ((`VoidPtr|`Ptr _), { mandatory_field = true })) -> - <:ctyp< $lid:name$ : Virt_mem_mmap.addr >> - | (name, ((`VoidPtr|`Ptr _), { mandatory_field = false })) -> - <:ctyp< $lid:name$ : Virt_mem_mmap.addr option >> - | (name, (`Str _, { mandatory_field = true })) -> - <:ctyp< $lid:name$ : string >> - | (name, (`Str _, { mandatory_field = false })) -> - <:ctyp< $lid:name$ : string option >> - ) field_types in - let fields = concat_record_fields _loc fields in - let struct_type = <:str_item< type t = { $fields$ } >> in - let struct_sig = <:sig_item< type t = { $fields$ } >> in - struct_type, struct_sig in - - (* Create a "field signature" which describes certain aspects - * of the fields which vary between kernel versions. - *) - let fieldsig_type, fieldsigs = - let fieldsig_type = - let fields = List.map ( - fun (name, _) -> - let fsname = "__fs_" ^ name in - <:ctyp< $lid:fsname$ : Virt_mem_types.fieldsig >> - ) field_types in - let fields = concat_record_fields _loc fields in - <:str_item< type fs_t = { $fields$ } >> in - - let fieldsigs = List.map ( - fun (i, (_, fields, fields_not_present)) -> - let make_fieldsig field_name available offset = - let available = - if available then <:expr< true >> else <:expr< false >> in - let fsname = "__fs_" ^ field_name in - <:rec_binding< - $lid:fsname$ = - { Virt_mem_types.field_available = $available$; - field_offset = $`int:offset$ } - >> - in - let fields = List.map ( - fun (field_name, (_, offset, _)) -> - make_fieldsig field_name true offset - ) fields in - let fields_not_present = List.map ( - fun field_name -> - make_fieldsig field_name false (-1) - ) fields_not_present in - - let fieldsigs = fields @ fields_not_present in - let fsname = sprintf "fieldsig_%d" i in - let fieldsigs = concat_record_bindings _loc fieldsigs in - let fieldsigs = build_record _loc fieldsigs in - <:str_item< - let $lid:fsname$ = $fieldsigs$ - >> - ) parsers in - - let fieldsigs = concat_str_items _loc fieldsigs in - - fieldsig_type, fieldsigs in - - (* The shared parser functions. - * - * We could include bitmatch statements directly in here, but - * what happens is that the macros get expanded here, resulting - * in (even more) unreadable generated code. So instead just - * do a textual substitution later by post-processing the - * generated files. Not type-safe, but we can't have - * everything. - *) - let parser_stmts, parser_subs = - let parser_stmts = List.map ( - fun (i, _) -> - let fnname = sprintf "parser_%d" i in - <:str_item< - let $lid:fnname$ bits = $str:fnname$ - >> - ) parsers in - - let parser_stmts = concat_str_items _loc parser_stmts in - - (* What gets substituted for "parser_NN" ... *) - let parser_subs = List.map ( - fun (i, (endian, fields, fields_not_present)) -> - let fnname = sprintf "parser_%d" i in - let endian = - match endian with - | Bitstring.LittleEndian -> "littleendian" - | Bitstring.BigEndian -> "bigendian" - | _ -> assert false in - let patterns = - (* Fields must be sorted by offset, otherwise bitmatch - * will complain. - *) - let cmp (_, (_, o1, _)) (_, (_, o2, _)) = compare o1 o2 in - let fields = List.sort ~cmp fields in - String.concat ";\n " ( - List.map ( - function - | (field_name, ((`Int|`Ptr _|`VoidPtr), offset, size)) -> - (* 'zero+' is a hack to force the type to int64. *) - sprintf "%s : zero+%d : offset(%d), %s" - field_name (size*8) (offset*8) endian - | (field_name, (`Str width, offset, size)) -> - sprintf "%s : %d : offset(%d), string" - field_name (width*8) (offset*8) - ) fields - ) in - let assignments = - List.map ( - fun (field_name, typ) -> - let (_, { mandatory_field = mandatory; - list_head_adjustment = list_head_adjustment }) = - try List.assoc field_name field_types - with Not_found -> - failwith (sprintf "%s: not found in field_types" - field_name) in - match typ, mandatory, list_head_adjustment with - | (`Ptr "list_head", offset, size), true, true -> - sprintf "%s = Int64.sub %s %dL" - field_name field_name offset - | (`Ptr "list_head", offset, size), false, true -> - sprintf "%s = Some (Int64.sub %s %dL)" - field_name field_name offset - | _, true, _ -> - sprintf "%s = %s" field_name field_name - | _, false, _ -> - sprintf "%s = Some %s" field_name field_name - ) fields in - let assignments_not_present = - List.map ( - fun field_name -> sprintf "%s = None" field_name - ) fields_not_present in - - let assignments = - String.concat ";\n " - (assignments @ assignments_not_present) in - - let sub = - sprintf " - bitmatch bits with - | { %s } -> - { %s } - | { _ } -> - raise (Virt_mem_types.ParseError (struct_name, %S, match_err))" - patterns assignments fnname in - - fnname, sub - ) parsers in - - parser_stmts, parser_subs in - - (* Define a map from kernel versions to parsing functions. *) - let version_map = - let stmts = List.fold_left ( - fun stmts (_, version, arch, total_size, i) -> - let parserfn = sprintf "parser_%d" i in - let fsname = sprintf "fieldsig_%d" i in - <:str_item< - $stmts$ - let v = ($lid:parserfn$, $`int:total_size$, $lid:fsname$) - let map = StringMap.add $str:version$ v map - >> - ) <:str_item< let map = StringMap.empty >> kernels in - - <:str_item< - module StringMap = Map.Make (String) ;; - $stmts$ - >> in - - (* Accessors for the field signatures. *) - let fsaccess, fsaccess_sig = - let fields = List.map ( - fun (field_name, _) -> - let fsname = "__fs_" ^ field_name in - <:str_item< - let $lid:"field_signature_of_"^field_name$ version = - let _, _, fs = StringMap.find version map in - fs.$lid:fsname$ - >> - ) field_types in - - let fsaccess = concat_str_items _loc fields in - - let fields = List.map ( - fun (field_name, _) -> - <:sig_item< - val $lid:"field_signature_of_"^field_name$ : kernel_version -> - Virt_mem_types.fieldsig - >> - ) field_types in - - let fsaccess_sig = concat_sig_items _loc fields in - - fsaccess, fsaccess_sig in - - (* Code (.ml file). *) - let code = <:str_item< - let zero = 0 - let struct_name = $str:struct_name$ - let match_err = "failed to match kernel structure" ;; - $struct_type$ - $fieldsig_type$ - $fieldsigs$ - $parser_stmts$ - $version_map$ - - type kernel_version = string - let $lid:struct_name^"_known"$ version = StringMap.mem version map - let $lid:struct_name^"_size"$ version = - let _, size, _ = StringMap.find version map in - size - let $lid:struct_name^"_of_bits"$ version bits = - let parsefn, _, _ = StringMap.find version map in - parsefn bits - let $lid:"get_"^struct_name$ version mem addr = - let parsefn, size, _ = StringMap.find version map in - let bytes = Virt_mem_mmap.get_bytes mem addr size in - let bits = Bitstring.bitstring_of_string bytes in - parsefn bits ;; - $fsaccess$ - >> in - - (* Interface (.mli file). *) - let interface = <:sig_item< - $struct_sig$ - - val struct_name : string - type kernel_version = string - val $lid:struct_name^"_known"$ : kernel_version -> bool - val $lid:struct_name^"_size"$ : kernel_version -> int - val $lid:struct_name^"_of_bits"$ : - kernel_version -> Bitstring.bitstring -> t - val $lid:"get_"^struct_name$ : kernel_version -> - ('a, 'b, [`HasMapping]) Virt_mem_mmap.t -> Virt_mem_mmap.addr -> t;; - $fsaccess_sig$ - >> in - - (struct_name, code, interface, parser_subs) - ) files in - - (* Finally generate the output files. *) - let re_subst = Pcre.regexp "^(.*)\"(parser_\\d+)\"(.*)$" in - - List.iter ( - fun (struct_name, code, interface, parser_subs) -> - (* Interface (.mli file). *) - let output_file = outputdir // "kernel_" ^ struct_name ^ ".mli" in - printf "Writing %s interface to %s ...\n%!" struct_name output_file; - Printers.OCaml.print_interf ~output_file interface; - - (* Implementation (.ml file). *) - let output_file = outputdir // "kernel_" ^ struct_name ^ ".ml" in - printf "Writing %s implementation to %s ...\n%!" struct_name output_file; - - let new_output_file = output_file ^ ".new" in - Printers.OCaml.print_implem ~output_file:new_output_file code; - - (* Substitute the parser bodies in the output file. *) - let ichan = open_in new_output_file in - let ochan = open_out output_file in - - output_string ochan "\ -(* WARNING: This file and the corresponding mli (interface) are - * automatically generated by the extract/codegen/kerneldb_to_parser.ml - * program. - * - * Any edits you make to this file will be lost. - * - * To update this file from the latest kernel database, it is recommended - * that you do 'make update-kernel-structs'. - *)\n\n"; - - let rec loop () = - let line = input_line ichan in - let line = - if Pcre.pmatch ~rex:re_subst line then ( - let subs = Pcre.exec ~rex:re_subst line in - let start = Pcre.get_substring subs 1 in - let template = Pcre.get_substring subs 2 in - let rest = Pcre.get_substring subs 3 in - let sub = List.assoc template parser_subs in - start ^ sub ^ rest - ) else line in - output_string ochan line; output_char ochan '\n'; - loop () - in - (try loop () with End_of_file -> ()); - - close_out ochan; - close_in ichan; - - Unix.unlink new_output_file - ) files -*) diff --git a/extract/codegen/minimizer.ml b/extract/codegen/minimizer.ml new file mode 100644 index 0000000..ede6a47 --- /dev/null +++ b/extract/codegen/minimizer.ml @@ -0,0 +1,87 @@ +(* 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 parser_ = { + pa_i : int; + pa_name : string; + pa_endian : Bitstring.endian; + pa_structure : Pahole_parser.structure; +} + +and pahash = (string, parser_) Hashtbl.t + +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 + +let hash_values h = Hashtbl.fold (fun _ v vs -> v :: vs) h [] + +let minimize_parsers struct_name kernels = + let h = Hashtbl.create 13 in + let rh = Hashtbl.create 13 in + + (* Do not change - see Code_generation.re_subst. *) + 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 } + as structure)) -> + 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 pa = { pa_i = i; pa_name = name_of i; + pa_endian = endian; + pa_structure = structure } in + Hashtbl.add h key pa; + pa in + Hashtbl.add rh version pa + ) kernels; + + let pas = hash_values h in + pas, rh diff --git a/extract/codegen/minimizer.mli b/extract/codegen/minimizer.mli new file mode 100644 index 0000000..e5937e0 --- /dev/null +++ b/extract/codegen/minimizer.mli @@ -0,0 +1,59 @@ +(** Parser minimization. *) +(* 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. + *) + +(** + {2 How it works} + + {!Pahole_parser} has parsed in a limited set of structures from + each available kernel. We now aim to take a holistic view of + a structure as it changed over time, though different kernel + versions and also on different architectures. + + {3 Generated parsing functions} + + A form of minimization is required to find kernel structures which + happen to be similar - ie. all the fields happen to be in the same + place, with the same wordsize and endianness. + + We can then generate a minimal set of parsing functions which + map the binary data from the kernel image into structures. +*) + +(** {2 Minimization of parsers} *) + +type parser_ (* parser is a reserved word *) = { + pa_i : int; (** Unique number. *) + pa_name : string; (** Parser function name in output. *) + pa_endian : Bitstring.endian; (** Default field endianness. *) + pa_structure : Pahole_parser.structure; (** Original structure. *) +} + (** The type of a parser. *) + +type pahash = (string, parser_) Hashtbl.t + (** Hash of the kernel version string to the parser. *) + +val minimize_parsers : + string -> + (Pahole_parser.info * Pahole_parser.structure) list -> + parser_ list * pahash + (** [minimize_parsers struct_name kernels] returns a minimized + list of parsers and a hash table of kernel version to + {!parser_}). + *) diff --git a/extract/codegen/pahole_parser.ml b/extract/codegen/pahole_parser.ml index 99e36de..029ecde 100644 --- a/extract/codegen/pahole_parser.ml +++ b/extract/codegen/pahole_parser.ml @@ -437,11 +437,27 @@ let get_fields structures = *) let h = Hashtbl.create 13 in + (* A hash to check for fields which aren't always available by + * counting the number of times we see each field. + *) + let count, get = + let h = Hashtbl.create 13 in + let count field_name = + let r = + try Hashtbl.find h field_name + with Not_found -> let r = ref 0 in Hashtbl.add h field_name r; r in + incr r + in + let get field_name = try !(Hashtbl.find h field_name) with Not_found -> 0 in + count, get + in + List.iter ( fun ({kernel_version = version}, {struct_name = struct_name; struct_fields = fields}) -> List.iter ( fun {field_name = name; field_type = typ} -> + count name; try let (field_type, version_first_seen) = Hashtbl.find h name in if typ <> field_type then ( @@ -460,10 +476,13 @@ let get_fields structures = ) fields ) structures; + let nr_kernels = List.length structures in + let fields = Hashtbl.fold ( fun name (typ, _) fields -> - (name, typ) :: fields + let always_available = get name = nr_kernels in + (name, (typ, always_available)) :: fields ) h [] in List.sort fields diff --git a/extract/codegen/pahole_parser.mli b/extract/codegen/pahole_parser.mli index 8444e5f..1bbd701 100644 --- a/extract/codegen/pahole_parser.mli +++ b/extract/codegen/pahole_parser.mli @@ -125,9 +125,14 @@ val transpose : string list -> The first parameter is the list of structure names of interest, and should be the same as was passed to {!load_structures}. *) -val get_fields : (info * structure) list -> (string * f_type) list +val get_fields : (info * structure) list -> (string * (f_type * bool)) list (** This gets a complete list of fields which have appeared in - any kernel version, and the type of those fields. + any kernel version. + + The return list contains [(field_name, (field_type, + always_present))] where [always_present] is a boolean flag which + is true if the field is present in every kernel version we + examined. Fields must not change type between kernel versions - if so this function prints an error and exits. (We may support diff --git a/extract/codegen/struct_classify.ml b/extract/codegen/struct_classify.ml deleted file mode 100644 index 376c301..0000000 --- a/extract/codegen/struct_classify.ml +++ /dev/null @@ -1,196 +0,0 @@ -(* 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.FListHeadPointer None -> ShapeField - | (PP.FStructPointer struct_name - | PP.FListHeadPointer (Some (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 : (string * PP.f_type) list; -} - -and content_field_struct = { - cf_i : int; - cf_name : string; - cf_fields : (string * PP.f_type) list; -} - -and parser_ = { - pa_i : int; - pa_name : string; - pa_endian : Bitstring.endian; - pa_structure : Pahole_parser.structure; - pa_shape_field_struct : shape_field_struct; - pa_content_field_struct : content_field_struct; -} - -and sfhash = (string, shape_field_struct) Hashtbl.t -and cfhash = (string, content_field_struct) Hashtbl.t -and pahash = (string, parser_) Hashtbl.t - -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 (n1,_) (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_map ( - fun { PP.field_name = name; field_type = typ } -> - if classify_field names typ = ShapeField then Some (name, typ) - else None - ) - 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 fst 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_map ( - fun { PP.field_name = name; field_type = typ } -> - if classify_field names typ = ContentField then Some (name, typ) - else None - ) - 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 fst 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 - - (* Do not change - see Code_generation.re_subst. *) - 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 } - as structure)) -> - 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_endian = endian; - pa_structure = structure; - 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 diff --git a/extract/codegen/struct_classify.mli b/extract/codegen/struct_classify.mli deleted file mode 100644 index b0cd5da..0000000 --- a/extract/codegen/struct_classify.mli +++ /dev/null @@ -1,180 +0,0 @@ -(** Structure classification. *) -(* 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. - *) - -(** - {2 How it works} - - There's no getting around it, this is complicated. - - {!Pahole_parser} has parsed in a limited set of structures from - each available kernel. We now aim to take a holistic view of - a structure as it changed over time, though different kernel - versions and also on different architectures. - - {3 Shape fields and content fields} - - A structure is a list of fields. - - Fields fall into two classifications, as far as we are interested: - - (i) 'Shape' fields define the relationship between different - structures. Shape fields are all pointers to other structures - that we care about. They have type {!Pahole_parser.FStructPointer} - and {!Pahole_parser.FListHeadPointer}. - - (ii) 'Content' fields are fields in a structure that contain - some data, like ints and strings. (In the current implementation, - it's anything left which isn't a shape field). - - So we can easily take a structure and place its fields into two - buckets. For example, with [task_struct] it might be: - - [task_struct] shape fields: - - [tasks'next] (the linked list of tasks) - - [tasks'prev] - - [parent] (points to the parent task) - - [task_struct] content fields: - - [pid] (process ID) - - [comm] (task name) - - etc. etc. - - {3 Shape fields and iterator functions} - - For each kernel/structure we can build a list of shape fields, but - in fact in many kernels they will be the same, so we also - performing a {i sharing} operation to minimize the number of - variations. - - We also write (by hand) iterator functions. These iterator - functions are matched to the corresponding shape field structure, - by setting up some prerequisites that the function needs, then - matching on those prerequisites with the available shape - field structures. - - {3 Content fields and printing functions} - - The same (minimization & matching) applies to hand-written printing - functions over content field structures. - - {3 Generated parsing functions} - - A third form of minimization is required to find kernel - structures which happen to be similar - ie. all the fields - happen to be in the same place, with the same wordsize and - endianness. - - We can then generate a minimal set of parsing functions which - map the binary data from the kernel image into shape and - content field structures. - - {3 Generated loading code} - - Finally, we generate recursive loading code which recurses over - structures into order to load the kernel memory and invoke the - correct parsers on it, ensuring that when the program runs, all - known kernel structures are recursively reached and loaded in. -*) - -(** {2 Field classification} *) - -type f_class = ShapeField | ContentField - -val classify_field : string list -> Pahole_parser.f_type -> f_class - (** [classify_field names field] classifies a field as either - a shape field or a content field. [names] is a list of - all kernel structures that we care about. *) - -(** {2 Minimization of shape field structures and content field structures} *) - -type shape_field_struct = { - sf_i : int; (** Unique number. *) - sf_name : string; (** Structure name in output. *) - sf_fields : (string * Pahole_parser.f_type) list; (** Shape fields. *) -} - (** The type of a shape field structure. *) - -and content_field_struct = { - cf_i : int; (** Unique number. *) - cf_name : string; (** Structure name in output. *) - cf_fields : (string * Pahole_parser.f_type) list; (** Content fields. *) -} - (** The type of a content field structure. *) - -type sfhash = (string, shape_field_struct) Hashtbl.t - (** Hash of kernel version to the shape field structure. *) - -val minimize_shape_field_structs : - string -> string list -> - (Pahole_parser.info * Pahole_parser.structure) list -> - shape_field_struct list * sfhash - (** [minimize_shape_field_structs struct_name names kernels] returns - a minimized list of shape field structures - (a hash table of kernel version to {!shape_field_struct}). - - [struct_name] is the name of the structure. - - [names] is the list of interesting kernel structures. *) - -type cfhash = (string, content_field_struct) Hashtbl.t - (** Hash of kernel version to the content field structure. *) - -val minimize_content_field_structs : - string -> string list -> - (Pahole_parser.info * Pahole_parser.structure) list -> - content_field_struct list * cfhash - (** [minimize_content_field_structs struct_name names kernels] returns - a minimized list of content field structures - (a hash table of kernel version to {!content_field_struct}). - - [struct_name] is the name of the structure. - - [names] is the list of interesting kernel structures. *) - -(** {2 Minimization of parsers} *) - -type parser_ (* parser is a reserved word *) = { - pa_i : int; (** Unique number. *) - pa_name : string; (** Parser function name in output. *) - (* The input to the parser: *) - pa_endian : Bitstring.endian; (** Default field endianness. *) - pa_structure : Pahole_parser.structure; (** Original structure. *) - (* The output of the parser: *) - pa_shape_field_struct : shape_field_struct; - pa_content_field_struct : content_field_struct; -} - (** The type of a parser. *) - -type pahash = (string, parser_) Hashtbl.t - (** Hash of the kernel version to the parser. *) - -val minimize_parsers : - string -> - (Pahole_parser.info * Pahole_parser.structure) list -> - sfhash -> cfhash -> - parser_ list * pahash - (** [minimize_parsers struct_name kernels sfhash cfhash] returns - a minimized list of parsers (a hash table of kernel version - to {!parser_}). - - [sfhash] and [cfhash] are the kernel version -> shape/content - field struct hashes returned by a previous call to - {!minimize_shape_field_structs} and {!minimize_content_field_structs} - respectively. *) diff --git a/lib/Makefile.in b/lib/Makefile.in index e96a542..e386af0 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -76,13 +76,6 @@ virt_mem.cma: $(OBJS) virt_mem.cmxa: $(XOBJS) ocamlmklib -o virt_mem $^ -# The autogenerated code in kernel.ml contains recursive types. -kernel.cmo: kernel.ml - $(OCAMLFIND) ocamlc -rectypes $(OCAMLCFLAGS) $(OCAMLCPACKAGES) -c $< - -kernel.cmx: kernel.ml - $(OCAMLFIND) ocamlopt -rectypes $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) -c $< - # Just for testing Virt_mem_mmap module: test_mmap: virt_mem_utils.cmx virt_mem_mmap_c.o virt_mem_mmap.cmx test_mmap.cmx ocamlfind ocamlopt \ diff --git a/lib/kernel.ml b/lib/kernel.ml index b02e187..95df51d 100644 --- a/lib/kernel.ml +++ b/lib/kernel.ml @@ -12,10 +12,9 @@ module StringMap = Map.Make(String);; module AddrMap = Map.Make(Int64);; type kernel_version = string;; let match_err = "failed to match kernel structure";; -let struct_missing_err = "struct does not exist in this kernel version";; let unknown_kernel_version version struct_name = invalid_arg - (Printf.sprintf + (sprintf "%s: unknown kernel version or struct %s is not supported in this kernel. Try a newer version of virt-mem, or if the guest is not from a @@ -24,75 +23,57 @@ supported Linux distribution, see this page about adding support: " version struct_name);; let zero = 0;; -type ('a, 'b) task_struct = ('a * 'b);; -type task_struct_shape_fields_1 = - { task_struct_shape_fields_1_tasks'next : Virt_mem_mmap.addr; - task_struct_shape_fields_1_tasks'next_offset : int; - task_struct_shape_fields_1_tasks'next_adjustment : int +type task_struct = + { task_struct_comm : string; task_struct_normal_prio : int64; + task_struct_pid : int64; task_struct_prio : int64; + task_struct_run_list'next : Virt_mem_mmap.addr option; + task_struct_run_list'next_offset : int; + task_struct_run_list'next_adjustment : int; + task_struct_run_list'prev : Virt_mem_mmap.addr option; + task_struct_state : int64; task_struct_static_prio : int64; + task_struct_tasks'next : Virt_mem_mmap.addr; + task_struct_tasks'next_offset : int; + task_struct_tasks'next_adjustment : int; + task_struct_tasks'prev : Virt_mem_mmap.addr };; -type task_struct_content_fields_2 = - { task_struct_content_fields_2_comm : string; - task_struct_content_fields_2_normal_prio : int64; - task_struct_content_fields_2_pid : int64; - task_struct_content_fields_2_prio : int64; - task_struct_content_fields_2_state : int64; - task_struct_content_fields_2_static_prio : int64; - task_struct_content_fields_2_tasks'prev : Virt_mem_mmap.addr +type net_device = + { net_device_addr_len : int64; + net_device_dev_list'next : Virt_mem_mmap.addr option; + net_device_dev_list'next_offset : int; + net_device_dev_list'next_adjustment : int; + net_device_dev_list'prev : Virt_mem_mmap.addr option; + net_device_flags : int64; net_device_ip6_ptr : Virt_mem_mmap.addr; + net_device_ip_ptr : Virt_mem_mmap.addr; net_device_mtu : int64; + net_device_name : string; net_device_next : Virt_mem_mmap.addr option; + net_device_operstate : int64; net_device_perm_addr : string };; -type ('a, 'b) net_device = ('a * 'b);; -type net_device_shape_fields_8 = - { net_device_shape_fields_8_dev_list'next : Virt_mem_mmap.addr; - net_device_shape_fields_8_dev_list'next_offset : int; - net_device_shape_fields_8_dev_list'next_adjustment : int; - net_device_shape_fields_8_ip6_ptr : Virt_mem_mmap.addr; - net_device_shape_fields_8_ip_ptr : Virt_mem_mmap.addr +type net = + { net_dev_base_head'next : Virt_mem_mmap.addr; + net_dev_base_head'next_offset : int; + net_dev_base_head'next_adjustment : int; + net_dev_base_head'prev : Virt_mem_mmap.addr; + net_dev_base_head'prev_offset : int; + net_dev_base_head'prev_adjustment : int };; -type net_device_content_fields_9 = - { net_device_content_fields_9_addr_len : int64; - net_device_content_fields_9_dev_list'prev : Virt_mem_mmap.addr; - net_device_content_fields_9_flags : int64; - net_device_content_fields_9_mtu : int64; - net_device_content_fields_9_name : string; - net_device_content_fields_9_operstate : int64; - net_device_content_fields_9_perm_addr : string +type in_device = { in_device_ifa_list : Virt_mem_mmap.addr };; +type inet6_dev = { inet6_dev_addr_list : Virt_mem_mmap.addr };; +type in_ifaddr = + { in_ifaddr_ifa_address : int64; in_ifaddr_ifa_broadcast : int64; + in_ifaddr_ifa_local : int64; in_ifaddr_ifa_mask : int64; + in_ifaddr_ifa_next : Virt_mem_mmap.addr };; -type ('a, 'b) net = ('a * 'b);; -type net_shape_fields_14 = - { net_shape_fields_14_dev_base_head'next : Virt_mem_mmap.addr; - net_shape_fields_14_dev_base_head'next_offset : int; - net_shape_fields_14_dev_base_head'next_adjustment : int; - net_shape_fields_14_dev_base_head'prev : Virt_mem_mmap.addr; - net_shape_fields_14_dev_base_head'prev_offset : int; - net_shape_fields_14_dev_base_head'prev_adjustment : int - };; -type net_content_fields_15 = unit;; -type ('a, 'b) in_device = ('a * 'b);; -type in_device_shape_fields_20 = - { in_device_shape_fields_20_ifa_list : Virt_mem_mmap.addr - };; -type in_device_content_fields_21 = unit;; -type ('a, 'b) inet6_dev = ('a * 'b);; -type inet6_dev_shape_fields_26 = - { inet6_dev_shape_fields_26_addr_list : Virt_mem_mmap.addr - };; -type inet6_dev_content_fields_27 = unit;; -type ('a, 'b) in_ifaddr = ('a * 'b);; -type in_ifaddr_shape_fields_32 = - { in_ifaddr_shape_fields_32_ifa_next : Virt_mem_mmap.addr - };; -type in_ifaddr_content_fields_33 = - { in_ifaddr_content_fields_33_ifa_address : int64; - in_ifaddr_content_fields_33_ifa_broadcast : int64; - in_ifaddr_content_fields_33_ifa_local : int64; - in_ifaddr_content_fields_33_ifa_mask : int64 - };; -type ('a, 'b) inet6_ifaddr = ('a * 'b);; -type inet6_ifaddr_shape_fields_38 = - { inet6_ifaddr_shape_fields_38_lst_next : Virt_mem_mmap.addr - };; -type inet6_ifaddr_content_fields_39 = - { inet6_ifaddr_content_fields_39_prefix_len : int64 +type inet6_ifaddr = + { inet6_ifaddr_lst_next : Virt_mem_mmap.addr; + inet6_ifaddr_prefix_len : int64 };; +type kernel_struct = + Task_struct of task_struct + | Net_device of net_device + | Net of net + | In_device of in_device + | Inet6_dev of inet6_dev + | In_ifaddr of in_ifaddr + | Inet6_ifaddr of inet6_ifaddr;; let offset_of_net_device_dev_list'next = let map = StringMap.add "2.6.25.14-69.fc8.i686" 48 @@ -109,7 +90,7 @@ let offset_of_net_device_dev_list'next = (StringMap.add "2.6.25.14-69.fc8.x86_64" 72 StringMap.empty))))))))))) in fun kernel_version -> StringMap.find kernel_version map;; -let task_struct_parser_3 kernel_version bits = +let task_struct_parser_1 kernel_version bits = bitmatch bits with | { state : zero+64 : offset(0), littleendian; prio : zero+32 : offset(224), littleendian; @@ -119,22 +100,23 @@ let task_struct_parser_3 kernel_version bits = tasks'prev : zero+64 : offset(3904), littleendian; pid : zero+32 : offset(4352), littleendian; comm : 128 : offset(8392), string } -> - let s = - { task_struct_shape_fields_1_tasks'next = tasks'next; - task_struct_shape_fields_1_tasks'next_offset = 480; - task_struct_shape_fields_1_tasks'next_adjustment = 480 } in - let c = - { task_struct_content_fields_2_comm = comm; - task_struct_content_fields_2_normal_prio = normal_prio; - task_struct_content_fields_2_pid = pid; - task_struct_content_fields_2_prio = prio; - task_struct_content_fields_2_state = state; - task_struct_content_fields_2_static_prio = static_prio; - task_struct_content_fields_2_tasks'prev = tasks'prev } in - (s, c) + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = None; + task_struct_run_list'next_offset = -1; + task_struct_run_list'next_adjustment = -1; + task_struct_run_list'prev = None; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 480; + task_struct_tasks'next_adjustment = 480; + task_struct_tasks'prev = tasks'prev } | { _ } -> - raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_3", match_err));; -let task_struct_parser_4 kernel_version bits = + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_1", match_err));; +let task_struct_parser_2 kernel_version bits = bitmatch bits with | { state : zero+64 : offset(0), bigendian; prio : zero+32 : offset(224), bigendian; @@ -144,22 +126,23 @@ let task_struct_parser_4 kernel_version bits = tasks'prev : zero+64 : offset(3904), bigendian; pid : zero+32 : offset(4352), bigendian; comm : 128 : offset(8392), string } -> - let s = - { task_struct_shape_fields_1_tasks'next = tasks'next; - task_struct_shape_fields_1_tasks'next_offset = 480; - task_struct_shape_fields_1_tasks'next_adjustment = 480 } in - let c = - { task_struct_content_fields_2_comm = comm; - task_struct_content_fields_2_normal_prio = normal_prio; - task_struct_content_fields_2_pid = pid; - task_struct_content_fields_2_prio = prio; - task_struct_content_fields_2_state = state; - task_struct_content_fields_2_static_prio = static_prio; - task_struct_content_fields_2_tasks'prev = tasks'prev } in - (s, c) + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = None; + task_struct_run_list'next_offset = -1; + task_struct_run_list'next_adjustment = -1; + task_struct_run_list'prev = None; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 480; + task_struct_tasks'next_adjustment = 480; + task_struct_tasks'prev = tasks'prev } | { _ } -> - raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_4", match_err));; -let task_struct_parser_5 kernel_version bits = + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_2", match_err));; +let task_struct_parser_3 kernel_version bits = bitmatch bits with | { state : zero+32 : offset(0), littleendian; prio : zero+32 : offset(160), littleendian; @@ -169,22 +152,23 @@ let task_struct_parser_5 kernel_version bits = tasks'prev : zero+32 : offset(3232), littleendian; pid : zero+32 : offset(3552), littleendian; comm : 128 : offset(5896), string } -> - let s = - { task_struct_shape_fields_1_tasks'next = tasks'next; - task_struct_shape_fields_1_tasks'next_offset = 400; - task_struct_shape_fields_1_tasks'next_adjustment = 400 } in - let c = - { task_struct_content_fields_2_comm = comm; - task_struct_content_fields_2_normal_prio = normal_prio; - task_struct_content_fields_2_pid = pid; - task_struct_content_fields_2_prio = prio; - task_struct_content_fields_2_state = state; - task_struct_content_fields_2_static_prio = static_prio; - task_struct_content_fields_2_tasks'prev = tasks'prev } in - (s, c) + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = None; + task_struct_run_list'next_offset = -1; + task_struct_run_list'next_adjustment = -1; + task_struct_run_list'prev = None; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 400; + task_struct_tasks'next_adjustment = 400; + task_struct_tasks'prev = tasks'prev } | { _ } -> - raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_5", match_err));; -let task_struct_parser_6 kernel_version bits = + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_3", match_err));; +let task_struct_parser_4 kernel_version bits = bitmatch bits with | { state : zero+32 : offset(0), littleendian; prio : zero+32 : offset(160), littleendian; @@ -194,22 +178,23 @@ let task_struct_parser_6 kernel_version bits = tasks'prev : zero+32 : offset(3264), littleendian; pid : zero+32 : offset(3584), littleendian; comm : 128 : offset(5928), string } -> - let s = - { task_struct_shape_fields_1_tasks'next = tasks'next; - task_struct_shape_fields_1_tasks'next_offset = 404; - task_struct_shape_fields_1_tasks'next_adjustment = 404 } in - let c = - { task_struct_content_fields_2_comm = comm; - task_struct_content_fields_2_normal_prio = normal_prio; - task_struct_content_fields_2_pid = pid; - task_struct_content_fields_2_prio = prio; - task_struct_content_fields_2_state = state; - task_struct_content_fields_2_static_prio = static_prio; - task_struct_content_fields_2_tasks'prev = tasks'prev } in - (s, c) + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = None; + task_struct_run_list'next_offset = -1; + task_struct_run_list'next_adjustment = -1; + task_struct_run_list'prev = None; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 404; + task_struct_tasks'next_adjustment = 404; + task_struct_tasks'prev = tasks'prev } | { _ } -> - raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_6", match_err));; -let task_struct_parser_7 kernel_version bits = + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_4", match_err));; +let task_struct_parser_5 kernel_version bits = bitmatch bits with | { state : zero+32 : offset(0), bigendian; prio : zero+32 : offset(160), bigendian; @@ -219,21 +204,134 @@ let task_struct_parser_7 kernel_version bits = tasks'prev : zero+32 : offset(3360), bigendian; pid : zero+32 : offset(3680), bigendian; comm : 128 : offset(6056), string } -> - let s = - { task_struct_shape_fields_1_tasks'next = tasks'next; - task_struct_shape_fields_1_tasks'next_offset = 416; - task_struct_shape_fields_1_tasks'next_adjustment = 416 } in - let c = - { task_struct_content_fields_2_comm = comm; - task_struct_content_fields_2_normal_prio = normal_prio; - task_struct_content_fields_2_pid = pid; - task_struct_content_fields_2_prio = prio; - task_struct_content_fields_2_state = state; - task_struct_content_fields_2_static_prio = static_prio; - task_struct_content_fields_2_tasks'prev = tasks'prev } in - (s, c) + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = None; + task_struct_run_list'next_offset = -1; + task_struct_run_list'next_adjustment = -1; + task_struct_run_list'prev = None; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 416; + task_struct_tasks'next_adjustment = 416; + task_struct_tasks'prev = tasks'prev } + | { _ } -> + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_5", match_err));; +let task_struct_parser_6 kernel_version bits = + bitmatch bits with + | { state : zero+32 : offset(0), bigendian; + prio : zero+32 : offset(192), bigendian; + static_prio : zero+32 : offset(224), bigendian; + normal_prio : zero+32 : offset(256), bigendian; + run_list'next : zero+32 : offset(288), bigendian; + run_list'prev : zero+32 : offset(320), bigendian; + tasks'next : zero+32 : offset(1024), bigendian; + tasks'prev : zero+32 : offset(1056), bigendian; + pid : zero+32 : offset(1376), bigendian; + comm : 128 : offset(3264), string } -> + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = Some run_list'next; + task_struct_run_list'next_offset = 36; + task_struct_run_list'next_adjustment = 36; + task_struct_run_list'prev = Some run_list'prev; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 128; + task_struct_tasks'next_adjustment = 128; + task_struct_tasks'prev = tasks'prev } + | { _ } -> + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_6", match_err));; +let task_struct_parser_7 kernel_version bits = + bitmatch bits with + | { state : zero+64 : offset(0), littleendian; + prio : zero+32 : offset(320), littleendian; + static_prio : zero+32 : offset(352), littleendian; + normal_prio : zero+32 : offset(384), littleendian; + run_list'next : zero+64 : offset(448), littleendian; + run_list'prev : zero+64 : offset(512), littleendian; + tasks'next : zero+64 : offset(1536), littleendian; + tasks'prev : zero+64 : offset(1600), littleendian; + pid : zero+32 : offset(2144), littleendian; + comm : 128 : offset(5440), string } -> + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = Some run_list'next; + task_struct_run_list'next_offset = 56; + task_struct_run_list'next_adjustment = 56; + task_struct_run_list'prev = Some run_list'prev; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 192; + task_struct_tasks'next_adjustment = 192; + task_struct_tasks'prev = tasks'prev } | { _ } -> raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_7", match_err));; +let task_struct_parser_8 kernel_version bits = + bitmatch bits with + | { state : zero+32 : offset(0), littleendian; + prio : zero+32 : offset(192), littleendian; + static_prio : zero+32 : offset(224), littleendian; + normal_prio : zero+32 : offset(256), littleendian; + run_list'next : zero+32 : offset(288), littleendian; + run_list'prev : zero+32 : offset(320), littleendian; + tasks'next : zero+32 : offset(992), littleendian; + tasks'prev : zero+32 : offset(1024), littleendian; + pid : zero+32 : offset(1344), littleendian; + comm : 128 : offset(3232), string } -> + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = Some run_list'next; + task_struct_run_list'next_offset = 36; + task_struct_run_list'next_adjustment = 36; + task_struct_run_list'prev = Some run_list'prev; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 124; + task_struct_tasks'next_adjustment = 124; + task_struct_tasks'prev = tasks'prev } + | { _ } -> + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_8", match_err));; +let task_struct_parser_9 kernel_version bits = + bitmatch bits with + | { state : zero+64 : offset(0), bigendian; + prio : zero+32 : offset(320), bigendian; + static_prio : zero+32 : offset(352), bigendian; + normal_prio : zero+32 : offset(384), bigendian; + run_list'next : zero+64 : offset(448), bigendian; + run_list'prev : zero+64 : offset(512), bigendian; + tasks'next : zero+64 : offset(1600), bigendian; + tasks'prev : zero+64 : offset(1664), bigendian; + pid : zero+32 : offset(2208), bigendian; + comm : 128 : offset(5440), string } -> + { task_struct_comm = comm; + task_struct_normal_prio = normal_prio; + task_struct_pid = pid; + task_struct_prio = prio; + task_struct_run_list'next = Some run_list'next; + task_struct_run_list'next_offset = 56; + task_struct_run_list'next_adjustment = 56; + task_struct_run_list'prev = Some run_list'prev; + task_struct_state = state; + task_struct_static_prio = static_prio; + task_struct_tasks'next = tasks'next; + task_struct_tasks'next_offset = 200; + task_struct_tasks'next_adjustment = 200; + task_struct_tasks'prev = tasks'prev } + | { _ } -> + raise (Virt_mem_types.ParseError ("task_struct", "task_struct_parser_9", match_err));; let net_device_parser_10 kernel_version bits = bitmatch bits with | { name : 128 : offset(0), string; @@ -246,21 +344,19 @@ let net_device_parser_10 kernel_version bits = addr_len : zero+8 : offset(3392), littleendian; ip_ptr : zero+64 : offset(3840), littleendian; ip6_ptr : zero+64 : offset(3968), littleendian } -> - let s = - { net_device_shape_fields_8_dev_list'next = dev_list'next; - net_device_shape_fields_8_dev_list'next_offset = 72; - net_device_shape_fields_8_dev_list'next_adjustment = 72; - net_device_shape_fields_8_ip6_ptr = ip6_ptr; - net_device_shape_fields_8_ip_ptr = ip_ptr } in - let c = - { net_device_content_fields_9_addr_len = addr_len; - net_device_content_fields_9_dev_list'prev = dev_list'prev; - net_device_content_fields_9_flags = flags; - net_device_content_fields_9_mtu = mtu; - net_device_content_fields_9_name = name; - net_device_content_fields_9_operstate = operstate; - net_device_content_fields_9_perm_addr = perm_addr } in - (s, c) + { net_device_addr_len = addr_len; + net_device_dev_list'next = Some dev_list'next; + net_device_dev_list'next_offset = 72; + net_device_dev_list'next_adjustment = 72; + net_device_dev_list'prev = Some dev_list'prev; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = None; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } | { _ } -> raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_10", match_err));; let net_device_parser_11 kernel_version bits = @@ -275,21 +371,19 @@ let net_device_parser_11 kernel_version bits = addr_len : zero+8 : offset(3392), bigendian; ip_ptr : zero+64 : offset(3840), bigendian; ip6_ptr : zero+64 : offset(3968), bigendian } -> - let s = - { net_device_shape_fields_8_dev_list'next = dev_list'next; - net_device_shape_fields_8_dev_list'next_offset = 72; - net_device_shape_fields_8_dev_list'next_adjustment = 72; - net_device_shape_fields_8_ip6_ptr = ip6_ptr; - net_device_shape_fields_8_ip_ptr = ip_ptr } in - let c = - { net_device_content_fields_9_addr_len = addr_len; - net_device_content_fields_9_dev_list'prev = dev_list'prev; - net_device_content_fields_9_flags = flags; - net_device_content_fields_9_mtu = mtu; - net_device_content_fields_9_name = name; - net_device_content_fields_9_operstate = operstate; - net_device_content_fields_9_perm_addr = perm_addr } in - (s, c) + { net_device_addr_len = addr_len; + net_device_dev_list'next = Some dev_list'next; + net_device_dev_list'next_offset = 72; + net_device_dev_list'next_adjustment = 72; + net_device_dev_list'prev = Some dev_list'prev; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = None; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } | { _ } -> raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_11", match_err));; let net_device_parser_12 kernel_version bits = @@ -304,21 +398,19 @@ let net_device_parser_12 kernel_version bits = addr_len : zero+8 : offset(2016), littleendian; ip_ptr : zero+32 : offset(2304), littleendian; ip6_ptr : zero+32 : offset(2368), littleendian } -> - let s = - { net_device_shape_fields_8_dev_list'next = dev_list'next; - net_device_shape_fields_8_dev_list'next_offset = 48; - net_device_shape_fields_8_dev_list'next_adjustment = 48; - net_device_shape_fields_8_ip6_ptr = ip6_ptr; - net_device_shape_fields_8_ip_ptr = ip_ptr } in - let c = - { net_device_content_fields_9_addr_len = addr_len; - net_device_content_fields_9_dev_list'prev = dev_list'prev; - net_device_content_fields_9_flags = flags; - net_device_content_fields_9_mtu = mtu; - net_device_content_fields_9_name = name; - net_device_content_fields_9_operstate = operstate; - net_device_content_fields_9_perm_addr = perm_addr } in - (s, c) + { net_device_addr_len = addr_len; + net_device_dev_list'next = Some dev_list'next; + net_device_dev_list'next_offset = 48; + net_device_dev_list'next_adjustment = 48; + net_device_dev_list'prev = Some dev_list'prev; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = None; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } | { _ } -> raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_12", match_err));; let net_device_parser_13 kernel_version bits = @@ -333,705 +425,973 @@ let net_device_parser_13 kernel_version bits = addr_len : zero+8 : offset(2016), bigendian; ip_ptr : zero+32 : offset(2304), bigendian; ip6_ptr : zero+32 : offset(2368), bigendian } -> - let s = - { net_device_shape_fields_8_dev_list'next = dev_list'next; - net_device_shape_fields_8_dev_list'next_offset = 48; - net_device_shape_fields_8_dev_list'next_adjustment = 48; - net_device_shape_fields_8_ip6_ptr = ip6_ptr; - net_device_shape_fields_8_ip_ptr = ip_ptr } in - let c = - { net_device_content_fields_9_addr_len = addr_len; - net_device_content_fields_9_dev_list'prev = dev_list'prev; - net_device_content_fields_9_flags = flags; - net_device_content_fields_9_mtu = mtu; - net_device_content_fields_9_name = name; - net_device_content_fields_9_operstate = operstate; - net_device_content_fields_9_perm_addr = perm_addr } in - (s, c) + { net_device_addr_len = addr_len; + net_device_dev_list'next = Some dev_list'next; + net_device_dev_list'next_offset = 48; + net_device_dev_list'next_adjustment = 48; + net_device_dev_list'prev = Some dev_list'prev; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = None; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } | { _ } -> raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_13", match_err));; -let net_parser_18 kernel_version bits = +let net_device_parser_14 kernel_version bits = + bitmatch bits with + | { name : 128 : offset(0), string; + next : zero+32 : offset(384), bigendian; + flags : zero+32 : offset(704), bigendian; + operstate : zero+8 : offset(784), bigendian; + mtu : zero+32 : offset(800), bigendian; + perm_addr : 256 : offset(896), string; + addr_len : zero+8 : offset(1152), bigendian; + ip_ptr : zero+32 : offset(1344), bigendian; + ip6_ptr : zero+32 : offset(1408), bigendian } -> + { net_device_addr_len = addr_len; + net_device_dev_list'next = None; + net_device_dev_list'next_offset = -1; + net_device_dev_list'next_adjustment = -1; + net_device_dev_list'prev = None; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = Some next; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } + | { _ } -> + raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_14", match_err));; +let net_device_parser_15 kernel_version bits = + bitmatch bits with + | { name : 128 : offset(0), string; + next : zero+64 : offset(576), littleendian; + flags : zero+32 : offset(1152), littleendian; + operstate : zero+8 : offset(1232), littleendian; + mtu : zero+32 : offset(1248), littleendian; + perm_addr : 256 : offset(1408), string; + addr_len : zero+8 : offset(1664), littleendian; + ip_ptr : zero+64 : offset(1984), littleendian; + ip6_ptr : zero+64 : offset(2112), littleendian } -> + { net_device_addr_len = addr_len; + net_device_dev_list'next = None; + net_device_dev_list'next_offset = -1; + net_device_dev_list'next_adjustment = -1; + net_device_dev_list'prev = None; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = Some next; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } + | { _ } -> + raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_15", match_err));; +let net_device_parser_16 kernel_version bits = + bitmatch bits with + | { name : 128 : offset(0), string; + next : zero+32 : offset(384), littleendian; + flags : zero+32 : offset(704), littleendian; + operstate : zero+8 : offset(784), littleendian; + mtu : zero+32 : offset(800), littleendian; + perm_addr : 256 : offset(896), string; + addr_len : zero+8 : offset(1152), littleendian; + ip_ptr : zero+32 : offset(1344), littleendian; + ip6_ptr : zero+32 : offset(1408), littleendian } -> + { net_device_addr_len = addr_len; + net_device_dev_list'next = None; + net_device_dev_list'next_offset = -1; + net_device_dev_list'next_adjustment = -1; + net_device_dev_list'prev = None; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = Some next; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } + | { _ } -> + raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_16", match_err));; +let net_device_parser_17 kernel_version bits = + bitmatch bits with + | { name : 128 : offset(0), string; + next : zero+64 : offset(576), bigendian; + flags : zero+32 : offset(1152), bigendian; + operstate : zero+8 : offset(1232), bigendian; + mtu : zero+32 : offset(1248), bigendian; + perm_addr : 256 : offset(1408), string; + addr_len : zero+8 : offset(1664), bigendian; + ip_ptr : zero+64 : offset(1984), bigendian; + ip6_ptr : zero+64 : offset(2112), bigendian } -> + { net_device_addr_len = addr_len; + net_device_dev_list'next = None; + net_device_dev_list'next_offset = -1; + net_device_dev_list'next_adjustment = -1; + net_device_dev_list'prev = None; + net_device_flags = flags; + net_device_ip6_ptr = ip6_ptr; + net_device_ip_ptr = ip_ptr; + net_device_mtu = mtu; + net_device_name = name; + net_device_next = Some next; + net_device_operstate = operstate; + net_device_perm_addr = perm_addr } + | { _ } -> + raise (Virt_mem_types.ParseError ("net_device", "net_device_parser_17", match_err));; +let net_parser_20 kernel_version bits = bitmatch bits with | { dev_base_head'next : zero+32 : offset(416), littleendian; dev_base_head'prev : zero+32 : offset(448), littleendian } -> - let s = - { net_shape_fields_14_dev_base_head'next = dev_base_head'next; - net_shape_fields_14_dev_base_head'next_offset = 52; - net_shape_fields_14_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; - net_shape_fields_14_dev_base_head'prev = dev_base_head'prev; - net_shape_fields_14_dev_base_head'prev_offset = 56; - net_shape_fields_14_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } in - let c = - () in - (s, c) + { net_dev_base_head'next = dev_base_head'next; + net_dev_base_head'next_offset = 52; + net_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; + net_dev_base_head'prev = dev_base_head'prev; + net_dev_base_head'prev_offset = 56; + net_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } | { _ } -> - raise (Virt_mem_types.ParseError ("net", "net_parser_18", match_err));; -let net_parser_19 kernel_version bits = + raise (Virt_mem_types.ParseError ("net", "net_parser_20", match_err));; +let net_parser_21 kernel_version bits = bitmatch bits with | { dev_base_head'next : zero+32 : offset(416), bigendian; dev_base_head'prev : zero+32 : offset(448), bigendian } -> - let s = - { net_shape_fields_14_dev_base_head'next = dev_base_head'next; - net_shape_fields_14_dev_base_head'next_offset = 52; - net_shape_fields_14_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; - net_shape_fields_14_dev_base_head'prev = dev_base_head'prev; - net_shape_fields_14_dev_base_head'prev_offset = 56; - net_shape_fields_14_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } in - let c = - () in - (s, c) + { net_dev_base_head'next = dev_base_head'next; + net_dev_base_head'next_offset = 52; + net_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; + net_dev_base_head'prev = dev_base_head'prev; + net_dev_base_head'prev_offset = 56; + net_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } | { _ } -> - raise (Virt_mem_types.ParseError ("net", "net_parser_19", match_err));; -let net_parser_16 kernel_version bits = + raise (Virt_mem_types.ParseError ("net", "net_parser_21", match_err));; +let net_parser_18 kernel_version bits = bitmatch bits with | { dev_base_head'next : zero+64 : offset(768), littleendian; dev_base_head'prev : zero+64 : offset(832), littleendian } -> - let s = - { net_shape_fields_14_dev_base_head'next = dev_base_head'next; - net_shape_fields_14_dev_base_head'next_offset = 96; - net_shape_fields_14_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; - net_shape_fields_14_dev_base_head'prev = dev_base_head'prev; - net_shape_fields_14_dev_base_head'prev_offset = 104; - net_shape_fields_14_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } in - let c = - () in - (s, c) + { net_dev_base_head'next = dev_base_head'next; + net_dev_base_head'next_offset = 96; + net_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; + net_dev_base_head'prev = dev_base_head'prev; + net_dev_base_head'prev_offset = 104; + net_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } | { _ } -> - raise (Virt_mem_types.ParseError ("net", "net_parser_16", match_err));; -let net_parser_17 kernel_version bits = + raise (Virt_mem_types.ParseError ("net", "net_parser_18", match_err));; +let net_parser_19 kernel_version bits = bitmatch bits with | { dev_base_head'next : zero+64 : offset(768), bigendian; dev_base_head'prev : zero+64 : offset(832), bigendian } -> - let s = - { net_shape_fields_14_dev_base_head'next = dev_base_head'next; - net_shape_fields_14_dev_base_head'next_offset = 96; - net_shape_fields_14_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; - net_shape_fields_14_dev_base_head'prev = dev_base_head'prev; - net_shape_fields_14_dev_base_head'prev_offset = 104; - net_shape_fields_14_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } in - let c = - () in - (s, c) + { net_dev_base_head'next = dev_base_head'next; + net_dev_base_head'next_offset = 96; + net_dev_base_head'next_adjustment = offset_of_net_device_dev_list'next kernel_version; + net_dev_base_head'prev = dev_base_head'prev; + net_dev_base_head'prev_offset = 104; + net_dev_base_head'prev_adjustment = offset_of_net_device_dev_list'next kernel_version } | { _ } -> - raise (Virt_mem_types.ParseError ("net", "net_parser_17", match_err));; + raise (Virt_mem_types.ParseError ("net", "net_parser_19", match_err));; let in_device_parser_24 kernel_version bits = bitmatch bits with | { ifa_list : zero+32 : offset(96), littleendian } -> - let s = - { in_device_shape_fields_20_ifa_list = ifa_list } in - let c = - () in - (s, c) + { in_device_ifa_list = ifa_list } | { _ } -> raise (Virt_mem_types.ParseError ("in_device", "in_device_parser_24", match_err));; let in_device_parser_25 kernel_version bits = bitmatch bits with | { ifa_list : zero+32 : offset(96), bigendian } -> - let s = - { in_device_shape_fields_20_ifa_list = ifa_list } in - let c = - () in - (s, c) + { in_device_ifa_list = ifa_list } | { _ } -> raise (Virt_mem_types.ParseError ("in_device", "in_device_parser_25", match_err));; let in_device_parser_22 kernel_version bits = bitmatch bits with | { ifa_list : zero+64 : offset(128), littleendian } -> - let s = - { in_device_shape_fields_20_ifa_list = ifa_list } in - let c = - () in - (s, c) + { in_device_ifa_list = ifa_list } | { _ } -> raise (Virt_mem_types.ParseError ("in_device", "in_device_parser_22", match_err));; let in_device_parser_23 kernel_version bits = bitmatch bits with | { ifa_list : zero+64 : offset(128), bigendian } -> - let s = - { in_device_shape_fields_20_ifa_list = ifa_list } in - let c = - () in - (s, c) + { in_device_ifa_list = ifa_list } | { _ } -> raise (Virt_mem_types.ParseError ("in_device", "in_device_parser_23", match_err));; -let inet6_dev_parser_30 kernel_version bits = +let inet6_dev_parser_28 kernel_version bits = bitmatch bits with | { addr_list : zero+32 : offset(32), littleendian } -> - let s = - { inet6_dev_shape_fields_26_addr_list = addr_list } in - let c = - () in - (s, c) + { inet6_dev_addr_list = addr_list } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_30", match_err));; -let inet6_dev_parser_31 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_28", match_err));; +let inet6_dev_parser_29 kernel_version bits = bitmatch bits with | { addr_list : zero+32 : offset(32), bigendian } -> - let s = - { inet6_dev_shape_fields_26_addr_list = addr_list } in - let c = - () in - (s, c) + { inet6_dev_addr_list = addr_list } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_31", match_err));; -let inet6_dev_parser_28 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_29", match_err));; +let inet6_dev_parser_26 kernel_version bits = bitmatch bits with | { addr_list : zero+64 : offset(64), littleendian } -> - let s = - { inet6_dev_shape_fields_26_addr_list = addr_list } in - let c = - () in - (s, c) + { inet6_dev_addr_list = addr_list } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_28", match_err));; -let inet6_dev_parser_29 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_26", match_err));; +let inet6_dev_parser_27 kernel_version bits = bitmatch bits with | { addr_list : zero+64 : offset(64), bigendian } -> - let s = - { inet6_dev_shape_fields_26_addr_list = addr_list } in - let c = - () in - (s, c) + { inet6_dev_addr_list = addr_list } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_29", match_err));; -let in_ifaddr_parser_36 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_dev", "inet6_dev_parser_27", match_err));; +let in_ifaddr_parser_32 kernel_version bits = bitmatch bits with | { ifa_next : zero+32 : offset(0), littleendian; ifa_local : zero+32 : offset(128), littleendian; ifa_address : zero+32 : offset(160), littleendian; ifa_mask : zero+32 : offset(192), littleendian; ifa_broadcast : zero+32 : offset(224), littleendian } -> - let s = - { in_ifaddr_shape_fields_32_ifa_next = ifa_next } in - let c = - { in_ifaddr_content_fields_33_ifa_address = ifa_address; - in_ifaddr_content_fields_33_ifa_broadcast = ifa_broadcast; - in_ifaddr_content_fields_33_ifa_local = ifa_local; - in_ifaddr_content_fields_33_ifa_mask = ifa_mask } in - (s, c) + { in_ifaddr_ifa_address = ifa_address; + in_ifaddr_ifa_broadcast = ifa_broadcast; + in_ifaddr_ifa_local = ifa_local; + in_ifaddr_ifa_mask = ifa_mask; + in_ifaddr_ifa_next = ifa_next } | { _ } -> - raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_36", match_err));; -let in_ifaddr_parser_37 kernel_version bits = + raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_32", match_err));; +let in_ifaddr_parser_33 kernel_version bits = bitmatch bits with | { ifa_next : zero+32 : offset(0), bigendian; ifa_local : zero+32 : offset(128), bigendian; ifa_address : zero+32 : offset(160), bigendian; ifa_mask : zero+32 : offset(192), bigendian; ifa_broadcast : zero+32 : offset(224), bigendian } -> - let s = - { in_ifaddr_shape_fields_32_ifa_next = ifa_next } in - let c = - { in_ifaddr_content_fields_33_ifa_address = ifa_address; - in_ifaddr_content_fields_33_ifa_broadcast = ifa_broadcast; - in_ifaddr_content_fields_33_ifa_local = ifa_local; - in_ifaddr_content_fields_33_ifa_mask = ifa_mask } in - (s, c) + { in_ifaddr_ifa_address = ifa_address; + in_ifaddr_ifa_broadcast = ifa_broadcast; + in_ifaddr_ifa_local = ifa_local; + in_ifaddr_ifa_mask = ifa_mask; + in_ifaddr_ifa_next = ifa_next } | { _ } -> - raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_37", match_err));; -let in_ifaddr_parser_34 kernel_version bits = + raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_33", match_err));; +let in_ifaddr_parser_30 kernel_version bits = bitmatch bits with | { ifa_next : zero+64 : offset(0), littleendian; ifa_local : zero+32 : offset(256), littleendian; ifa_address : zero+32 : offset(288), littleendian; ifa_mask : zero+32 : offset(320), littleendian; ifa_broadcast : zero+32 : offset(352), littleendian } -> - let s = - { in_ifaddr_shape_fields_32_ifa_next = ifa_next } in - let c = - { in_ifaddr_content_fields_33_ifa_address = ifa_address; - in_ifaddr_content_fields_33_ifa_broadcast = ifa_broadcast; - in_ifaddr_content_fields_33_ifa_local = ifa_local; - in_ifaddr_content_fields_33_ifa_mask = ifa_mask } in - (s, c) + { in_ifaddr_ifa_address = ifa_address; + in_ifaddr_ifa_broadcast = ifa_broadcast; + in_ifaddr_ifa_local = ifa_local; + in_ifaddr_ifa_mask = ifa_mask; + in_ifaddr_ifa_next = ifa_next } | { _ } -> - raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_34", match_err));; -let in_ifaddr_parser_35 kernel_version bits = + raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_30", match_err));; +let in_ifaddr_parser_31 kernel_version bits = bitmatch bits with | { ifa_next : zero+64 : offset(0), bigendian; ifa_local : zero+32 : offset(256), bigendian; ifa_address : zero+32 : offset(288), bigendian; ifa_mask : zero+32 : offset(320), bigendian; ifa_broadcast : zero+32 : offset(352), bigendian } -> - let s = - { in_ifaddr_shape_fields_32_ifa_next = ifa_next } in - let c = - { in_ifaddr_content_fields_33_ifa_address = ifa_address; - in_ifaddr_content_fields_33_ifa_broadcast = ifa_broadcast; - in_ifaddr_content_fields_33_ifa_local = ifa_local; - in_ifaddr_content_fields_33_ifa_mask = ifa_mask } in - (s, c) + { in_ifaddr_ifa_address = ifa_address; + in_ifaddr_ifa_broadcast = ifa_broadcast; + in_ifaddr_ifa_local = ifa_local; + in_ifaddr_ifa_mask = ifa_mask; + in_ifaddr_ifa_next = ifa_next } | { _ } -> - raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_35", match_err));; -let inet6_ifaddr_parser_42 kernel_version bits = + raise (Virt_mem_types.ParseError ("in_ifaddr", "in_ifaddr_parser_31", match_err));; +let inet6_ifaddr_parser_36 kernel_version bits = bitmatch bits with | { prefix_len : zero+32 : offset(128), littleendian; lst_next : zero+32 : offset(832), littleendian } -> - let s = - { inet6_ifaddr_shape_fields_38_lst_next = lst_next } in - let c = - { inet6_ifaddr_content_fields_39_prefix_len = prefix_len } in - (s, c) + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_42", match_err));; -let inet6_ifaddr_parser_40 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_36", match_err));; +let inet6_ifaddr_parser_34 kernel_version bits = bitmatch bits with | { prefix_len : zero+32 : offset(128), littleendian; lst_next : zero+64 : offset(1280), littleendian } -> - let s = - { inet6_ifaddr_shape_fields_38_lst_next = lst_next } in - let c = - { inet6_ifaddr_content_fields_39_prefix_len = prefix_len } in - (s, c) + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_40", match_err));; -let inet6_ifaddr_parser_41 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_34", match_err));; +let inet6_ifaddr_parser_35 kernel_version bits = bitmatch bits with | { prefix_len : zero+32 : offset(128), bigendian; lst_next : zero+64 : offset(1280), bigendian } -> - let s = - { inet6_ifaddr_shape_fields_38_lst_next = lst_next } in - let c = - { inet6_ifaddr_content_fields_39_prefix_len = prefix_len } in - (s, c) + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_41", match_err));; -let inet6_ifaddr_parser_43 kernel_version bits = + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_35", match_err));; +let inet6_ifaddr_parser_37 kernel_version bits = bitmatch bits with | { prefix_len : zero+32 : offset(128), bigendian; lst_next : zero+32 : offset(800), bigendian } -> - let s = - { inet6_ifaddr_shape_fields_38_lst_next = lst_next } in - let c = - { inet6_ifaddr_content_fields_39_prefix_len = prefix_len } in - (s, c) + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } + | { _ } -> + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_37", match_err));; +let inet6_ifaddr_parser_39 kernel_version bits = + bitmatch bits with + | { prefix_len : zero+32 : offset(128), littleendian; + lst_next : zero+64 : offset(1216), littleendian } -> + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } + | { _ } -> + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_39", match_err));; +let inet6_ifaddr_parser_41 kernel_version bits = + bitmatch bits with + | { prefix_len : zero+32 : offset(128), bigendian; + lst_next : zero+64 : offset(1216), bigendian } -> + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } + | { _ } -> + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_41", match_err));; +let inet6_ifaddr_parser_38 kernel_version bits = + bitmatch bits with + | { prefix_len : zero+32 : offset(128), bigendian; + lst_next : zero+32 : offset(736), bigendian } -> + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } + | { _ } -> + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_38", match_err));; +let inet6_ifaddr_parser_40 kernel_version bits = + bitmatch bits with + | { prefix_len : zero+32 : offset(128), littleendian; + lst_next : zero+32 : offset(736), littleendian } -> + { inet6_ifaddr_lst_next = lst_next; + inet6_ifaddr_prefix_len = prefix_len } | { _ } -> - raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_43", match_err));; -let task_struct_shape_fields_1_follower load followers map addr shape = - let (_, _, _, _, _, _, f) = followers in - let offset = shape.task_struct_shape_fields_1_tasks'next_offset - and adj = shape.task_struct_shape_fields_1_tasks'next_adjustment in - let offset = Int64.of_int offset and adj = Int64.of_int adj in - let addr = Int64.sub (Int64.add addr offset) adj in - let map = AddrMap.add addr ("task_struct", 0) map in - let out_addr = Int64.sub shape.task_struct_shape_fields_1_tasks'next adj in - let map = f load followers map out_addr in map;; -let net_device_shape_fields_8_follower load followers map addr shape = - let (_, _, _, _, _, f, _) = followers in - let offset = shape.net_device_shape_fields_8_dev_list'next_offset - and adj = shape.net_device_shape_fields_8_dev_list'next_adjustment in - let offset = Int64.of_int offset and adj = Int64.of_int adj in - let addr = Int64.sub (Int64.add addr offset) adj in - let map = AddrMap.add addr ("net_device", 0) map in - let out_addr = - Int64.sub shape.net_device_shape_fields_8_dev_list'next adj in - let map = f load followers map out_addr in - let (_, _, f, _, _, _, _) = followers in - let map = f load followers map shape.net_device_shape_fields_8_ip6_ptr in - let (_, _, _, f, _, _, _) = followers in - let map = f load followers map shape.net_device_shape_fields_8_ip_ptr - in map;; -let net_shape_fields_14_follower load followers map addr shape = - let (_, _, _, _, _, f, _) = followers in - let offset = shape.net_shape_fields_14_dev_base_head'next_offset - and adj = shape.net_shape_fields_14_dev_base_head'next_adjustment in - let offset = Int64.of_int offset and adj = Int64.of_int adj in - let addr = Int64.sub (Int64.add addr offset) adj in - let map = AddrMap.add addr ("net_device", 0) map in - let out_addr = - Int64.sub shape.net_shape_fields_14_dev_base_head'next adj in - let map = f load followers map out_addr in - let (_, _, _, _, _, f, _) = followers in - let offset = shape.net_shape_fields_14_dev_base_head'prev_offset - and adj = shape.net_shape_fields_14_dev_base_head'prev_adjustment in - let offset = Int64.of_int offset and adj = Int64.of_int adj in - let addr = Int64.sub (Int64.add addr offset) adj in - let map = AddrMap.add addr ("net_device", 0) map in - let out_addr = - Int64.sub shape.net_shape_fields_14_dev_base_head'prev adj in - let map = f load followers map out_addr in map;; -let in_device_shape_fields_20_follower load followers map addr shape = - let (_, f, _, _, _, _, _) = followers in - let map = f load followers map shape.in_device_shape_fields_20_ifa_list - in map;; -let inet6_dev_shape_fields_26_follower load followers map addr shape = - let (f, _, _, _, _, _, _) = followers in - let map = f load followers map shape.inet6_dev_shape_fields_26_addr_list - in map;; -let in_ifaddr_shape_fields_32_follower load followers map addr shape = - let (_, f, _, _, _, _, _) = followers in - let map = f load followers map shape.in_ifaddr_shape_fields_32_ifa_next - in map;; -let inet6_ifaddr_shape_fields_38_follower load followers map addr shape = - let (f, _, _, _, _, _, _) = followers in - let map = f load followers map shape.inet6_ifaddr_shape_fields_38_lst_next - in map;; -let kv_follower kernel_version struct_name total_size parserfn followerfn - load followers map addr = + raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_40", match_err));; +let size_of_task_struct = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 2496 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 2524 + (StringMap.add "2.6.25.14-108.fc9.i586" 1832 + (StringMap.add "2.6.25.14-108.fc9.i686" 1832 + (StringMap.add "2.6.25.14-69.fc8.ppc" 1952 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 2496 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 2496 + (StringMap.add "2.6.25.14-69.fc8.i586" 1832 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 1592 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 1920 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 2524 + (StringMap.add "2.6.25.11-97.fc9.i686" + 1832 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 1400 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 1400 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 1952 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 2112 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 1832 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "task_struct";; +let size_of_net_device = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 1752 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 1776 + (StringMap.add "2.6.25.14-108.fc9.i586" 1212 + (StringMap.add "2.6.25.14-108.fc9.i686" 1212 + (StringMap.add "2.6.25.14-69.fc8.ppc" 904 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 1752 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 1752 + (StringMap.add "2.6.25.14-69.fc8.i586" 1212 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 668 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 1260 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 1776 + (StringMap.add "2.6.25.11-97.fc9.i686" + 1212 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 912 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 912 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 904 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 1260 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 1212 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "net_device";; +let size_of_net = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 488 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 488 + (StringMap.add "2.6.25.14-108.fc9.i586" 284 + (StringMap.add "2.6.25.14-108.fc9.i686" 284 + (StringMap.add "2.6.25.14-69.fc8.ppc" 276 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 488 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 488 + (StringMap.add "2.6.25.14-69.fc8.i586" 284 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 488 + (StringMap.add "2.6.25.11-97.fc9.i686" 284 + (StringMap.add "2.6.25.14-108.fc9.ppc" 276 + (StringMap.add "2.6.25.14-69.fc8.i686" + 284 StringMap.empty))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "net";; +let size_of_in_device = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 368 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 368 + (StringMap.add "2.6.25.14-108.fc9.i586" 244 + (StringMap.add "2.6.25.14-108.fc9.i686" 244 + (StringMap.add "2.6.25.14-69.fc8.ppc" 236 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 368 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 368 + (StringMap.add "2.6.25.14-69.fc8.i586" 244 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 212 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 328 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 368 + (StringMap.add "2.6.25.11-97.fc9.i686" + 244 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 216 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 216 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 236 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 328 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 244 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "in_device";; +let size_of_inet6_dev = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 536 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 536 + (StringMap.add "2.6.25.14-108.fc9.i586" 356 + (StringMap.add "2.6.25.14-108.fc9.i686" 356 + (StringMap.add "2.6.25.14-69.fc8.ppc" 348 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 536 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 536 + (StringMap.add "2.6.25.14-69.fc8.i586" 356 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 284 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 464 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 536 + (StringMap.add "2.6.25.11-97.fc9.i686" + 356 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 292 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 292 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 348 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 464 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 356 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "inet6_dev";; +let size_of_in_ifaddr = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 71 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 71 + (StringMap.add "2.6.25.14-108.fc9.i586" 55 + (StringMap.add "2.6.25.14-108.fc9.i686" 55 + (StringMap.add "2.6.25.14-69.fc8.ppc" 55 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 71 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 71 + (StringMap.add "2.6.25.14-69.fc8.i586" 55 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 55 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 71 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 71 + (StringMap.add "2.6.25.11-97.fc9.i686" 55 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 55 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 55 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 55 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 71 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 55 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "in_ifaddr";; +let size_of_inet6_ifaddr = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" 200 + (StringMap.add "2.6.25.14-108.fc9.ppc64" 200 + (StringMap.add "2.6.25.14-108.fc9.i586" 128 + (StringMap.add "2.6.25.14-108.fc9.i686" 128 + (StringMap.add "2.6.25.14-69.fc8.ppc" 124 + (StringMap.add "2.6.25.14-108.fc9.x86_64" 200 + (StringMap.add "2.6.25.11-97.fc9.x86_64" 200 + (StringMap.add "2.6.25.14-69.fc8.i586" 128 + (StringMap.add "2.6.20-1.2933.fc6.ppc" 116 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" 192 + (StringMap.add "2.6.25.14-69.fc8.ppc64" 200 + (StringMap.add "2.6.25.11-97.fc9.i686" + 128 + (StringMap.add + "2.6.20-1.2933.fc6.i686" 116 + (StringMap.add + "2.6.20-1.2933.fc6.i586" 116 + (StringMap.add + "2.6.25.14-108.fc9.ppc" 124 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + 192 + (StringMap.add + "2.6.25.14-69.fc8.i686" + 128 StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with + | Not_found -> unknown_kernel_version kernel_version "inet6_ifaddr";; +let parser_of_task_struct = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" task_struct_parser_1 + (StringMap.add "2.6.25.14-108.fc9.ppc64" task_struct_parser_2 + (StringMap.add "2.6.25.14-108.fc9.i586" task_struct_parser_3 + (StringMap.add "2.6.25.14-108.fc9.i686" task_struct_parser_4 + (StringMap.add "2.6.25.14-69.fc8.ppc" task_struct_parser_5 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + task_struct_parser_1 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + task_struct_parser_1 + (StringMap.add "2.6.25.14-69.fc8.i586" + task_struct_parser_3 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + task_struct_parser_6 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + task_struct_parser_7 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + task_struct_parser_2 + (StringMap.add "2.6.25.11-97.fc9.i686" + task_struct_parser_4 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + task_struct_parser_8 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + task_struct_parser_8 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + task_struct_parser_5 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + task_struct_parser_9 + (StringMap.add + "2.6.25.14-69.fc8.i686" + task_struct_parser_4 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "task_struct";; +let parser_of_net_device = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" net_device_parser_10 + (StringMap.add "2.6.25.14-108.fc9.ppc64" net_device_parser_11 + (StringMap.add "2.6.25.14-108.fc9.i586" net_device_parser_12 + (StringMap.add "2.6.25.14-108.fc9.i686" net_device_parser_12 + (StringMap.add "2.6.25.14-69.fc8.ppc" net_device_parser_13 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + net_device_parser_10 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + net_device_parser_10 + (StringMap.add "2.6.25.14-69.fc8.i586" + net_device_parser_12 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + net_device_parser_14 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + net_device_parser_15 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + net_device_parser_11 + (StringMap.add "2.6.25.11-97.fc9.i686" + net_device_parser_12 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + net_device_parser_16 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + net_device_parser_16 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + net_device_parser_13 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + net_device_parser_17 + (StringMap.add + "2.6.25.14-69.fc8.i686" + net_device_parser_12 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "net_device";; +let parser_of_net = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" net_parser_18 + (StringMap.add "2.6.25.14-108.fc9.ppc64" net_parser_19 + (StringMap.add "2.6.25.14-108.fc9.i586" net_parser_20 + (StringMap.add "2.6.25.14-108.fc9.i686" net_parser_20 + (StringMap.add "2.6.25.14-69.fc8.ppc" net_parser_21 + (StringMap.add "2.6.25.14-108.fc9.x86_64" net_parser_18 + (StringMap.add "2.6.25.11-97.fc9.x86_64" net_parser_18 + (StringMap.add "2.6.25.14-69.fc8.i586" net_parser_20 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + net_parser_19 + (StringMap.add "2.6.25.11-97.fc9.i686" + net_parser_20 + (StringMap.add "2.6.25.14-108.fc9.ppc" + net_parser_21 + (StringMap.add "2.6.25.14-69.fc8.i686" + net_parser_20 StringMap.empty))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "net";; +let parser_of_in_device = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" in_device_parser_22 + (StringMap.add "2.6.25.14-108.fc9.ppc64" in_device_parser_23 + (StringMap.add "2.6.25.14-108.fc9.i586" in_device_parser_24 + (StringMap.add "2.6.25.14-108.fc9.i686" in_device_parser_24 + (StringMap.add "2.6.25.14-69.fc8.ppc" in_device_parser_25 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + in_device_parser_22 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + in_device_parser_22 + (StringMap.add "2.6.25.14-69.fc8.i586" + in_device_parser_24 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + in_device_parser_25 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + in_device_parser_22 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + in_device_parser_23 + (StringMap.add "2.6.25.11-97.fc9.i686" + in_device_parser_24 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + in_device_parser_24 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + in_device_parser_24 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + in_device_parser_25 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + in_device_parser_23 + (StringMap.add + "2.6.25.14-69.fc8.i686" + in_device_parser_24 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "in_device";; +let parser_of_inet6_dev = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" inet6_dev_parser_26 + (StringMap.add "2.6.25.14-108.fc9.ppc64" inet6_dev_parser_27 + (StringMap.add "2.6.25.14-108.fc9.i586" inet6_dev_parser_28 + (StringMap.add "2.6.25.14-108.fc9.i686" inet6_dev_parser_28 + (StringMap.add "2.6.25.14-69.fc8.ppc" inet6_dev_parser_29 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + inet6_dev_parser_26 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + inet6_dev_parser_26 + (StringMap.add "2.6.25.14-69.fc8.i586" + inet6_dev_parser_28 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + inet6_dev_parser_29 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + inet6_dev_parser_26 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + inet6_dev_parser_27 + (StringMap.add "2.6.25.11-97.fc9.i686" + inet6_dev_parser_28 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + inet6_dev_parser_28 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + inet6_dev_parser_28 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + inet6_dev_parser_29 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + inet6_dev_parser_27 + (StringMap.add + "2.6.25.14-69.fc8.i686" + inet6_dev_parser_28 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "inet6_dev";; +let parser_of_in_ifaddr = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" in_ifaddr_parser_30 + (StringMap.add "2.6.25.14-108.fc9.ppc64" in_ifaddr_parser_31 + (StringMap.add "2.6.25.14-108.fc9.i586" in_ifaddr_parser_32 + (StringMap.add "2.6.25.14-108.fc9.i686" in_ifaddr_parser_32 + (StringMap.add "2.6.25.14-69.fc8.ppc" in_ifaddr_parser_33 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + in_ifaddr_parser_30 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + in_ifaddr_parser_30 + (StringMap.add "2.6.25.14-69.fc8.i586" + in_ifaddr_parser_32 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + in_ifaddr_parser_33 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + in_ifaddr_parser_30 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + in_ifaddr_parser_31 + (StringMap.add "2.6.25.11-97.fc9.i686" + in_ifaddr_parser_32 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + in_ifaddr_parser_32 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + in_ifaddr_parser_32 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + in_ifaddr_parser_33 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + in_ifaddr_parser_31 + (StringMap.add + "2.6.25.14-69.fc8.i686" + in_ifaddr_parser_32 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with | Not_found -> unknown_kernel_version kernel_version "in_ifaddr";; +let parser_of_inet6_ifaddr = + let map = + StringMap.add "2.6.25.14-69.fc8.x86_64" inet6_ifaddr_parser_34 + (StringMap.add "2.6.25.14-108.fc9.ppc64" inet6_ifaddr_parser_35 + (StringMap.add "2.6.25.14-108.fc9.i586" inet6_ifaddr_parser_36 + (StringMap.add "2.6.25.14-108.fc9.i686" inet6_ifaddr_parser_36 + (StringMap.add "2.6.25.14-69.fc8.ppc" inet6_ifaddr_parser_37 + (StringMap.add "2.6.25.14-108.fc9.x86_64" + inet6_ifaddr_parser_34 + (StringMap.add "2.6.25.11-97.fc9.x86_64" + inet6_ifaddr_parser_34 + (StringMap.add "2.6.25.14-69.fc8.i586" + inet6_ifaddr_parser_36 + (StringMap.add "2.6.20-1.2933.fc6.ppc" + inet6_ifaddr_parser_38 + (StringMap.add "2.6.20-1.2933.fc6.x86_64" + inet6_ifaddr_parser_39 + (StringMap.add "2.6.25.14-69.fc8.ppc64" + inet6_ifaddr_parser_35 + (StringMap.add "2.6.25.11-97.fc9.i686" + inet6_ifaddr_parser_36 + (StringMap.add + "2.6.20-1.2933.fc6.i686" + inet6_ifaddr_parser_40 + (StringMap.add + "2.6.20-1.2933.fc6.i586" + inet6_ifaddr_parser_40 + (StringMap.add + "2.6.25.14-108.fc9.ppc" + inet6_ifaddr_parser_37 + (StringMap.add + "2.6.20-1.2933.fc6.ppc64" + inet6_ifaddr_parser_41 + (StringMap.add + "2.6.25.14-69.fc8.i686" + inet6_ifaddr_parser_36 + StringMap.empty)))))))))))))))) + in + fun kernel_version -> + try StringMap.find kernel_version map + with + | Not_found -> unknown_kernel_version kernel_version "inet6_ifaddr";; +let rec task_struct_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_task_struct kernel_version in + let total_size = size_of_task_struct kernel_version in + let bits = load "task_struct" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("task_struct", (Some (total_size, bits, Task_struct data))) map in + let map = + match data.task_struct_run_list'next with + | None -> map + | Some dest_addr -> + let offset = data.task_struct_run_list'next_offset + and adj = data.task_struct_run_list'next_adjustment in + let offset = Int64.of_int offset and adj = Int64.of_int adj in + let addr = Int64.sub (Int64.add addr offset) adj in + let map = AddrMap.add addr ("task_struct", None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = task_struct_follower kernel_version load map dest_addr + in map in + let dest_addr = data.task_struct_tasks'next in + let map = + let offset = data.task_struct_tasks'next_offset + and adj = data.task_struct_tasks'next_adjustment in + let offset = Int64.of_int offset and adj = Int64.of_int adj in + let addr = Int64.sub (Int64.add addr offset) adj in + let map = AddrMap.add addr ("task_struct", None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = task_struct_follower kernel_version load map dest_addr + in map + in map) + else map +and net_device_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_net_device kernel_version in + let total_size = size_of_net_device kernel_version in + let bits = load "net_device" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("net_device", (Some (total_size, bits, Net_device data))) map in + let map = + match data.net_device_dev_list'next with + | None -> map + | Some dest_addr -> + let offset = data.net_device_dev_list'next_offset + and adj = data.net_device_dev_list'next_adjustment in + let offset = Int64.of_int offset and adj = Int64.of_int adj in + let addr = Int64.sub (Int64.add addr offset) adj in + let map = AddrMap.add addr ("net_device", None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = net_device_follower kernel_version load map dest_addr + in map in + let dest_addr = data.net_device_ip6_ptr in + let map = + let map = inet6_dev_follower kernel_version load map dest_addr in map in + let dest_addr = data.net_device_ip_ptr in + let map = + let map = in_device_follower kernel_version load map dest_addr in map in + let map = + match data.net_device_next with + | None -> map + | Some dest_addr -> + let map = net_device_follower kernel_version load map dest_addr + in map + in map) + else map +and net_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_net kernel_version in + let total_size = size_of_net kernel_version in + let bits = load "net" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr ("net", (Some (total_size, bits, Net data))) map in + let dest_addr = data.net_dev_base_head'next in + let map = + let offset = data.net_dev_base_head'next_offset + and adj = data.net_dev_base_head'next_adjustment in + let offset = Int64.of_int offset and adj = Int64.of_int adj in + let addr = Int64.sub (Int64.add addr offset) adj in + let map = AddrMap.add addr ("net_device", None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = net_device_follower kernel_version load map dest_addr in map in + let dest_addr = data.net_dev_base_head'prev in + let map = + let offset = data.net_dev_base_head'prev_offset + and adj = data.net_dev_base_head'prev_adjustment in + let offset = Int64.of_int offset and adj = Int64.of_int adj in + let addr = Int64.sub (Int64.add addr offset) adj in + let map = AddrMap.add addr ("net_device", None) map in + let dest_addr = Int64.sub dest_addr adj in + let map = net_device_follower kernel_version load map dest_addr in map + in map) + else map +and in_device_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_in_device kernel_version in + let total_size = size_of_in_device kernel_version in + let bits = load "in_device" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("in_device", (Some (total_size, bits, In_device data))) map in + let dest_addr = data.in_device_ifa_list in + let map = + let map = in_ifaddr_follower kernel_version load map dest_addr in map + in map) + else map +and inet6_dev_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_inet6_dev kernel_version in + let total_size = size_of_inet6_dev kernel_version in + let bits = load "inet6_dev" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("inet6_dev", (Some (total_size, bits, Inet6_dev data))) map in + let dest_addr = data.inet6_dev_addr_list in + let map = + let map = inet6_ifaddr_follower kernel_version load map dest_addr + in map + in map) + else map +and in_ifaddr_follower kernel_version load map addr = + if (addr <> 0L) && (not (AddrMap.mem addr map)) + then + (let parser_ = parser_of_in_ifaddr kernel_version in + let total_size = size_of_in_ifaddr kernel_version in + let bits = load "in_ifaddr" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("in_ifaddr", (Some (total_size, bits, In_ifaddr data))) map in + let dest_addr = data.in_ifaddr_ifa_next in + let map = + let map = in_ifaddr_follower kernel_version load map dest_addr in map + in map) + else map +and inet6_ifaddr_follower kernel_version load map addr = if (addr <> 0L) && (not (AddrMap.mem addr map)) then - (let map = AddrMap.add addr (struct_name, total_size) map in - let bits = load struct_name addr total_size in - let (shape, _) = parserfn kernel_version bits - in followerfn load followers map addr shape) + (let parser_ = parser_of_inet6_ifaddr kernel_version in + let total_size = size_of_inet6_ifaddr kernel_version in + let bits = load "inet6_ifaddr" addr total_size in + let data = parser_ kernel_version bits in + let map = + AddrMap.add addr + ("inet6_ifaddr", (Some (total_size, bits, Inet6_ifaddr data))) map in + let dest_addr = data.inet6_ifaddr_lst_next in + let map = + let map = inet6_ifaddr_follower kernel_version load map dest_addr + in map + in map) else map;; -let task_struct_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "task_struct" 2496 - task_struct_parser_3 task_struct_shape_fields_1_follower;; -let task_struct_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "task_struct" 2524 - task_struct_parser_4 task_struct_shape_fields_1_follower;; -let task_struct_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "task_struct" 1832 - task_struct_parser_5 task_struct_shape_fields_1_follower;; -let task_struct_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "task_struct" 1832 - task_struct_parser_6 task_struct_shape_fields_1_follower;; -let task_struct_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "task_struct" 1952 task_struct_parser_7 - task_struct_shape_fields_1_follower;; -let task_struct_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "task_struct" 2496 - task_struct_parser_3 task_struct_shape_fields_1_follower;; -let task_struct_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "task_struct" 2496 - task_struct_parser_3 task_struct_shape_fields_1_follower;; -let task_struct_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "task_struct" 1832 task_struct_parser_5 - task_struct_shape_fields_1_follower;; -let task_struct_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "task_struct" 2524 - task_struct_parser_4 task_struct_shape_fields_1_follower;; -let task_struct_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "task_struct" 1832 task_struct_parser_6 - task_struct_shape_fields_1_follower;; -let task_struct_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "task_struct" 1952 task_struct_parser_7 - task_struct_shape_fields_1_follower;; -let task_struct_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "task_struct" 1832 task_struct_parser_6 - task_struct_shape_fields_1_follower;; -let net_device_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "net_device" 1752 - net_device_parser_10 net_device_shape_fields_8_follower;; -let net_device_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "net_device" 1776 - net_device_parser_11 net_device_shape_fields_8_follower;; -let net_device_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "net_device" 1212 net_device_parser_12 - net_device_shape_fields_8_follower;; -let net_device_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "net_device" 1212 net_device_parser_12 - net_device_shape_fields_8_follower;; -let net_device_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "net_device" 904 net_device_parser_13 - net_device_shape_fields_8_follower;; -let net_device_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "net_device" 1752 - net_device_parser_10 net_device_shape_fields_8_follower;; -let net_device_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "net_device" 1752 - net_device_parser_10 net_device_shape_fields_8_follower;; -let net_device_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "net_device" 1212 net_device_parser_12 - net_device_shape_fields_8_follower;; -let net_device_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "net_device" 1776 net_device_parser_11 - net_device_shape_fields_8_follower;; -let net_device_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "net_device" 1212 net_device_parser_12 - net_device_shape_fields_8_follower;; -let net_device_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "net_device" 904 net_device_parser_13 - net_device_shape_fields_8_follower;; -let net_device_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "net_device" 1212 net_device_parser_12 - net_device_shape_fields_8_follower;; -let net_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "net" 488 net_parser_16 - net_shape_fields_14_follower;; -let net_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "net" 488 net_parser_17 - net_shape_fields_14_follower;; -let net_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "net" 284 net_parser_18 - net_shape_fields_14_follower;; -let net_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "net" 284 net_parser_18 - net_shape_fields_14_follower;; -let net_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "net" 276 net_parser_19 - net_shape_fields_14_follower;; -let net_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "net" 488 net_parser_16 - net_shape_fields_14_follower;; -let net_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "net" 488 net_parser_16 - net_shape_fields_14_follower;; -let net_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "net" 284 net_parser_18 - net_shape_fields_14_follower;; -let net_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "net" 488 net_parser_17 - net_shape_fields_14_follower;; -let net_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "net" 284 net_parser_18 - net_shape_fields_14_follower;; -let net_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "net" 276 net_parser_19 - net_shape_fields_14_follower;; -let net_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "net" 284 net_parser_18 - net_shape_fields_14_follower;; -let in_device_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "in_device" 368 in_device_parser_22 - in_device_shape_fields_20_follower;; -let in_device_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "in_device" 368 in_device_parser_23 - in_device_shape_fields_20_follower;; -let in_device_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "in_device" 244 in_device_parser_24 - in_device_shape_fields_20_follower;; -let in_device_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "in_device" 244 in_device_parser_24 - in_device_shape_fields_20_follower;; -let in_device_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "in_device" 236 in_device_parser_25 - in_device_shape_fields_20_follower;; -let in_device_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "in_device" 368 in_device_parser_22 - in_device_shape_fields_20_follower;; -let in_device_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "in_device" 368 in_device_parser_22 - in_device_shape_fields_20_follower;; -let in_device_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "in_device" 244 in_device_parser_24 - in_device_shape_fields_20_follower;; -let in_device_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "in_device" 368 in_device_parser_23 - in_device_shape_fields_20_follower;; -let in_device_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "in_device" 244 in_device_parser_24 - in_device_shape_fields_20_follower;; -let in_device_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "in_device" 236 in_device_parser_25 - in_device_shape_fields_20_follower;; -let in_device_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "in_device" 244 in_device_parser_24 - in_device_shape_fields_20_follower;; -let inet6_dev_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "inet6_dev" 536 inet6_dev_parser_28 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "inet6_dev" 536 inet6_dev_parser_29 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "inet6_dev" 356 inet6_dev_parser_30 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "inet6_dev" 356 inet6_dev_parser_30 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "inet6_dev" 348 inet6_dev_parser_31 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "inet6_dev" 536 inet6_dev_parser_28 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "inet6_dev" 536 inet6_dev_parser_28 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "inet6_dev" 356 inet6_dev_parser_30 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "inet6_dev" 536 inet6_dev_parser_29 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "inet6_dev" 356 inet6_dev_parser_30 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "inet6_dev" 348 inet6_dev_parser_31 - inet6_dev_shape_fields_26_follower;; -let inet6_dev_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "inet6_dev" 356 inet6_dev_parser_30 - inet6_dev_shape_fields_26_follower;; -let in_ifaddr_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "in_ifaddr" 71 in_ifaddr_parser_34 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "in_ifaddr" 71 in_ifaddr_parser_35 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "in_ifaddr" 55 in_ifaddr_parser_36 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "in_ifaddr" 55 in_ifaddr_parser_36 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "in_ifaddr" 55 in_ifaddr_parser_37 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "in_ifaddr" 71 in_ifaddr_parser_34 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "in_ifaddr" 71 in_ifaddr_parser_34 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "in_ifaddr" 55 in_ifaddr_parser_36 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "in_ifaddr" 71 in_ifaddr_parser_35 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "in_ifaddr" 55 in_ifaddr_parser_36 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "in_ifaddr" 55 in_ifaddr_parser_37 - in_ifaddr_shape_fields_32_follower;; -let in_ifaddr_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "in_ifaddr" 55 in_ifaddr_parser_36 - in_ifaddr_shape_fields_32_follower;; -let inet6_ifaddr_kv0_follower = - kv_follower "2.6.25.14-69.fc8.x86_64" "inet6_ifaddr" 200 - inet6_ifaddr_parser_40 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv1_follower = - kv_follower "2.6.25.14-108.fc9.ppc64" "inet6_ifaddr" 200 - inet6_ifaddr_parser_41 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv2_follower = - kv_follower "2.6.25.14-108.fc9.i586" "inet6_ifaddr" 128 - inet6_ifaddr_parser_42 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv3_follower = - kv_follower "2.6.25.14-108.fc9.i686" "inet6_ifaddr" 128 - inet6_ifaddr_parser_42 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv4_follower = - kv_follower "2.6.25.14-69.fc8.ppc" "inet6_ifaddr" 124 - inet6_ifaddr_parser_43 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv5_follower = - kv_follower "2.6.25.14-108.fc9.x86_64" "inet6_ifaddr" 200 - inet6_ifaddr_parser_40 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv6_follower = - kv_follower "2.6.25.11-97.fc9.x86_64" "inet6_ifaddr" 200 - inet6_ifaddr_parser_40 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv7_follower = - kv_follower "2.6.25.14-69.fc8.i586" "inet6_ifaddr" 128 - inet6_ifaddr_parser_42 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv8_follower = - kv_follower "2.6.25.14-69.fc8.ppc64" "inet6_ifaddr" 200 - inet6_ifaddr_parser_41 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv9_follower = - kv_follower "2.6.25.11-97.fc9.i686" "inet6_ifaddr" 128 - inet6_ifaddr_parser_42 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv10_follower = - kv_follower "2.6.25.14-108.fc9.ppc" "inet6_ifaddr" 124 - inet6_ifaddr_parser_43 inet6_ifaddr_shape_fields_38_follower;; -let inet6_ifaddr_kv11_follower = - kv_follower "2.6.25.14-69.fc8.i686" "inet6_ifaddr" 128 - inet6_ifaddr_parser_42 inet6_ifaddr_shape_fields_38_follower;; -let follower_map = - StringMap.add "2.6.25.14-69.fc8.i686" - (inet6_ifaddr_kv11_follower, in_ifaddr_kv11_follower, - inet6_dev_kv11_follower, in_device_kv11_follower, net_kv11_follower, - net_device_kv11_follower, task_struct_kv11_follower) - (StringMap.add "2.6.25.14-108.fc9.ppc" - (inet6_ifaddr_kv10_follower, in_ifaddr_kv10_follower, - inet6_dev_kv10_follower, in_device_kv10_follower, net_kv10_follower, - net_device_kv10_follower, task_struct_kv10_follower) - (StringMap.add "2.6.25.11-97.fc9.i686" - (inet6_ifaddr_kv9_follower, in_ifaddr_kv9_follower, - inet6_dev_kv9_follower, in_device_kv9_follower, net_kv9_follower, - net_device_kv9_follower, task_struct_kv9_follower) - (StringMap.add "2.6.25.14-69.fc8.ppc64" - (inet6_ifaddr_kv8_follower, in_ifaddr_kv8_follower, - inet6_dev_kv8_follower, in_device_kv8_follower, - net_kv8_follower, net_device_kv8_follower, - task_struct_kv8_follower) - (StringMap.add "2.6.25.14-69.fc8.i586" - (inet6_ifaddr_kv7_follower, in_ifaddr_kv7_follower, - inet6_dev_kv7_follower, in_device_kv7_follower, - net_kv7_follower, net_device_kv7_follower, - task_struct_kv7_follower) - (StringMap.add "2.6.25.11-97.fc9.x86_64" - (inet6_ifaddr_kv6_follower, in_ifaddr_kv6_follower, - inet6_dev_kv6_follower, in_device_kv6_follower, - net_kv6_follower, net_device_kv6_follower, - task_struct_kv6_follower) - (StringMap.add "2.6.25.14-108.fc9.x86_64" - (inet6_ifaddr_kv5_follower, in_ifaddr_kv5_follower, - inet6_dev_kv5_follower, in_device_kv5_follower, - net_kv5_follower, net_device_kv5_follower, - task_struct_kv5_follower) - (StringMap.add "2.6.25.14-69.fc8.ppc" - (inet6_ifaddr_kv4_follower, in_ifaddr_kv4_follower, - inet6_dev_kv4_follower, in_device_kv4_follower, - net_kv4_follower, net_device_kv4_follower, - task_struct_kv4_follower) - (StringMap.add "2.6.25.14-108.fc9.i686" - (inet6_ifaddr_kv3_follower, - in_ifaddr_kv3_follower, inet6_dev_kv3_follower, - in_device_kv3_follower, net_kv3_follower, - net_device_kv3_follower, - task_struct_kv3_follower) - (StringMap.add "2.6.25.14-108.fc9.i586" - (inet6_ifaddr_kv2_follower, - in_ifaddr_kv2_follower, - inet6_dev_kv2_follower, - in_device_kv2_follower, net_kv2_follower, - net_device_kv2_follower, - task_struct_kv2_follower) - (StringMap.add "2.6.25.14-108.fc9.ppc64" - (inet6_ifaddr_kv1_follower, - in_ifaddr_kv1_follower, - inet6_dev_kv1_follower, - in_device_kv1_follower, net_kv1_follower, - net_device_kv1_follower, - task_struct_kv1_follower) - (StringMap.add "2.6.25.14-69.fc8.x86_64" - (inet6_ifaddr_kv0_follower, - in_ifaddr_kv0_follower, - inet6_dev_kv0_follower, - in_device_kv0_follower, - net_kv0_follower, - net_device_kv0_follower, - task_struct_kv0_follower) - StringMap.empty)))))))))));; -let task_struct_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "task_struct" in - let (_, _, _, _, _, _, f) = followers - in f load followers AddrMap.empty addr;; -let net_device_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "net_device" in - let (_, _, _, _, _, f, _) = followers - in f load followers AddrMap.empty addr;; -let net_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "net" in - let (_, _, _, _, f, _, _) = followers - in f load followers AddrMap.empty addr;; -let in_device_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "in_device" in - let (_, _, _, f, _, _, _) = followers - in f load followers AddrMap.empty addr;; -let inet6_dev_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "inet6_dev" in - let (_, _, f, _, _, _, _) = followers - in f load followers AddrMap.empty addr;; -let in_ifaddr_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "in_ifaddr" in - let (_, f, _, _, _, _, _) = followers - in f load followers AddrMap.empty addr;; -let inet6_ifaddr_follower kernel_version load addr = - let followers = - try StringMap.find kernel_version follower_map - with | Not_found -> unknown_kernel_version kernel_version "inet6_ifaddr" in - let (f, _, _, _, _, _, _) = followers - in f load followers AddrMap.empty addr;; diff --git a/lib/kernel.mli b/lib/kernel.mli index 1dcb173..25f16ba 100644 --- a/lib/kernel.mli +++ b/lib/kernel.mli @@ -16,34 +16,113 @@ module AddrMap : val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool;; end;; type kernel_version = string;; +type task_struct = + { task_struct_comm : string; task_struct_normal_prio : int64; + task_struct_pid : int64; task_struct_prio : int64; + task_struct_run_list'next : Virt_mem_mmap.addr option; + task_struct_run_list'next_offset : int; + task_struct_run_list'next_adjustment : int; + task_struct_run_list'prev : Virt_mem_mmap.addr option; + task_struct_state : int64; task_struct_static_prio : int64; + task_struct_tasks'next : Virt_mem_mmap.addr; + task_struct_tasks'next_offset : int; + task_struct_tasks'next_adjustment : int; + task_struct_tasks'prev : Virt_mem_mmap.addr + };; +type net_device = + { net_device_addr_len : int64; + net_device_dev_list'next : Virt_mem_mmap.addr option; + net_device_dev_list'next_offset : int; + net_device_dev_list'next_adjustment : int; + net_device_dev_list'prev : Virt_mem_mmap.addr option; + net_device_flags : int64; net_device_ip6_ptr : Virt_mem_mmap.addr; + net_device_ip_ptr : Virt_mem_mmap.addr; net_device_mtu : int64; + net_device_name : string; net_device_next : Virt_mem_mmap.addr option; + net_device_operstate : int64; net_device_perm_addr : string + };; +type net = + { net_dev_base_head'next : Virt_mem_mmap.addr; + net_dev_base_head'next_offset : int; + net_dev_base_head'next_adjustment : int; + net_dev_base_head'prev : Virt_mem_mmap.addr; + net_dev_base_head'prev_offset : int; + net_dev_base_head'prev_adjustment : int + };; +type in_device = { in_device_ifa_list : Virt_mem_mmap.addr };; +type inet6_dev = { inet6_dev_addr_list : Virt_mem_mmap.addr };; +type in_ifaddr = + { in_ifaddr_ifa_address : int64; in_ifaddr_ifa_broadcast : int64; + in_ifaddr_ifa_local : int64; in_ifaddr_ifa_mask : int64; + in_ifaddr_ifa_next : Virt_mem_mmap.addr + };; +type inet6_ifaddr = + { inet6_ifaddr_lst_next : Virt_mem_mmap.addr; + inet6_ifaddr_prefix_len : int64 + };; +type kernel_struct = + Task_struct of task_struct + | Net_device of net_device + | Net of net + | In_device of in_device + | Inet6_dev of inet6_dev + | In_ifaddr of in_ifaddr + | Inet6_ifaddr of inet6_ifaddr;; val task_struct_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val net_device_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val net_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val in_device_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val inet6_dev_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val in_ifaddr_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; val inet6_ifaddr_follower : kernel_version -> (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) -> - Virt_mem_mmap.addr -> (string * int) AddrMap.t;; + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t -> + Virt_mem_mmap.addr -> + (string * ((int * Bitstring.bitstring * kernel_struct) option)) + AddrMap.t;; diff --git a/lib/virt_mem.ml b/lib/virt_mem.ml index 2ed0c5a..7943797 100644 --- a/lib/virt_mem.ml +++ b/lib/virt_mem.ml @@ -579,8 +579,9 @@ Possibly the '-T' command line parameter was used inconsistently."); Bitstring.bitstring_of_string bits in let init_task = Ksymmap.find "init_task" ksyms in + let map = Kernel.AddrMap.empty in let map = - Kernel.task_struct_follower kversion load init_task in + Kernel.task_struct_follower kversion load map init_task in (* let image, tasks = @@ -611,8 +612,9 @@ Possibly the '-T' command line parameter was used inconsistently."); let map = try let dev_base = Ksymmap.find "dev_base" ksyms in + let map = Kernel.AddrMap.empty in let map = - Kernel.net_device_follower kversion load dev_base in + Kernel.net_device_follower kversion load map dev_base in Some map with Not_found -> try @@ -622,8 +624,9 @@ Possibly the '-T' command line parameter was used inconsistently."); with Not_found -> try let init_net = Ksymmap.find "init_net" ksyms in + let map = Kernel.AddrMap.empty in let map = - Kernel.net_follower kversion load init_net in + Kernel.net_follower kversion load map init_net in Some map with Not_found -> eprintf (f_"%s: cannot find dev_base, dev_base_head or init_net symbols in kernel image.\n") !image.domname; diff --git a/lib/virt_mem_kernels.ml b/lib/virt_mem_kernels.ml index 9460224..68ede24 100644 --- a/lib/virt_mem_kernels.ml +++ b/lib/virt_mem_kernels.ml @@ -1,7 +1,9 @@ let kernels = - [ "2.6.25.11-97.fc9.i686"; "2.6.25.11-97.fc9.x86_64"; - "2.6.25.14-108.fc9.i586"; "2.6.25.14-108.fc9.i686"; - "2.6.25.14-108.fc9.ppc"; "2.6.25.14-108.fc9.ppc64"; - "2.6.25.14-108.fc9.x86_64"; "2.6.25.14-69.fc8.i586"; - "2.6.25.14-69.fc8.i686"; "2.6.25.14-69.fc8.ppc"; + [ "2.6.20-1.2933.fc6.i586"; "2.6.20-1.2933.fc6.i686"; + "2.6.20-1.2933.fc6.ppc"; "2.6.20-1.2933.fc6.ppc64"; + "2.6.20-1.2933.fc6.x86_64"; "2.6.25.11-97.fc9.i686"; + "2.6.25.11-97.fc9.x86_64"; "2.6.25.14-108.fc9.i586"; + "2.6.25.14-108.fc9.i686"; "2.6.25.14-108.fc9.ppc"; + "2.6.25.14-108.fc9.ppc64"; "2.6.25.14-108.fc9.x86_64"; + "2.6.25.14-69.fc8.i586"; "2.6.25.14-69.fc8.i686"; "2.6.25.14-69.fc8.ppc"; "2.6.25.14-69.fc8.ppc64"; "2.6.25.14-69.fc8.x86_64" ];; -- 1.8.3.1