Make the modules more accessible to be 'open'ed.

[virt-mem.git] / extract / codegen / kerneldb_to_parser.ml

diff --git a/extract/codegen/kerneldb_to_parser.ml b/extract/codegen/kerneldb_to_parser.ml
index 2bddb90..6414ce4 100644 (file)
--- a/extract/codegen/kerneldb_to_parser.ml
+++ b/extract/codegen/kerneldb_to_parser.ml
@@ -32,7 +32,7 @@ let what = [
   "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", (
@@ -286,9 +286,9 @@ Example (from toplevel of virt-mem source tree):
        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
@@ -315,7 +315,8 @@ Example (from toplevel of virt-mem source tree):
         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
       );
@@ -329,7 +330,8 @@ Example (from toplevel of virt-mem source tree):
         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
       );
@@ -343,9 +345,10 @@ Example (from toplevel of virt-mem source tree):
   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 ->
@@ -370,10 +373,15 @@ Example (from toplevel of virt-mem source tree):
              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)
@@ -516,12 +524,8 @@ Example (from toplevel of virt-mem source tree):
            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
@@ -593,9 +597,7 @@ Example (from toplevel of virt-mem source tree):
                  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
@@ -640,16 +642,15 @@ Example (from toplevel of virt-mem source tree):
          $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
@@ -661,13 +662,12 @@ Example (from toplevel of virt-mem source tree):
          $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)