aboutsummaryrefslogtreecommitdiffstats
path: root/debug
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2015-09-30 15:39:26 +0200
committerBernhard Schommer <bernhardschommer@gmail.com>2015-09-30 15:39:26 +0200
commit4421b4168ad82d326665662a1a56a4db3cd41a11 (patch)
tree6f082989f45ab497d3116d91f2c381d27b8224ec /debug
parentefd2afc1c11ba2e6f46b25a028b5c1c56f0bc2c1 (diff)
downloadcompcert-kvx-4421b4168ad82d326665662a1a56a4db3cd41a11.tar.gz
compcert-kvx-4421b4168ad82d326665662a1a56a4db3cd41a11.zip
More robust dwarf generation. Do not add incomplete local variables
in the Debuging information.
Diffstat (limited to 'debug')
-rw-r--r--debug/DebugInformation.ml2
-rw-r--r--debug/Dwarfgen.ml42
2 files changed, 30 insertions, 14 deletions
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 382845a4..0249f20b 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -665,7 +665,7 @@ let insert_local_declaration sto id ty loc =
lvar_file_loc = loc;
lvar_type = ty;
lvar_static = sto = Storage_static;
- } in
+ } in
let id' = next_id () in
Hashtbl.add local_variables id' (LocalVariable var);
Hashtbl.add stamp_to_local id.stamp id'
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index 3239ceb6..d539f21a 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -37,6 +37,17 @@ let rec mmap f env = function
let (tl', env2) = mmap f env1 tl in
(hd' :: tl', env2)
+let rec mmap_opt f env = function
+ | [] -> ([],env)
+ | hd :: tl ->
+ let (hd',env1) = f env hd in
+ let (tl', env2) = mmap_opt f env1 tl in
+ begin
+ match hd' with
+ | Some hd -> (hd :: tl', env2)
+ | None -> tl',env2
+ end
+
(* Functions to translate the basetypes. *)
let int_type_to_entry id i =
let encoding =
@@ -349,16 +360,19 @@ let function_parameter_to_entry f_id (acc,bcc) p =
new_entry (next_id ()) (DW_TAG_formal_parameter p),(IntSet.add p.formal_parameter_type acc,loc_list@bcc)
let rec local_variable_to_entry sec f_id (acc,bcc) v id =
- let loc,loc_list = location_entry f_id (get_opt_val v.lvar_atom) in
- let var = {
- variable_file_loc = translate_file_loc sec v.lvar_file_loc;
- variable_declaration = None;
- variable_external = None;
- variable_name = v.lvar_name;
- variable_type = v.lvar_type;
- variable_location = loc;
- } in
- new_entry id (DW_TAG_variable var),(IntSet.add v.lvar_type acc,loc_list@bcc)
+ match v.lvar_atom with
+ | None -> None,(acc,bcc)
+ | Some loc ->
+ let loc,loc_list = location_entry f_id loc in
+ let var = {
+ variable_file_loc = translate_file_loc sec v.lvar_file_loc;
+ variable_declaration = None;
+ variable_external = None;
+ variable_name = v.lvar_name;
+ variable_type = v.lvar_type;
+ variable_location = loc;
+ } in
+ Some (new_entry id (DW_TAG_variable var)),(IntSet.add v.lvar_type acc,loc_list@bcc)
and scope_to_entry sec f_id acc sc id =
let l_pc,h_pc = try
@@ -377,14 +391,16 @@ and scope_to_entry sec f_id acc sc id =
lexical_block_high_pc = h_pc;
lexical_block_low_pc = l_pc;
} in
- let vars,acc = mmap (local_to_entry sec f_id) acc sc.scope_variables in
+ let vars,acc = mmap_opt (local_to_entry sec f_id) acc sc.scope_variables in
let entry = new_entry id (DW_TAG_lexical_block scope) in
add_children entry vars,acc
and local_to_entry sec f_id acc id =
match Hashtbl.find local_variables id with
| LocalVariable v -> local_variable_to_entry sec f_id acc v id
- | Scope v -> scope_to_entry sec f_id acc v id
+ | Scope v -> let s,acc =
+ (scope_to_entry sec f_id acc v id) in
+ Some s,acc
let fun_scope_to_entries sec f_id acc id =
match id with
@@ -392,7 +408,7 @@ let fun_scope_to_entries sec f_id acc id =
| Some id ->
let sc = Hashtbl.find local_variables id in
(match sc with
- | Scope sc ->mmap (local_to_entry sec f_id) acc sc.scope_variables
+ | Scope sc ->mmap_opt (local_to_entry sec f_id) acc sc.scope_variables
| _ -> assert false)
let function_to_entry sec (acc,bcc) id f =