"task_struct", (
"struct task_struct {", "};", true,
[ "state"; "prio"; "normal_prio"; "static_prio";
- "tasks'prev"; "tasks'next"; "mm"; "active_mm"; "comm"]
+ "tasks'prev"; "tasks'next"; "mm"; "active_mm"; "comm"; "pid" ]
);
(*
"mm_struct", (
let infos = Sys.readdir kernelsdir in
let infos = Array.to_list infos in
let infos = List.filter (fun name -> String.ends_with name ".info") infos in
- let infos = List.map ((//) kernelsdir) infos in
+ let infos = List.map ( (//) kernelsdir) infos in
(* Regular expressions. We really really should use ocaml-mikmatch ... *)
let re_oldformat = Pcre.regexp "^RPM: \\d+: \\(build \\d+\\) ([-\\w]+) ([\\w.]+) ([\\w.]+) \\(.*?\\) (\\w+)" in
match struct_name with
| None -> nested_fields
| Some prefix ->
- List.map (
- fun (name, details) -> (prefix ^ "'" ^ name, details)
- ) nested_fields in
+ List.map (
+ fun (name, details) -> (prefix ^ "'" ^ name, details)
+ ) nested_fields in
(* Parse the rest. *)
nested_fields @ parse basename rest
let subs = Pcre.exec ~rex:re_offsetsize line in
let offset = int_of_string (Pcre.get_substring subs 1) in
let size = int_of_string (Pcre.get_substring subs 2) in
- (name, (`Ptr struct_name, offset, size)) :: parse basename lines
+ (name, (`Ptr struct_name, offset, size))
+ :: parse basename lines
with
Not_found -> parse basename lines
);
let subs = Pcre.exec ~rex:re_offsetsize line in
let offset = int_of_string (Pcre.get_substring subs 1) in
let size = int_of_string (Pcre.get_substring subs 2) in
- (name, (`Str width, offset, size)) :: parse basename lines
+ (name, (`Str width, offset, size))
+ :: parse basename lines
with
Not_found -> parse basename lines
);
let datas = List.map (
fun (basename, version, arch, bodies) ->
let structures = List.filter_map (
- fun (name, (_, _, _, wanted_fields)) ->
+ fun (struct_name, (_, _, _, wanted_fields)) ->
let body =
- try Some (Hashtbl.find bodies name) with Not_found -> None in
+ try Some (Hashtbl.find bodies struct_name)
+ with Not_found -> None in
match body with
| None -> None
| Some body ->
List.iter (
fun wanted_field ->
if not (List.mem_assoc wanted_field fields) then
- failwith (sprintf "%s: structure %s is missing required field %s" basename name wanted_field)
+ failwith (sprintf "%s: structure %s is missing required field %s" basename struct_name wanted_field)
) wanted_fields;
- Some (name, (fields, total_size))
+ (* Prefix all the field names with the structure name. *)
+ let fields =
+ List.map (fun (name, details) ->
+ struct_name ^ "_" ^ name, details) fields in
+
+ Some (struct_name, (fields, total_size))
) what in
(basename, version, arch, structures)
function
| (name, `Int) ->
<:ctyp< $lid:name$ : int64 >>
- | (name, `Ptr "list_head") ->
- <:ctyp< $lid:name$ :
- [ `$lid:struct_name$ ] Virt_mem_mmap.typed_addr >>
- | (name, `Ptr struct_name) ->
- <:ctyp< $lid:name$ :
- [ `$lid:struct_name$ ] Virt_mem_mmap.typed_addr >>
+ | (name, `Ptr _) ->
+ <:ctyp< $lid:name$ : Virt_mem_mmap.addr >>
| (name, `Str _) ->
<:ctyp< $lid:name$ : string >>
) field_types in
List.map (
function
| (field_name, (`Ptr "list_head", offset, size)) ->
- sprintf "%s = (Virt_mem_mmap.unsafe_typed_addr_of_addr (Int64.sub %s %dL) : [ `%s ] Virt_mem_mmap.typed_addr)" field_name field_name offset struct_name
- | (field_name, (`Ptr struct_name, offset, size)) ->
- sprintf "%s = (Virt_mem_mmap.unsafe_typed_addr_of_addr %s : [ `%s ] Virt_mem_mmap.typed_addr)" field_name field_name struct_name
+ sprintf "%s = Int64.sub %s %dL" field_name field_name offset
| (field_name, _) ->
sprintf "%s = %s" field_name field_name
) fields
) <:str_item< let map = StringMap.empty >> kernels in
<:str_item<
- module StringMap = Map.Make (String)
+ module StringMap = Map.Make (String) ;;
$stmts$
>> in
$version_map$
type kernel_version = string
- let known version = StringMap.mem version map
- let size version =
+ 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 of_bits version bits =
+ let $lid:struct_name^"_of_bits"$ version bits =
let parsefn, _ = StringMap.find version map in
parsefn bits
- let get version mem addr =
+ let $lid:"get_"^struct_name$ version mem addr =
let parsefn, size = StringMap.find version map in
- let addr = Virt_mem_mmap.unsafe_addr_of_typed_addr addr in
let bytes = Virt_mem_mmap.get_bytes mem addr size in
let bits = Bitstring.bitstring_of_string bytes in
parsefn bits
$struct_sig$
type kernel_version = string
- val known : kernel_version -> bool
- val size : kernel_version -> int
- val of_bits : kernel_version -> Bitstring.bitstring -> t
- val get : kernel_version ->
- ('a, 'b, [`HasMapping]) Virt_mem_mmap.t ->
- [ `$lid:struct_name$ ] Virt_mem_mmap.typed_addr ->
- t
+ 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
>> in
(struct_name, code, interface, parser_subs)