diff options
author | Bernhard Schommer <bernhardschommer@gmail.com> | 2015-09-30 15:39:26 +0200 |
---|---|---|
committer | Bernhard Schommer <bernhardschommer@gmail.com> | 2015-09-30 15:39:26 +0200 |
commit | 4421b4168ad82d326665662a1a56a4db3cd41a11 (patch) | |
tree | 6f082989f45ab497d3116d91f2c381d27b8224ec | |
parent | efd2afc1c11ba2e6f46b25a028b5c1c56f0bc2c1 (diff) | |
download | compcert-4421b4168ad82d326665662a1a56a4db3cd41a11.tar.gz compcert-4421b4168ad82d326665662a1a56a4db3cd41a11.zip |
More robust dwarf generation. Do not add incomplete local variables
in the Debuging information.
-rw-r--r-- | debug/DebugInformation.ml | 2 | ||||
-rw-r--r-- | debug/Dwarfgen.ml | 42 |
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 = |