X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=extract%2Fcodegen%2Fkerneldb_to_parser.ml;h=e4c751971d7b5c16bbe391ff9f9facaafe52fffd;hb=2e1de51e35bea53ebece1a6fd6d6970534f4cbe9;hp=4bda41871744f205285bda96e54f0b9be40bd9b1;hpb=2130352fd969e0d07dee19aa93d5f3369e89baa5;p=virt-mem.git

diff --git a/extract/codegen/kerneldb_to_parser.ml b/extract/codegen/kerneldb_to_parser.ml
index 4bda418..e4c7519 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,19 +76,59 @@ 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;
+      "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", { 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 };
     ]
   };
+  "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 = false
@@ -99,10 +152,12 @@ let (//) = Filename.concat
  * '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 the last one working.
+ * Thanks to bluestorm on #ocaml for getting these working.
  *)
 let concat_str_items _loc items =
   match items with
@@ -128,6 +183,9 @@ let concat_record_bindings _loc rbs =
     | 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
@@ -316,8 +374,9 @@ Example (from toplevel of virt-mem source tree):
    * XXX Even better would be to have a proper interface to libdwarves.
    *)
   let re_offsetsize = Pcre.regexp "/\\*\\s+(\\d+)\\s+(\\d+)\\s+\\*/" in
-  let re_intfield = Pcre.regexp "int\\s+(\\w+);" in
+  let re_intfield = Pcre.regexp "(?:int|char)\\s+(\\w+);" in
   let re_ptrfield = Pcre.regexp "struct\\s+(\\w+)\\s*\\*\\s*(\\w+);" in
+  let re_voidptrfield = Pcre.regexp "void\\s*\\*\\s*(\\w+);" in
   let re_strfield = Pcre.regexp "char\\s+(\\w+)\\[(\\d+)\\];" in
   let re_structopener = Pcre.regexp "(struct|union)\\s+.*{$" in
   let re_structcloser = Pcre.regexp "}\\s*(\\w+)?(\\[\\d+\\])?;" in
@@ -402,6 +461,20 @@ Example (from toplevel of virt-mem source tree):
 	 Not_found -> parse basename lines
       );
 
+    | line :: lines when Pcre.pmatch ~rex:re_voidptrfield line ->
+      (* A void* field. *)
+      let subs = Pcre.exec ~rex:re_voidptrfield line in
+      let name = Pcre.get_substring subs 1 in
+      (try
+	 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, (`VoidPtr, offset, size))
+	   :: parse basename lines
+       with
+	 Not_found -> parse basename lines
+      );
+
     | line :: lines when Pcre.pmatch ~rex:re_strfield line ->
       (* A string (char array) field. *)
       let subs = Pcre.exec ~rex:re_strfield line in
@@ -446,6 +519,7 @@ Example (from toplevel of virt-mem source tree):
 	      (* That got us all the fields, but we only care about
 	       * the wanted_fields.
 	       *)
+	      let all_fields = fields in
 	      let fields = List.filter (
 		fun (name, _) -> List.mem_assoc name wanted_fields
 	      ) fields in
@@ -453,8 +527,15 @@ Example (from toplevel of virt-mem source tree):
 	      (* Also check we have all the mandatory fields. *)
 	      List.iter (
 		fun (wanted_field, { mandatory_field = mandatory }) ->
-		  if mandatory && not (List.mem_assoc wanted_field fields) then
-		    failwith (sprintf "%s: structure %s is missing required field %s" basename struct_name wanted_field)
+		  if mandatory && not (List.mem_assoc wanted_field fields)
+		  then (
+		    eprintf "%s: structure %s is missing required field %s\n" basename struct_name wanted_field;
+		    eprintf "fields found in this structure:\n";
+		    List.iter (
+		      fun (name, _) -> eprintf "\t%s\n" name
+		    ) all_fields;
+		    exit 1
+		  );
 	      ) wanted_fields;
 
 	      (* Prefix all the field names with the structure name. *)
@@ -482,6 +563,8 @@ Example (from toplevel of virt-mem source tree):
                      printf "    int %s; " field_name
 		 | `Ptr struct_name ->
 		     printf "    struct %s *%s; " struct_name field_name
+		 | `VoidPtr ->
+		     printf "    void *%s; " field_name
 		 | `Str width ->
 		     printf "    char %s[%d]; " field_name width
 		);
@@ -580,16 +663,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)
@@ -682,17 +765,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, ((`VoidPtr|`Ptr _), { mandatory_field = true })) ->
 		<:ctyp< $lid:name$ : Virt_mem_mmap.addr >>
-	    | (name, (`Ptr _, false)) ->
+	    | (name, ((`VoidPtr|`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
@@ -737,8 +820,9 @@ Example (from toplevel of virt-mem source tree):
 	      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$ = { () with $fieldsigs$ }
+		let $lid:fsname$ = $fieldsigs$
 	      >>
 	  ) parsers in
 
@@ -784,8 +868,7 @@ Example (from toplevel of virt-mem source tree):
 		String.concat ";\n      " (
 		  List.map (
 		    function
-		    | (field_name, (`Int, offset, size))
-		    | (field_name, (`Ptr _, offset, size)) ->
+		    | (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
@@ -797,21 +880,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 =