Structure parsers reintroduced. ** NOT WORKING **

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

diff --git a/extract/codegen/compile_kerneldb.ml b/extract/codegen/compile_kerneldb.ml
index 9d9e89c..31bb000 100644 (file)
--- a/extract/codegen/compile_kerneldb.ml
+++ b/extract/codegen/compile_kerneldb.ml
@@ -34,7 +34,7 @@ type struct_t = {
 }
 and field_metadata_t =
   | VoidPointerIsReally of string
-  | ListHeadIsReally of string
+  | ListHeadIsReally of (string * string) option
 
 (*----------------------------------------------------------------------
  * This controls what structures & fields we will parse out.
@@ -46,10 +46,10 @@ let good_structs = [
                    "state"; "prio"; "static_prio"; "normal_prio";
                    "comm"; "pid" ];
     field_metadata = [
-      "tasks'next", ListHeadIsReally "task_struct";
-      "tasks'prev", ListHeadIsReally "task_struct";
-      "run_list'next", ListHeadIsReally "task_struct";
-      "run_list'prev", ListHeadIsReally "task_struct";
+      "tasks'next", ListHeadIsReally None;
+      "tasks'prev", ListHeadIsReally None;
+      "run_list'next", ListHeadIsReally None;
+      "run_list'prev", ListHeadIsReally None;
     ];
   };
   "net_device", {
@@ -58,8 +58,8 @@ let good_structs = [
                    "name"; "flags"; "operstate"; "mtu"; "perm_addr";
                    "addr_len" ];
     field_metadata = [
-      "dev_list'next", ListHeadIsReally "net_device";
-      "dev_list'prev", ListHeadIsReally "net_device";
+      "dev_list'next", ListHeadIsReally None;
+      "dev_list'prev", ListHeadIsReally None;
       "ip_ptr", VoidPointerIsReally "in_device";
       "ip6_ptr", VoidPointerIsReally "inet6_dev";
     ];
@@ -67,8 +67,8 @@ let good_structs = [
   "net", {
     good_fields = [ "dev_base_head'next"; "dev_base_head'prev" ];
     field_metadata = [
-      "dev_base_head'next", ListHeadIsReally "net_device";
-      "dev_base_head'prev", ListHeadIsReally "net_device";
+      "dev_base_head'next", ListHeadIsReally (Some ("net_device", "dev_list"));
+      "dev_base_head'prev", ListHeadIsReally (Some ("net_device", "dev_list"));
     ];
   };
   "in_device", {
@@ -90,7 +90,7 @@ let good_structs = [
   };
 ]
 
-let debug = true
+let debug = false
 
 open Camlp4.PreCast
 open Syntax
@@ -342,13 +342,21 @@ Options:
       ) structures
     ) in
 
+  let implem_parsers, interf_parsers, subst_parsers =
+    CG.generate_parsers (
+      List.map (
+       fun (struct_name, (_, _, _, _, _, _, palist, _)) ->
+         (struct_name, palist)
+      ) structures
+    ) in
+
   (* Output the generated code. *)
   let output_file = outputdir // "kernel.mli" in
   printf "Writing kernel data interface to %s ...\n%!" output_file;
-  CG.output_interf ~output_file interf_types;
+  CG.output_interf ~output_file interf_types interf_parsers;
 
   let output_file = outputdir // "kernel.ml" in
   printf "Writing kernel data parsers to %s ...\n%!" output_file;
-  CG.output_implem ~output_file implem_types;
+  CG.output_implem ~output_file implem_types implem_parsers subst_parsers;
 
-  (* XXX Here we need to substitute the parser code. *)
+  printf "Finished.\n"