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/Debug.ml | 15 ++++-- debug/Debug.mli | 10 +++- debug/DebugInformation.ml | 25 +++++++++- debug/DebugInit.ml | 14 ++++-- debug/DwarfPrinter.ml | 57 +++++++++++------------ debug/DwarfPrinter.mli | 2 +- debug/DwarfTypes.mli | 16 ++++--- debug/Dwarfgen.ml | 116 +++++++++++++++++++++++++++------------------- 8 files changed, 159 insertions(+), 96 deletions(-) (limited to 'debug') diff --git a/debug/Debug.ml b/debug/Debug.ml index d0de9e98..1d3b260e 100644 --- a/debug/Debug.ml +++ b/debug/Debug.ml @@ -30,7 +30,7 @@ type implem = mutable set_bitfield_offset: ident -> string -> int -> string -> int -> unit; mutable insert_global_declaration: Env.t -> globdecl -> unit; mutable add_fun_addr: atom -> (int * int) -> unit; - mutable generate_debug_info: unit -> (dw_entry * dw_locations) option; + mutable generate_debug_info: (atom -> string) -> string -> debug_entries option; mutable all_files_iter: (string -> unit) -> unit; mutable insert_local_declaration: storage -> ident -> typ -> location -> unit; mutable atom_local_variable: ident -> atom -> unit; @@ -45,6 +45,9 @@ type implem = mutable function_end: atom -> positive -> unit; mutable add_label: atom -> positive -> int -> unit; mutable atom_parameter: ident -> ident -> atom -> unit; + mutable add_compilation_section_start: string ->(int * int * int * string) -> unit; + mutable compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit; + mutable exists_section: string -> bool; } let implem = @@ -57,7 +60,7 @@ let implem = set_bitfield_offset = (fun _ _ _ _ _ -> ()); insert_global_declaration = (fun _ _ -> ()); add_fun_addr = (fun _ _ -> ()); - generate_debug_info = (fun _ -> None); + generate_debug_info = (fun _ _ -> None); all_files_iter = (fun _ -> ()); insert_local_declaration = (fun _ _ _ _ -> ()); atom_local_variable = (fun _ _ -> ()); @@ -72,6 +75,9 @@ let implem = function_end = (fun _ _ -> ()); add_label = (fun _ _ _ -> ()); atom_parameter = (fun _ _ _ -> ()); + add_compilation_section_start = (fun _ _ -> ()); + compute_file_enum = (fun _ _ _ -> ()); + exists_section = (fun _ -> true); } let init_compile_unit name = implem.init name @@ -82,7 +88,7 @@ let set_member_offset id field off = implem.set_member_offset id field off let set_bitfield_offset id field off underlying size = implem.set_bitfield_offset id field off underlying size let insert_global_declaration env dec = implem.insert_global_declaration env dec let add_fun_addr atom addr = implem.add_fun_addr atom addr -let generate_debug_info () = implem.generate_debug_info () +let generate_debug_info fun_s var_s = implem.generate_debug_info fun_s var_s let all_files_iter f = implem.all_files_iter f let insert_local_declaration sto id ty loc = implem.insert_local_declaration sto id ty loc let atom_local_variable id atom = implem.atom_local_variable id atom @@ -97,3 +103,6 @@ let stack_variable atom loc = implem.stack_variable atom loc let function_end atom loc = implem.function_end atom loc let add_label atom p lbl = implem.add_label atom p lbl let atom_parameter fid pid atom = implem.atom_parameter fid pid atom +let add_compilation_section_start sec addr = implem.add_compilation_section_start sec addr +let exists_section sec = implem.exists_section sec +let compute_file_enum end_l entry_l line_e = implem.compute_file_enum end_l entry_l line_e diff --git a/debug/Debug.mli b/debug/Debug.mli index c5fcddb3..166a6759 100644 --- a/debug/Debug.mli +++ b/debug/Debug.mli @@ -28,7 +28,7 @@ type implem = mutable set_bitfield_offset: ident -> string -> int -> string -> int -> unit; mutable insert_global_declaration: Env.t -> globdecl -> unit; mutable add_fun_addr: atom -> (int * int) -> unit; - mutable generate_debug_info: unit -> (dw_entry * dw_locations) option; + mutable generate_debug_info: (atom -> string) -> string -> debug_entries option; mutable all_files_iter: (string -> unit) -> unit; mutable insert_local_declaration: storage -> ident -> typ -> location -> unit; mutable atom_local_variable: ident -> atom -> unit; @@ -43,6 +43,9 @@ type implem = mutable function_end: atom -> positive -> unit; mutable add_label: atom -> positive -> int -> unit; mutable atom_parameter: ident -> ident -> atom -> unit; + mutable add_compilation_section_start: string -> (int * int * int * string) -> unit; + mutable compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit; + mutable exists_section: string -> bool; } val implem: implem @@ -68,5 +71,8 @@ val end_live_range: atom -> positive -> unit val stack_variable: atom -> int * int builtin_arg -> unit val function_end: atom -> positive -> unit val add_label: atom -> positive -> int -> unit -val generate_debug_info: unit -> (dw_entry * dw_locations) option +val generate_debug_info: (atom -> string) -> string -> debug_entries option val atom_parameter: ident -> ident -> atom -> unit +val add_compilation_section_start: string -> (int * int * int * string) -> unit +val compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit +val exists_section: string -> bool diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index 8b6ec1ad..7866c339 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -774,9 +774,28 @@ let function_end atom loc = List.iter (close_range loc) !open_vars; open_vars:= [] -let compilation_section_start: (string,int) Hashtbl.t = Hashtbl.create 7 +let compilation_section_start: (string,int * int * int * string) Hashtbl.t = Hashtbl.create 7 let compilation_section_end: (string,int) Hashtbl.t = Hashtbl.create 7 +let add_compilation_section_start sec addr = + Hashtbl.add compilation_section_start sec addr + +let add_compilation_section_end sec addr = + Hashtbl.add compilation_section_end sec addr + +let exists_section sec = + Hashtbl.mem compilation_section_start sec + +let filenum: (string * string,int) Hashtbl.t = Hashtbl.create 7 + +let compute_file_enum end_label entry_label line_end = + Hashtbl.iter (fun sec (_,_,_,secname) -> + Hashtbl.add compilation_section_end sec (end_label secname); + StringSet.iter (fun file -> + let lbl = entry_label file in + Hashtbl.add filenum (sec,file) lbl) !all_files; + line_end ()) compilation_section_start + let init name = id := 0; file_name := name; @@ -790,4 +809,6 @@ let init name = Hashtbl.reset atom_to_local; Hashtbl.reset scope_to_local; Hashtbl.reset compilation_section_start; - Hashtbl.reset compilation_section_end + Hashtbl.reset compilation_section_end; + Hashtbl.reset filenum; + all_files := StringSet.empty diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml index 17db4354..e0c435cd 100644 --- a/debug/DebugInit.ml +++ b/debug/DebugInit.ml @@ -27,7 +27,7 @@ let init_debug () = implem.set_bitfield_offset <- DebugInformation.set_bitfield_offset; implem.insert_global_declaration <- DebugInformation.insert_global_declaration; implem.add_fun_addr <- DebugInformation.add_fun_addr; - implem.generate_debug_info <- (fun () -> Some (Dwarfgen.gen_debug_info ())); + implem.generate_debug_info <- (fun a b -> Some (Dwarfgen.gen_debug_info a b)); implem.all_files_iter <- (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files); implem.insert_local_declaration <- DebugInformation.insert_local_declaration; implem.atom_local_variable <- DebugInformation.atom_local_variable; @@ -41,7 +41,10 @@ let init_debug () = implem.stack_variable <- DebugInformation.stack_variable; implem.function_end <- DebugInformation.function_end; implem.add_label <- DebugInformation.add_label; - implem.atom_parameter <- DebugInformation.atom_parameter + implem.atom_parameter <- DebugInformation.atom_parameter; + implem.add_compilation_section_start <- DebugInformation.add_compilation_section_start; + implem.compute_file_enum <- DebugInformation.compute_file_enum; + implem.exists_section <- DebugInformation.exists_section let init_none () = implem.init <- (fun _ -> ()); @@ -52,7 +55,7 @@ let init_none () = implem.set_bitfield_offset <- (fun _ _ _ _ _ -> ()); implem.insert_global_declaration <- (fun _ _ -> ()); implem.add_fun_addr <- (fun _ _ -> ()); - implem.generate_debug_info <- (fun _ -> None); + implem.generate_debug_info <- (fun _ _ -> None); implem.all_files_iter <- (fun _ -> ()); implem.insert_local_declaration <- (fun _ _ _ _ -> ()); implem.atom_local_variable <- (fun _ _ -> ()); @@ -66,8 +69,9 @@ let init_none () = implem.stack_variable <- (fun _ _ -> ()); implem.function_end <- (fun _ _ -> ()); implem.add_label <- (fun _ _ _ -> ()); - implem.atom_parameter <- (fun _ _ _ -> ()) - + implem.atom_parameter <- (fun _ _ _ -> ()); + implem.add_compilation_section_start <- (fun _ _ -> ()); + implem.exists_section <- (fun _ -> true) let init () = if !Clflags.option_g then diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 32c15dfd..aa1c187f 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -21,7 +21,7 @@ open Sections (* The printer is parameterized over target specific functions and a set of dwarf type constants *) module DwarfPrinter(Target: DWARF_TARGET): sig - val print_debug: out_channel -> dw_entry -> dw_locations -> unit + val print_debug: out_channel -> debug_entries -> unit end = struct @@ -245,7 +245,7 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_abbrev oc = let abbrevs = Hashtbl.fold (fun s i acc -> (s,i)::acc) abbrev_mapping [] in let abbrevs = List.sort (fun (_,a) (_,b) -> Pervasives.compare a b) abbrevs in - fprintf oc " .section %s\n" (name_of_section Section_debug_abbrev); + section oc Section_debug_abbrev; let lbl = new_label () in abbrev_start_addr := lbl; print_label oc lbl; @@ -275,9 +275,6 @@ module DwarfPrinter(Target: DWARF_TARGET): | None -> () | Some o -> f oc o - let print_file_loc oc f = - print_opt_value oc f print_file_loc - let print_flag oc b = output_string oc (string_of_byte b) @@ -296,6 +293,15 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_2byte oc b = fprintf oc " .2byte 0x%X\n" b + let print_ref oc r = + let ref = entry_to_label r in + fprintf oc " .4byte %a\n" label ref + + let print_file_loc oc = function + | Some (file,col) -> + fprintf oc " .4byte %a\n" label file; + print_uleb128 oc col + | None -> () let size_of_loc_expr = function | DW_OP_bregx _ -> 3 @@ -322,11 +328,6 @@ module DwarfPrinter(Target: DWARF_TARGET): print_uleb128 oc i end - - let print_ref oc r = - let ref = entry_to_label r in - fprintf oc " .4byte %a\n" label ref - let print_loc oc loc = match loc with | LocSymbol s -> @@ -394,12 +395,12 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_compilation_unit oc tag = let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:%s" Version.version Configuration.arch in print_string oc (Sys.getcwd ()); - print_addr oc (get_start_addr ()); - print_addr oc (get_end_addr ()); + print_addr oc tag.compile_unit_low_pc; + print_addr oc tag.compile_unit_high_pc; print_uleb128 oc 1; print_string oc tag.compile_unit_name; print_string oc prod_name; - print_addr oc (get_stmt_list_addr ()) + print_addr oc tag.compile_unit_stmt_list let print_const_type oc ct = print_ref oc ct.const_type @@ -539,16 +540,15 @@ module DwarfPrinter(Target: DWARF_TARGET): print_sleb128 oc 0) entry (* Print the debug abbrev section *) - let print_debug_abbrev oc entry = - compute_abbrev entry; + let print_debug_abbrev oc entries = + List.iter (fun (_,_,e,_) -> compute_abbrev e) entries; print_abbrev oc (* Print the debug info section *) - let print_debug_info oc entry = - let debug_start = new_label () in - debug_start_addr:= debug_start; - fprintf oc" .section %s\n" (name_of_section Section_debug_info); - print_label oc debug_start; + let print_debug_info oc sec start entry = + debug_start_addr:= start; + section oc (Section_debug_info sec); + print_label oc start; let debug_length_start = new_label () (* Address used for length calculation *) and debug_end = new_label () in fprintf oc " .4byte %a-%a\n" label debug_end label debug_length_start; @@ -560,8 +560,7 @@ module DwarfPrinter(Target: DWARF_TARGET): print_sleb128 oc 0; print_label oc debug_end (* End of the debug section *) - let print_location_entry oc l = - let c_low = get_start_addr () in + let print_location_entry oc c_low l = print_label oc (entry_to_label l.loc_id); List.iter (fun (b,e,loc) -> fprintf oc " .4byte %a-%a\n" label b label c_low; @@ -570,15 +569,15 @@ module DwarfPrinter(Target: DWARF_TARGET): fprintf oc " .4byte 0\n"; fprintf oc " .4byte 0\n" - let print_location_list oc l = - fprintf oc" .section %s\n" (name_of_section Section_debug_loc); - List.iter (print_location_entry oc) l + let print_location_list oc (c_low,l) = + List.iter (print_location_entry oc c_low) l (* Print the debug info and abbrev section *) - let print_debug oc entry loc = - print_debug_abbrev oc entry; - print_debug_info oc entry; - print_location_list oc loc + let print_debug oc entries = + print_debug_abbrev oc entries; + List.iter (fun (s,d,e,_) -> print_debug_info oc s d e) entries; + section oc Section_debug_loc; + List.iter (fun (_,_,_,l) -> print_location_list oc l) entries end diff --git a/debug/DwarfPrinter.mli b/debug/DwarfPrinter.mli index 8b206a00..e1e10601 100644 --- a/debug/DwarfPrinter.mli +++ b/debug/DwarfPrinter.mli @@ -14,5 +14,5 @@ open DwarfTypes module DwarfPrinter: functor (Target: DWARF_TARGET) -> sig - val print_debug: out_channel -> dw_entry -> dw_locations -> unit + val print_debug: out_channel -> debug_entries -> unit end diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index 8c2a7d56..906b7cba 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -60,7 +60,7 @@ type bound_value = (* Types representing the attribute information per tag value *) -type file_loc = string * constant +type file_loc = int * constant type dw_tag_array_type = { @@ -77,7 +77,10 @@ type dw_tag_base_type = type dw_tag_compile_unit = { - compile_unit_name: string; + compile_unit_name: string; + compile_unit_low_pc: int; + compile_unit_high_pc: int; + compile_unit_stmt_list: int; } type dw_tag_const_type = @@ -243,16 +246,15 @@ type location_entry = loc: (int * int * location_value) list; loc_id: reference; } -type dw_locations = location_entry list +type dw_locations = int * location_entry list + +type debug_entries = (string * int * dw_entry * dw_locations) list (* The target specific functions for printing the debug information *) module type DWARF_TARGET= sig val label: out_channel -> int -> unit val print_file_loc: out_channel -> file_loc -> unit - val get_start_addr: unit -> int - val get_end_addr: unit -> int - val get_stmt_list_addr: unit -> int - val name_of_section: section_name -> string + val section: out_channel -> section_name -> unit val symbol: out_channel -> atom -> unit end 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