From 05acff8bcb4f127a6f0ff6c587ba38d1c8cbe2fc Mon Sep 17 00:00:00 2001
From: Bernhard Schommer <bernhardschommer@gmail.com>
Date: Tue, 29 Sep 2015 18:35:36 +0200
Subject: More fixes for the DebugInformation.

Changed the sizeof function to take into account the bytes needed
for the sleb128/uleb128 encoding of the DW_OP_* arguments and
changed the end_live_range function to only close functions where
the live range is currently open.
---
 debug/DebugInformation.ml | 21 ++++++++-------------
 debug/DwarfPrinter.ml     |  9 ++-------
 debug/DwarfUtil.ml        | 27 +++++++++++++++++++++++++++
 debug/Dwarfgen.ml         |  1 +
 4 files changed, 38 insertions(+), 20 deletions(-)

(limited to 'debug')

diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 7866c339..73f9163a 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -256,10 +256,15 @@ let insert_type (ty: typ) =
               } in
               FunctionType ftype
           | TNamed (id,_) ->
+              let typ = try
+                let _,t =
+                  List.find (fun a -> fst a = id.name) CBuiltins.builtins.Builtins.typedefs in
+                Some (attr_aux t)
+              with Not_found -> None in
               let t = {
                 typedef_file_loc = None;
                 typedef_name = id.name;
-                typ = None;
+                typ = typ;
               } in
               Typedef t
           | TStruct (id,_) ->
@@ -749,17 +754,7 @@ let end_live_range atom lbl =
     let old_r = Hashtbl.find var_locations atom in
     match old_r with
     | RangeLoc (n_r::old_r) ->
-        let n_r = {n_r with  range_end = Some lbl} in
-        Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r))
-    | _ -> assert false
-  with Not_found -> ()
-      
-let close_range lbl atom  =
-  try
-    let old_r = Hashtbl.find var_locations atom in
-    match old_r with
-    | RangeLoc (n_r::old_r) ->
-        if n_r.range_end = None then
+        if n_r.range_end = None then (* We can skip non open locations *)
           let n_r = {n_r with  range_end = Some lbl} in
           Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r))
     | _ -> assert false
@@ -771,7 +766,7 @@ let stack_variable atom (sp,loc) =
 let function_end atom loc =
   IntSet.iter (fun id -> close_scope atom id loc) !open_scopes;
   open_scopes := IntSet.empty;
-  List.iter (close_range loc) !open_vars;
+  List.iter (fun atom -> end_live_range atom loc) !open_vars;
   open_vars:= []
 
 let compilation_section_start: (string,int * int * int * string) Hashtbl.t = Hashtbl.create 7
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index aa1c187f..a95c71a1 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -303,12 +303,6 @@ module DwarfPrinter(Target: DWARF_TARGET):
           print_uleb128 oc col
       | None -> ()
 
-    let size_of_loc_expr = function
-      | DW_OP_bregx _ -> 3
-      | DW_OP_plus_uconst _ -> 2
-      | DW_OP_piece _ -> 2
-      | DW_OP_reg i -> if i < 32 then 1 else  2
-
     let print_loc_expr oc = function
       | DW_OP_bregx (a,b) ->
           print_byte oc dw_op_bregx;
@@ -316,7 +310,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
           fprintf oc "	.sleb128	%ld\n" b
       | DW_OP_plus_uconst i ->
           print_byte oc dw_op_plus_uconst;
-          print_byte oc i
+          print_uleb128 oc i
       | DW_OP_piece i ->
           print_byte oc dw_op_piece;
           print_uleb128 oc i
@@ -360,6 +354,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
     let print_data_location oc dl =
       match dl with
       | DataLocBlock e ->
+          print_sleb128 oc (size_of_loc_expr e);
           print_loc_expr oc e
       | _ -> ()
 
diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml
index e1869281..16e446ee 100644
--- a/debug/DwarfUtil.ml
+++ b/debug/DwarfUtil.ml
@@ -113,3 +113,30 @@ let data_location_block_type_abbr = dw_form_block
 let data_location_ref_type_abbr = dw_form_ref4
 let bound_const_type_abbr = dw_form_udata
 let bound_ref_type_abbr=dw_form_ref4
+
+(* Sizeof functions for the encoding of uleb128 and sleb128 *)
+let sizeof_uleb128 value =
+  let size = ref 1 in
+  let value = ref (value lsr 7) in
+  while !value <> 0 do
+    value := !value lsr 7;
+    incr size;
+  done;
+  !size
+
+let sizeof_sleb128 value =
+  let size = ref 1 in
+  let byte = ref (value land 0x7f) in
+  let value = ref (value lsr 7) in
+  while not ((!value = 0 && (!byte land 0x40) = 0) || (!value = -1 && ((!byte land 0x40) <> 0))) do
+    byte := !value land 0x7f;
+    value := !value lsr 7;
+    incr size;
+  done;
+  !size
+
+let size_of_loc_expr = function
+  | DW_OP_bregx (a,b) -> 1 + (sizeof_uleb128 a)  + (sizeof_sleb128 (Int32.to_int b))
+  | DW_OP_plus_uconst a
+  | DW_OP_piece a -> 1 + (sizeof_uleb128 a)
+  | DW_OP_reg i -> if i < 32 then 1 else  2
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index 3239ceb6..ac32f9f1 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -235,6 +235,7 @@ let needs_types id d =
   | Void
   | EnumType _ -> d,false
   | Typedef t ->
+      Printf.printf "Typedef %s\n" t.typedef_name;
       add_type (get_opt_val t.typ) d
   | PointerType p -> 
       add_type p.pts d
-- 
cgit