From 9d054ac710a2e62070b1d92a8261eb11ec19dd65 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Allow the automatic list_head adjustment to be overridden, when pointers go from one type of structure to another type. --- extract/codegen/kerneldb_to_parser.ml | 80 +++++++++++++++++++++-------------- 1 file changed, 49 insertions(+), 31 deletions(-) diff --git a/extract/codegen/kerneldb_to_parser.ml b/extract/codegen/kerneldb_to_parser.ml index f94de2f..2a46b68 100644 --- a/extract/codegen/kerneldb_to_parser.ml +++ b/extract/codegen/kerneldb_to_parser.ml @@ -36,22 +36,35 @@ type struct_t = { } 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", { mandatory_field = true }; - "prio", { mandatory_field = true }; - "normal_prio", { mandatory_field = true }; - "static_prio", { mandatory_field = true }; - "tasks'prev", { mandatory_field = true }; - "tasks'next", { mandatory_field = true }; - "mm", { mandatory_field = true }; - "active_mm", { mandatory_field = true }; - "comm", { mandatory_field = true }; - "pid", { mandatory_field = true }; + "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; ] }; (* @@ -63,17 +76,21 @@ let structs = [ "net_device", { opener = "struct net_device {"; closer = "};"; mandatory_struct = true; fields = [ - "dev_list'prev", { mandatory_field = false }; - "dev_list'next", { mandatory_field = false }; - "next", { mandatory_field = false }; - "name", { mandatory_field = true }; - "dev_addr", { mandatory_field = true }; + "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; + "dev_addr", ordinary_field; ] }; "net", { opener = "struct net {"; closer = "};"; mandatory_struct = false; fields = [ - "dev_base_head'next", { mandatory_field = true }; + "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 }; ] }; ] @@ -585,16 +602,16 @@ Example (from toplevel of virt-mem source tree): (* Now get a type for each structure field. *) List.filter_map ( - fun (field_name, { mandatory_field = mandatory }) -> + 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, mandatory)) + 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 mandatory then failwith msg else prerr_endline msg; + if ft.mandatory_field then failwith msg else prerr_endline msg; None ) struct_fields in (struct_name, kernels, field_types) @@ -687,17 +704,17 @@ Example (from toplevel of virt-mem source tree): let struct_type, struct_sig = let fields = List.map ( function - | (name, (`Int, true)) -> + | (name, (`Int, { mandatory_field = true })) -> <:ctyp< $lid:name$ : int64 >> - | (name, (`Int, false)) -> + | (name, (`Int, { mandatory_field = false })) -> <:ctyp< $lid:name$ : int64 option >> - | (name, (`Ptr _, true)) -> + | (name, (`Ptr _, { mandatory_field = true })) -> <:ctyp< $lid:name$ : Virt_mem_mmap.addr >> - | (name, (`Ptr _, false)) -> + | (name, (`Ptr _, { mandatory_field = false })) -> <:ctyp< $lid:name$ : Virt_mem_mmap.addr option >> - | (name, (`Str _, true)) -> + | (name, (`Str _, { mandatory_field = true })) -> <:ctyp< $lid:name$ : string >> - | (name, (`Str _, false)) -> + | (name, (`Str _, { mandatory_field = false })) -> <:ctyp< $lid:name$ : string option >> ) field_types in let fields = concat_record_fields _loc fields in @@ -803,21 +820,22 @@ Example (from toplevel of virt-mem source tree): let assignments = List.map ( fun (field_name, typ) -> - let (_, mandatory) = + 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 with - | (`Ptr "list_head", offset, size), true -> + 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 -> + | (`Ptr "list_head", offset, size), false, true -> sprintf "%s = Some (Int64.sub %s %dL)" field_name field_name offset - | _, true -> + | _, true, _ -> sprintf "%s = %s" field_name field_name - | _, false -> + | _, false, _ -> sprintf "%s = Some %s" field_name field_name ) fields in let assignments_not_present = -- 1.8.3.1