X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=extract%2Fcodegen%2Fcode_generation.ml;h=b465e4ba2c593a4dad663125b11ed3aa91a87bc6;hb=6d60df50895e83763a20c4ec62ef0ec334cd7676;hp=41520dc1b3170a7ab6e1db31148df0d9b37b89c6;hpb=82201a5312c3582daeb7215efd731f7e784d9edf;p=virt-mem.git

diff --git a/extract/codegen/code_generation.ml b/extract/codegen/code_generation.ml
index 41520dc..b465e4b 100644
--- a/extract/codegen/code_generation.ml
+++ b/extract/codegen/code_generation.ml
@@ -531,30 +531,60 @@ let generate_followers names xs =
 	      match typ with
 	      | PP.FListHeadPointer _ ->
 		  <:expr<
-		    (* For list head pointers, add the address of the base
+		    if debug then
+		      eprintf "%s_follower: %s: list_head pointing at a %s\n"
+			$str:struct_name$ $str:name$ $str:dest_struct_name$;
+
+	            (* For list head pointers, add the address of the base
 		     * of this virtual structure to the map, then adjust
 		     * the pointer.
 		     *)
 		    let offset = data.$lid:struct_name^"_"^name^"_offset"$
 		    and adj = data.$lid:struct_name^"_"^name^"_adjustment"$ in
+
+		    if debug then
+		      eprintf "%s_follower: %s: offset=%d adjustment=%d\n"
+			$str:struct_name$ $str:name$ offset adj;
+
 		    let offset = Int64.of_int offset
 		    and adj = Int64.of_int adj in
-		    (* 'addr' is base of the virtual struct *)
-		    let addr = Int64.sub (Int64.add addr offset) adj in
+
+		    (* 'addr' is base of the virtual struct, but when
+		     * adding it to the map make sure we don't splat
+		     * the real structure (can happen if offset=adj).
+		     *)
 		    let map =
-		      AddrMap.add addr ($str:dest_struct_name$, None) map in
+		      if offset <> adj then (
+			let addr = Int64.sub (Int64.add addr offset) adj in
+			AddrMap.add addr ($str:dest_struct_name$, None) map
+		      ) else map in
+
+		    (* 'dest_addr' is the destination address of
+		     * this pointer.  It needs the usual list_head
+		     * adjustment applied.
+		     *)
 		    let dest_addr = Int64.sub dest_addr adj in
+
+		    if debug then
+		      eprintf "%s_follower: %s: dest_addr=%Lx\n"
+			$str:struct_name$ $str:name$ dest_addr;
+
 		    let map =
 		      $lid:dest_struct_name^"_follower"$
-			kernel_version load map dest_addr in
+			debug kernel_version load map dest_addr in
 		    map
 		  >>
 
 	      | PP.FStructPointer _ ->
 		  <:expr<
+		    if debug then
+		      eprintf "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx\n"
+			$str:struct_name$ $str:name$
+			$str:dest_struct_name$ dest_addr;
+
 		    let map =
 		      $lid:dest_struct_name^"_follower"$
-			kernel_version load map dest_addr in
+			debug kernel_version load map dest_addr in
 		    map
 		  >>
 
@@ -580,7 +610,9 @@ let generate_followers names xs =
       let struct_name_uc = String.capitalize struct_name in
 
       <:binding<
-	$lid:struct_name^"_follower"$ kernel_version load map addr =
+	$lid:struct_name^"_follower"$ debug kernel_version load map addr =
+	  if debug then
+	    eprintf "%s_follower: addr = %Lx\n" $str:struct_name$ addr;
           if addr <> 0L && not (AddrMap.mem addr map) then (
 	    let parser_ = $lid:"parser_of_"^struct_name$ kernel_version in
 	    let total_size = $lid:"size_of_"^struct_name$ kernel_version in
@@ -603,7 +635,7 @@ let generate_followers names xs =
     fun (struct_name, _) ->
       <:sig_item<
         val $lid:struct_name^"_follower"$ :
-	  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr ->
+	  bool -> kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr ->
 	  addrmap
       >>
   ) xs in