Integrated image/kdata into kimage structure. Removed dead-code.
[virt-mem.git] / extract / codegen / code_generation.ml
index 41254d8..41520dc 100644 (file)
@@ -448,7 +448,7 @@ let generate_parsers xs =
   | { %s } ->
       { %s }
   | { _ } ->
-      raise (Virt_mem_types.ParseError (%S, %S, match_err))"
+      raise (ParseError (%S, %S, match_err))"
              patterns assignments
              struct_name pa_name in
 
@@ -603,13 +603,8 @@ let generate_followers names xs =
     fun (struct_name, _) ->
       <:sig_item<
         val $lid:struct_name^"_follower"$ :
-         kernel_version ->
-         (string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring) ->
-         (string * (int * Bitstring.bitstring * kernel_struct) option)
-            AddrMap.t ->
-         Virt_mem_mmap.addr ->
-         (string * (int * Bitstring.bitstring * kernel_struct) option)
-            AddrMap.t
+         kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr ->
+         addrmap
       >>
   ) xs in
   let sigs = concat_sig_items sigs in
@@ -617,7 +612,9 @@ let generate_followers names xs =
   strs, sigs
 
 let output_interf ~output_file types offsets parsers version_maps followers =
-  (* Some standard code that appears at the top of the interface file. *)
+  (* Some standard code that appears at the top and bottom
+   * of the interface file.
+   *)
   let prologue =
     <:sig_item<
       module AddrMap : sig
@@ -636,12 +633,28 @@ let output_interf ~output_file types offsets parsers version_maps followers =
        val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
        val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
       end ;;
-      type kernel_version = string ;;
+      exception ParseError of string * string * string ;;
+
+      type kernel_version = string
+
+      type load_fn =
+         string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring
+    >>
+  and addrmap =
+    <:sig_item<
+      type addrmap =
+         (string * (int * Bitstring.bitstring * kernel_struct) option)
+           AddrMap.t
     >> in
 
   let sigs =
-    concat_sig_items [ prologue; types; offsets; parsers;
-                      version_maps; followers ] in
+    concat_sig_items [ prologue;
+                      types;
+                      addrmap;
+                      offsets;
+                      parsers;
+                      version_maps;
+                      followers ] in
   Printers.OCaml.print_interf ~output_file sigs;
 
   ignore (Sys.command (sprintf "wc -l %s" (Filename.quote output_file)))
@@ -651,15 +664,17 @@ let re_subst = Pcre.regexp "^(.*)\"(\\w+_parser_\\d+)\"(.*)$"
 
 let output_implem ~output_file types offsets parsers parser_subs
     version_maps followers =
-  (* Some standard code that appears at the top of the implementation file. *)
+  (* Some standard code that appears at the top and bottom
+   * of the implementation file.
+   *)
   let prologue =
     <:str_item<
       open Printf ;;
       module StringMap = Map.Make (String) ;;
       module AddrMap = Map.Make (Int64) ;;
-      type kernel_version = string ;;
+      exception ParseError of string * string * string ;;
 
-      let match_err = "failed to match kernel structure" ;;
+      let match_err = "failed to match kernel structure"
 
       let unknown_kernel_version version struct_name =
        invalid_arg (sprintf "%s: unknown kernel version or
@@ -667,14 +682,28 @@ struct %s is not supported in this kernel.
 Try a newer version of virt-mem, or if the guest is not from a
 supported Linux distribution, see this page about adding support:
   http://et.redhat.com/~rjones/virt-mem/faq.html\n"
-                      version struct_name) ;;
+                      version struct_name)
+
+      type kernel_version = string
+      type load_fn = string -> Virt_mem_mmap.addr -> int -> Bitstring.bitstring
 
-      let zero = 0 ;;
+      let zero = 0
+    >>
+  and addrmap =
+    <:str_item<
+      type addrmap =
+         (string * (int * Bitstring.bitstring * kernel_struct) option)
+           AddrMap.t
     >> in
 
   let strs =
-    concat_str_items [ prologue; types; offsets; parsers;
-                      version_maps; followers ] in
+    concat_str_items [ prologue;
+                      types;
+                      addrmap;
+                      offsets;
+                      parsers;
+                      version_maps;
+                      followers ] in
 
   (* Write the new implementation to .ml.new file. *)
   let new_output_file = output_file ^ ".new" in