if fields <> [] then (
let fields = List.map (
fun (name, t) ->
- let t = ocaml_type_of_field_type t in
- <:ctyp< $lid:sf_name^"_"^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<
List.find (fun { PP.field_name = name } -> field_name = name)
structure.PP.struct_fields in
- (* Generate assignment code, if necessary we can adjust
- * the list_head.
+ (* Generate assignment code. List_heads are treated
+ * specially because they have an implicit adjustment.
*)
match field_type with
| PP.FListHeadPointer None ->
- sprintf "%s_%s = (if %s <> 0L then Int64.sub %s %dL else %s)"
- sf.SC.sf_name field_name
- field_name
- field_name offset field_name
+ 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)) ->
* know the offset until runtime, so we have to call
* offset_of_<struct>_<field> to find it.
*)
- sprintf "%s_%s = (
- if %s <> 0L then (
- let offset = offset_of_%s_%s kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub %s offset
- ) else %s
- )"
+ sprintf "%s_%s = %s;
+ %s_%s_offset = %d;
+ %s_%s_adjustment = offset_of_%s_%s kernel_version"
sf.SC.sf_name field_name field_name
- other_struct_name other_field_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
| PP.FListHeadPointer (Some (struct_name, _)) -> struct_name
| PP.FStructPointer struct_name -> struct_name
| _ -> assert false in
- tuple_generate_extract follower_tuple follower_name
- <:patt< f >> <:expr< followers >>
- <:expr<
- let map =
- f load followers map shape.$lid:sf_name^"_"^name$ in $body$
- >>
+
+ match typ with
+ | PP.FListHeadPointer _ ->
+ tuple_generate_extract follower_tuple follower_name
+ <:patt< f >> <:expr< followers >>
+ <: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 = 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$
+ >>
+
+ | PP.FStructPointer _ ->
+ tuple_generate_extract follower_tuple follower_name
+ <:patt< f >> <:expr< followers >>
+ <:expr<
+ let map =
+ f load followers map shape.$lid:sf_name^"_"^name$ in
+ $body$
+ >>
+
+ | _ -> assert false
) fields <:expr< map >> in
<:str_item<
- let $lid:sf_name^"_follower"$ load followers map shape =
+ let $lid:sf_name^"_follower"$ load followers map addr shape =
$body$
>>
) sflist
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 shape
+ followerfn load followers map addr shape
)
else map
>> in
let sigs =
concat_sig_items [ prologue; types; offsets; parsers; followers ] in
- Printers.OCaml.print_interf ~output_file sigs
+ Printers.OCaml.print_interf ~output_file sigs;
+
+ ignore (Sys.command (sprintf "wc -l %s" (Filename.quote output_file)))
(* Finally generate the output files. *)
let re_subst = Pcre.regexp "^(.*)\"(\\w+_parser_\\d+)\"(.*)$"
(* Some standard code that appears at the top of the implementation file. *)
let prologue =
<:str_item<
+ open Printf ;;
module StringMap = Map.Make (String) ;;
module AddrMap = Map.Make (Int64) ;;
type kernel_version = string ;;
close_out ochan;
close_in ichan;
- Unix.unlink new_output_file
+ Unix.unlink new_output_file;
+
+ ignore (Sys.command (sprintf "wc -l %s" (Filename.quote output_file)))
* that you do 'make update-kernel-structs'.
*)
+open Printf;;
module StringMap = Map.Make(String);;
module AddrMap = Map.Make(Int64);;
type kernel_version = string;;
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 : 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_content_fields_2 =
{ task_struct_content_fields_2_comm : 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 ('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'prev : 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);;
pid : zero+32 : offset(4352), littleendian;
comm : 128 : offset(8392), string } ->
let s =
- { task_struct_shape_fields_1_tasks'next = (if tasks'next <> 0L then Int64.sub tasks'next 480L else tasks'next) } in
+ { 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;
pid : zero+32 : offset(4352), bigendian;
comm : 128 : offset(8392), string } ->
let s =
- { task_struct_shape_fields_1_tasks'next = (if tasks'next <> 0L then Int64.sub tasks'next 480L else tasks'next) } in
+ { 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;
pid : zero+32 : offset(3552), littleendian;
comm : 128 : offset(5896), string } ->
let s =
- { task_struct_shape_fields_1_tasks'next = (if tasks'next <> 0L then Int64.sub tasks'next 400L else tasks'next) } in
+ { 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;
pid : zero+32 : offset(3584), littleendian;
comm : 128 : offset(5928), string } ->
let s =
- { task_struct_shape_fields_1_tasks'next = (if tasks'next <> 0L then Int64.sub tasks'next 404L else tasks'next) } in
+ { 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;
pid : zero+32 : offset(3680), bigendian;
comm : 128 : offset(6056), string } ->
let s =
- { task_struct_shape_fields_1_tasks'next = (if tasks'next <> 0L then Int64.sub tasks'next 416L else tasks'next) } in
+ { 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;
ip_ptr : zero+64 : offset(3840), littleendian;
ip6_ptr : zero+64 : offset(3968), littleendian } ->
let s =
- { net_device_shape_fields_8_dev_list'next = (if dev_list'next <> 0L then Int64.sub dev_list'next 72L else dev_list'next);
+ { 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 =
ip_ptr : zero+64 : offset(3840), bigendian;
ip6_ptr : zero+64 : offset(3968), bigendian } ->
let s =
- { net_device_shape_fields_8_dev_list'next = (if dev_list'next <> 0L then Int64.sub dev_list'next 72L else dev_list'next);
+ { 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 =
ip_ptr : zero+32 : offset(2304), littleendian;
ip6_ptr : zero+32 : offset(2368), littleendian } ->
let s =
- { net_device_shape_fields_8_dev_list'next = (if dev_list'next <> 0L then Int64.sub dev_list'next 48L else dev_list'next);
+ { 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 =
ip_ptr : zero+32 : offset(2304), bigendian;
ip6_ptr : zero+32 : offset(2368), bigendian } ->
let s =
- { net_device_shape_fields_8_dev_list'next = (if dev_list'next <> 0L then Int64.sub dev_list'next 48L else dev_list'next);
+ { 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 =
| { 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 = (
- if dev_base_head'next <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'next offset
- ) else dev_base_head'next
- );
- net_shape_fields_14_dev_base_head'prev = (
- if dev_base_head'prev <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'prev offset
- ) else dev_base_head'prev
- ) } in
+ { 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)
| { 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 = (
- if dev_base_head'next <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'next offset
- ) else dev_base_head'next
- );
- net_shape_fields_14_dev_base_head'prev = (
- if dev_base_head'prev <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'prev offset
- ) else dev_base_head'prev
- ) } in
+ { 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)
| { 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 = (
- if dev_base_head'next <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'next offset
- ) else dev_base_head'next
- );
- net_shape_fields_14_dev_base_head'prev = (
- if dev_base_head'prev <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'prev offset
- ) else dev_base_head'prev
- ) } in
+ { 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)
| { 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 = (
- if dev_base_head'next <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'next offset
- ) else dev_base_head'next
- );
- net_shape_fields_14_dev_base_head'prev = (
- if dev_base_head'prev <> 0L then (
- let offset = offset_of_net_device_dev_list'next kernel_version in
- let offset = Int64.of_int offset in
- Int64.sub dev_base_head'prev offset
- ) else dev_base_head'prev
- ) } in
+ { 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)
(s, c)
| { _ } ->
raise (Virt_mem_types.ParseError ("inet6_ifaddr", "inet6_ifaddr_parser_43", match_err));;
-let task_struct_shape_fields_1_follower load followers map shape =
+let task_struct_shape_fields_1_follower load followers map addr shape =
let (_, _, _, _, _, _, f) = followers in
- let map = f load followers map shape.task_struct_shape_fields_1_tasks'next
- in map;;
-let net_device_shape_fields_8_follower load followers map shape =
+ 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 map =
- f load followers map shape.net_device_shape_fields_8_dev_list'next 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 shape =
+let net_shape_fields_14_follower load followers map addr shape =
let (_, _, _, _, _, f, _) = followers in
- let map =
- f load followers map shape.net_shape_fields_14_dev_base_head'next 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 map = f load followers map shape.net_shape_fields_14_dev_base_head'prev
- in map;;
-let in_device_shape_fields_20_follower load followers map shape =
+ 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 shape =
+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 shape =
+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 shape =
+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 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 shape)
+ in followerfn load followers map addr shape)
else map;;
let task_struct_kv0_follower =
kv_follower "2.6.25.14-69.fc8.x86_64" "task_struct" 2496