From 68ad5472a78d12e0e4fd4eae422122185403d678 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 28 Sep 2015 18:39:43 +0200 Subject: Change the way the debug sections are printed. If a user uses the #pragma use_section for functions the diab linker requires a separate debug_info section for each entry. This commit adds functionality to emulate this behavior. --- debug/Dwarfgen.ml | 116 ++++++++++++++++++++++++++++++++---------------------- 1 file changed, 69 insertions(+), 47 deletions(-) (limited to 'debug/Dwarfgen.ml') diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 7fce22a7..3239ceb6 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -72,10 +72,20 @@ let void_to_entry id = } in new_entry id (DW_TAG_base_type void) -let typedef_to_entry id t = +let translate_file_loc sec (f,l) = + Hashtbl.find filenum (sec,f),l + +let translate_file_loc_opt sec = function + | None -> None + | Some (f,l) -> + try + Some (translate_file_loc sec (f,l)) + with Not_found -> None + +let typedef_to_entry sec id t = let i = get_opt_val t.typ in let td = { - typedef_file_loc = t.typedef_file_loc; + typedef_file_loc = translate_file_loc_opt sec t.typedef_file_loc; typedef_name = t.typedef_name; typedef_type = i; } in @@ -110,7 +120,7 @@ let const_to_entry id c = let volatile_to_entry id v = new_entry id (DW_TAG_volatile_type ({volatile_type = v.vol_type})) -let enum_to_entry id e = +let enum_to_entry sec id e = let enumerator_to_entry e = let tag = { @@ -121,7 +131,7 @@ let enum_to_entry id e = new_entry (next_id ()) (DW_TAG_enumerator tag) in let bs = sizeof_ikind enum_ikind in let enum = { - enumeration_file_loc = e.enum_file_loc; + enumeration_file_loc = translate_file_loc_opt sec e.enum_file_loc; enumeration_byte_size = bs; enumeration_declaration = Some false; enumeration_name = Some e.enum_name; @@ -172,9 +182,9 @@ let member_to_entry mem = } in new_entry (next_id ()) (DW_TAG_member mem) -let struct_to_entry id s = +let struct_to_entry sec id s = let tag = { - structure_file_loc = s.ct_file_loc; + structure_file_loc = translate_file_loc_opt sec s.ct_file_loc; structure_byte_size = s.ct_sizeof; structure_declaration = Some s.ct_declaration; structure_name = if s.ct_name <> "" then Some s.ct_name else None; @@ -183,9 +193,9 @@ let struct_to_entry id s = let child = List.map member_to_entry s.ct_members in add_children entry child -let union_to_entry id s = +let union_to_entry sec id s = let tag = { - union_file_loc = s.ct_file_loc; + union_file_loc = translate_file_loc_opt sec s.ct_file_loc; union_byte_size = s.ct_sizeof; union_declaration = Some s.ct_declaration; union_name = if s.ct_name <> "" then Some s.ct_name else None; @@ -194,20 +204,20 @@ let union_to_entry id s = let child = List.map member_to_entry s.ct_members in add_children entry child -let composite_to_entry id s = +let composite_to_entry sec id s = match s.ct_sou with - | Struct -> struct_to_entry id s - | Union -> union_to_entry id s + | Struct -> struct_to_entry sec id s + | Union -> union_to_entry sec id s -let infotype_to_entry id = function +let infotype_to_entry sec id = function | IntegerType i -> int_type_to_entry id i | FloatType f -> float_type_to_entry id f | PointerType p -> pointer_to_entry id p | ArrayType arr -> array_to_entry id arr - | CompositeType c -> composite_to_entry id c - | EnumType e -> enum_to_entry id e + | CompositeType c -> composite_to_entry sec id c + | EnumType e -> enum_to_entry sec id e | FunctionType f -> fun_type_to_entry id f - | Typedef t -> typedef_to_entry id t + | Typedef t -> typedef_to_entry sec id t | ConstType c -> const_to_entry id c | VolatileType v -> volatile_to_entry id v | Void -> void_to_entry id @@ -246,7 +256,7 @@ let needs_types id d = let d,c' = add_type f.cfd_typ d in d,c||c') (d,false) c.ct_members -let gen_types needed = +let gen_types sec needed = let rec aux d = let d,c = IntSet.fold (fun id (d,c) -> let d,c' = needs_types id d in @@ -258,13 +268,13 @@ let gen_types needed = let typs = aux needed in List.rev (Hashtbl.fold (fun id t acc -> if IntSet.mem id typs then - (infotype_to_entry id t)::acc + (infotype_to_entry sec id t)::acc else acc) types []) -let global_variable_to_entry acc id v = +let global_variable_to_entry sec acc id v = let var = { - variable_file_loc = v.gvar_file_loc; + variable_file_loc = translate_file_loc sec v.gvar_file_loc; variable_declaration = Some v.gvar_declaration; variable_external = Some v.gvar_external; variable_name = v.gvar_name; @@ -338,10 +348,10 @@ let function_parameter_to_entry f_id (acc,bcc) p = } in 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 f_id (acc,bcc) v id = +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 = v.lvar_file_loc; + variable_file_loc = translate_file_loc sec v.lvar_file_loc; variable_declaration = None; variable_external = None; variable_name = v.lvar_name; @@ -350,7 +360,7 @@ let rec local_variable_to_entry f_id (acc,bcc) v id = } in new_entry id (DW_TAG_variable var),(IntSet.add v.lvar_type acc,loc_list@bcc) -and scope_to_entry f_id acc sc id = +and scope_to_entry sec f_id acc sc id = let l_pc,h_pc = try let r = Hashtbl.find scope_ranges id in let lbl l = match l with @@ -367,27 +377,27 @@ and scope_to_entry 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 f_id) acc sc.scope_variables in + let vars,acc = mmap (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 f_id acc id = +and local_to_entry sec f_id acc id = match Hashtbl.find local_variables id with - | LocalVariable v -> local_variable_to_entry f_id acc v id - | Scope v -> scope_to_entry f_id acc v id + | LocalVariable v -> local_variable_to_entry sec f_id acc v id + | Scope v -> scope_to_entry sec f_id acc v id -let fun_scope_to_entries f_id acc id = +let fun_scope_to_entries sec f_id acc id = match id with | None -> [],acc | Some id -> let sc = Hashtbl.find local_variables id in (match sc with - | Scope sc ->mmap (local_to_entry f_id) acc sc.scope_variables + | Scope sc ->mmap (local_to_entry sec f_id) acc sc.scope_variables | _ -> assert false) -let function_to_entry (acc,bcc) id f = +let function_to_entry sec (acc,bcc) id f = let f_tag = { - subprogram_file_loc = f.fun_file_loc; + subprogram_file_loc = translate_file_loc sec f.fun_file_loc; subprogram_external = Some f.fun_external; subprogram_name = f.fun_name; subprogram_prototyped = true; @@ -399,24 +409,36 @@ let function_to_entry (acc,bcc) id f = let acc = match f.fun_return_type with Some s -> IntSet.add s acc | None -> acc in let f_entry = new_entry id (DW_TAG_subprogram f_tag) in let params,(acc,bcc) = mmap (function_parameter_to_entry f_id) (acc,bcc) f.fun_parameter in - let vars,(acc,bcc) = fun_scope_to_entries f_id (acc,bcc) f.fun_scope in + let vars,(acc,bcc) = fun_scope_to_entries sec f_id (acc,bcc) f.fun_scope in add_children f_entry (params@vars),(acc,bcc) -let definition_to_entry (acc,bcc) id t = +let definition_to_entry sec (acc,bcc) id t = match t with - | GlobalVariable g -> let e,acc = global_variable_to_entry acc id g in + | GlobalVariable g -> let e,acc = global_variable_to_entry sec acc id g in e,(acc,bcc) - | Function f -> function_to_entry (acc,bcc) id f - -let gen_defs () = - let defs,(typ,locs) = Hashtbl.fold (fun id t (acc,bcc) -> let t,bcc = definition_to_entry bcc id t in - t::acc,bcc) definitions ([],(IntSet.empty,[])) in - List.rev defs,typ,locs - -let gen_debug_info () : dw_entry * dw_locations= - let cp = { - compile_unit_name = !file_name; - } in - let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in - let defs,ty,locs = gen_defs () in - add_children cp ((gen_types ty) @ defs),locs + | Function f -> function_to_entry sec (acc,bcc) id f + +module StringMap = Map.Make(String) + +let gen_debug_info sec_name var_section : debug_entries = + let defs = Hashtbl.fold (fun id t acc -> + let s = match t with + | GlobalVariable _ -> var_section + | Function f -> sec_name (get_opt_val f.fun_atom) in + let old = try StringMap.find s acc with Not_found -> [] in + StringMap.add s ((id,t)::old) acc) definitions StringMap.empty in + StringMap.fold (fun s defs acc -> + let defs,(ty,locs) = List.fold_left (fun (acc,bcc) (id,t) -> + let t,bcc = definition_to_entry s bcc id t in + t::acc,bcc) ([],(IntSet.empty,[])) defs in + let line_start,low_pc,debug_start,_ = Hashtbl.find compilation_section_start s + and high_pc = Hashtbl.find compilation_section_end s in + let cp = { + compile_unit_name = !file_name; + compile_unit_low_pc = low_pc; + compile_unit_high_pc = high_pc; + compile_unit_stmt_list = line_start; + } in + let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in + let cp = add_children cp ((gen_types s ty) @ defs) in + (s,debug_start,cp,(low_pc,locs))::acc) defs [] -- cgit