diff options
Diffstat (limited to 'debug')
| -rw-r--r-- | debug/Debug.ml | 16 | ||||
| -rw-r--r-- | debug/Debug.mli | 12 | ||||
| -rw-r--r-- | debug/DebugInformation.ml | 12 | ||||
| -rw-r--r-- | debug/DebugInit.ml | 17 | ||||
| -rw-r--r-- | debug/DwarfPrinter.ml | 57 | ||||
| -rw-r--r-- | debug/DwarfTypes.mli | 14 | ||||
| -rw-r--r-- | debug/Dwarfgen.ml | 43 |
7 files changed, 95 insertions, 76 deletions
diff --git a/debug/Debug.ml b/debug/Debug.ml index 14176d3b..87d04ad7 100644 --- a/debug/Debug.ml +++ b/debug/Debug.ml @@ -29,7 +29,7 @@ type implem = set_member_offset: ident -> string -> int -> unit; set_bitfield_offset: ident -> string -> int -> string -> int -> unit; insert_global_declaration: Env.t -> globdecl -> unit; - add_fun_addr: atom -> (int * int) -> unit; + add_fun_addr: atom -> section_name -> (int * int) -> unit; generate_debug_info: (atom -> string) -> string -> debug_entries option; all_files_iter: (string -> unit) -> unit; insert_local_declaration: storage -> ident -> typ -> location -> unit; @@ -44,14 +44,12 @@ type implem = stack_variable: (atom * atom) -> int * int builtin_arg -> unit; add_label: atom -> positive -> int -> unit; atom_parameter: ident -> ident -> atom -> unit; - add_compilation_section_start: section_name -> int -> unit; - add_compilation_section_end: section_name -> int -> unit; compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit; compute_gnu_file_enum: (string -> unit) -> unit; exists_section: section_name -> bool; remove_unused: ident -> unit; variable_printed: string -> unit; - add_diab_info: section_name -> int -> int -> unit; + add_diab_info: section_name -> int -> int -> int -> unit; } let default_implem = @@ -62,7 +60,7 @@ let default_implem = set_member_offset = (fun _ _ _ -> ()); set_bitfield_offset = (fun _ _ _ _ _ -> ()); insert_global_declaration = (fun _ _ -> ()); - add_fun_addr = (fun _ _ -> ()); + add_fun_addr = (fun _ _ _ -> ()); generate_debug_info = (fun _ _ -> None); all_files_iter = (fun _ -> ()); insert_local_declaration = (fun _ _ _ _ -> ()); @@ -77,14 +75,12 @@ let default_implem = stack_variable = (fun _ _ -> ()); add_label = (fun _ _ _ -> ()); atom_parameter = (fun _ _ _ -> ()); - add_compilation_section_start = (fun _ _ -> ()); - add_compilation_section_end = (fun _ _ -> ()); compute_diab_file_enum = (fun _ _ _ -> ()); compute_gnu_file_enum = (fun _ -> ()); exists_section = (fun _ -> true); remove_unused = (fun _ -> ()); variable_printed = (fun _ -> ()); - add_diab_info = (fun _ _ _ -> ()); + add_diab_info = (fun _ _ _ _ -> ()); } let implem = ref default_implem @@ -110,11 +106,9 @@ let end_live_range atom lbl = !implem.end_live_range atom lbl let stack_variable atom loc = !implem.stack_variable 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 add_compilation_section_end sec addr = !implem.add_compilation_section_end sec addr let exists_section sec = !implem.exists_section sec let compute_diab_file_enum end_l entry_l line_e = !implem.compute_diab_file_enum end_l entry_l line_e let compute_gnu_file_enum f = !implem.compute_gnu_file_enum f let remove_unused ident = !implem.remove_unused ident let variable_printed ident = !implem.variable_printed ident -let add_diab_info sec addr = !implem.add_diab_info sec addr +let add_diab_info sec line_start debug_info low_pc = !implem.add_diab_info sec line_start debug_info low_pc diff --git a/debug/Debug.mli b/debug/Debug.mli index 83d5703b..1585e7e4 100644 --- a/debug/Debug.mli +++ b/debug/Debug.mli @@ -27,7 +27,7 @@ type implem = set_member_offset: ident -> string -> int -> unit; set_bitfield_offset: ident -> string -> int -> string -> int -> unit; insert_global_declaration: Env.t -> globdecl -> unit; - add_fun_addr: atom -> (int * int) -> unit; + add_fun_addr: atom -> section_name -> (int * int) -> unit; generate_debug_info: (atom -> string) -> string -> debug_entries option; all_files_iter: (string -> unit) -> unit; insert_local_declaration: storage -> ident -> typ -> location -> unit; @@ -42,14 +42,12 @@ type implem = stack_variable: (atom * atom) -> int * int builtin_arg -> unit; add_label: atom -> positive -> int -> unit; atom_parameter: ident -> ident -> atom -> unit; - add_compilation_section_start: section_name -> int -> unit; - add_compilation_section_end: section_name -> int -> unit; compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit; compute_gnu_file_enum: (string -> unit) -> unit; exists_section: section_name -> bool; remove_unused: ident -> unit; variable_printed: string -> unit; - add_diab_info: section_name -> int -> int -> unit; + add_diab_info: section_name -> int -> int -> int -> unit; } val default_implem: implem @@ -62,7 +60,7 @@ val set_composite_size: ident -> struct_or_union -> int option -> unit val set_member_offset: ident -> string -> int -> unit val set_bitfield_offset: ident -> string -> int -> string -> int -> unit val insert_global_declaration: Env.t -> globdecl -> unit -val add_fun_addr: atom -> (int * int) -> unit +val add_fun_addr: atom -> section_name -> (int * int) -> unit val all_files_iter: (string -> unit) -> unit val insert_local_declaration: storage -> ident -> typ -> location -> unit val atom_local_variable: ident -> atom -> unit @@ -77,11 +75,9 @@ val stack_variable: (atom * atom) -> int * int builtin_arg -> unit val add_label: atom -> positive -> int -> unit val generate_debug_info: (atom -> string) -> string -> debug_entries option val atom_parameter: ident -> ident -> atom -> unit -val add_compilation_section_start: section_name -> int -> unit -val add_compilation_section_end: section_name -> int -> unit val compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit val compute_gnu_file_enum: (string -> unit) -> unit val exists_section: section_name -> bool val remove_unused: ident -> unit val variable_printed: string -> unit -val add_diab_info: section_name -> int -> int -> unit +val add_diab_info: section_name -> int -> int -> int -> unit diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index 95f34b1d..51fbfde9 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -593,10 +593,20 @@ let add_compilation_section_end sec addr = let sec = section_to_string sec in Hashtbl.add compilation_section_end sec addr -let add_diab_info sec addr1 add2 = +let add_diab_info sec addr1 add2 addr3 = let sec' = section_to_string sec in + Hashtbl.add compilation_section_start sec' addr3; Hashtbl.add diab_additional sec' (addr1,add2,sec) +let diab_add_fun_addr name _ addr = add_fun_addr name addr + +let gnu_add_fun_addr name sec (high,low) = + let sec = section_to_string sec in + if not (Hashtbl.mem compilation_section_start sec) then + Hashtbl.add compilation_section_start sec low; + Hashtbl.replace compilation_section_end sec high; + add_fun_addr name (high,low) + let exists_section sec = Hashtbl.mem compilation_section_start (section_to_string sec) diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml index 209f2024..b4240af7 100644 --- a/debug/DebugInit.ml +++ b/debug/DebugInit.ml @@ -26,7 +26,7 @@ let default_debug = set_member_offset = DebugInformation.set_member_offset; set_bitfield_offset = DebugInformation.set_bitfield_offset; insert_global_declaration = DebugInformation.insert_global_declaration; - add_fun_addr = DebugInformation.add_fun_addr; + add_fun_addr = (fun _ _ _ -> ()); generate_debug_info = (fun _ _ -> None); all_files_iter = (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files); insert_local_declaration = DebugInformation.insert_local_declaration; @@ -41,23 +41,24 @@ let default_debug = stack_variable = DebugInformation.stack_variable; add_label = DebugInformation.add_label; atom_parameter = DebugInformation.atom_parameter; - add_compilation_section_start = DebugInformation.add_compilation_section_start; - add_compilation_section_end = DebugInformation.add_compilation_section_end; compute_diab_file_enum = DebugInformation.compute_diab_file_enum; compute_gnu_file_enum = DebugInformation.compute_gnu_file_enum; exists_section = DebugInformation.exists_section; remove_unused = DebugInformation.remove_unused; variable_printed = DebugInformation.variable_printed; - add_diab_info = DebugInformation.add_diab_info; + add_diab_info = (fun _ _ _ _ -> ()); } let init_debug () = - let gen = + implem := if Configuration.system = "diab" then - (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b)) + let gen = (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b)) in + {default_debug with generate_debug_info = gen; + add_diab_info = DebugInformation.add_diab_info; + add_fun_addr = DebugInformation.diab_add_fun_addr;} else - (fun a b -> Some (Dwarfgen.gen_gnu_debug_info a b)) in - implem := {default_debug with generate_debug_info = gen;} + {default_debug with generate_debug_info = (fun a b -> Some (Dwarfgen.gen_gnu_debug_info a b)); + add_fun_addr = DebugInformation.gnu_add_fun_addr} let init_none () = implem := default_implem diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index abed6a91..afa4799e 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -91,7 +91,13 @@ module DwarfPrinter(Target: DWARF_TARGET): | Some (LocSymbol _) | Some (LocSimple _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_block) buf - + let add_range buf = function + | Pc_pair _ -> + add_abbr_entry (0x11,"DW_AT_low_pc",DW_FORM_addr) buf; + add_abbr_entry (0x12,"DW_AT_high_pc",DW_FORM_addr) buf + | Offset _ -> + add_abbr_entry (0x55,"DW_AT_ranges",DW_FORM_data4) buf + | Empty -> () (* Dwarf entity to string function *) let abbrev_string_of_entity entity has_sibling = @@ -120,8 +126,7 @@ module DwarfPrinter(Target: DWARF_TARGET): | DW_TAG_compile_unit e -> prologue 0x11 "DW_TAG_compile_unit"; add_string buf 0x1b "DW_AT_comp_dir" e.compile_unit_dir; - add_low_pc buf; - add_high_pc buf; + add_range buf e.compile_unit_range; add_abbr_entry (0x13,"DW_AT_language",DW_FORM_udata) buf; add_name buf e.compile_unit_name; add_string buf 0x25 "DW_AT_producer" e.compile_unit_prod_name; @@ -152,8 +157,7 @@ module DwarfPrinter(Target: DWARF_TARGET): add_name buf e.label_name; | DW_TAG_lexical_block a -> prologue 0xb "DW_TAG_lexical_block"; - add_attr_some a.lexical_block_high_pc add_high_pc; - add_attr_some a.lexical_block_low_pc add_low_pc + add_range buf a.lexical_block_range; | DW_TAG_member e -> prologue 0xd "DW_TAG_member"; add_attr_some e.member_byte_size add_byte_size; @@ -179,8 +183,7 @@ module DwarfPrinter(Target: DWARF_TARGET): prologue 0x2e "DW_TAG_subprogram"; add_file_loc buf; add_attr_some e.subprogram_external (add_abbr_entry (0x3f,"DW_AT_external",DW_FORM_flag)); - add_attr_some e.subprogram_low_pc add_low_pc; - add_attr_some e.subprogram_high_pc add_high_pc; + add_range buf e.subprogram_range; add_name buf e.subprogram_name; add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf; add_attr_some e.subprogram_type add_type; @@ -418,10 +421,15 @@ module DwarfPrinter(Target: DWARF_TARGET): | None -> ()); print_string oc "DW_AT_name" bt.base_type_name + let print_range oc = function + | Pc_pair (l,h) -> + print_addr oc "DW_AT_low_pc" l; + print_addr oc "DW_AT_high_pc" h + | _ -> () + let print_compilation_unit oc tag = print_string oc "DW_AT_comp_dir" tag.compile_unit_dir; - print_addr oc "DW_AT_low_pc" tag.compile_unit_low_pc; - print_addr oc "DW_AT_high_pc" tag.compile_unit_high_pc; + print_range oc tag.compile_unit_range; print_uleb128 oc "DW_AT_language" 1; print_string oc "DW_AT_name" tag.compile_unit_name; print_string oc "DW_AT_producer" tag.compile_unit_prod_name; @@ -453,8 +461,7 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_lexical_block oc lb = - print_opt_value oc "DW_AT_high_pc" lb.lexical_block_high_pc print_addr; - print_opt_value oc "DW_AT_low_pc" lb.lexical_block_low_pc print_addr + print_range oc lb.lexical_block_range let print_member oc mb = print_opt_value oc "DW_AT_byte_size" mb.member_byte_size print_byte; @@ -475,15 +482,11 @@ module DwarfPrinter(Target: DWARF_TARGET): print_opt_value oc "DW_AT_declaration" st.structure_declaration print_flag; print_opt_value oc "DW_AT_name" st.structure_name print_string - let print_subprogram_addr oc (s,e) = - fprintf oc " .4byte %a\n" label e; - fprintf oc " .4byte %a\n" label s let print_subprogram oc sp = print_file_loc oc (Some sp.subprogram_file_loc); print_opt_value oc "DW_AT_external" sp.subprogram_external print_flag; - print_opt_value oc "DW_AT_low_pc" sp.subprogram_low_pc print_addr; - print_opt_value oc "DW_AT_high_pc" sp.subprogram_high_pc print_addr; + print_range oc sp.subprogram_range; print_string oc "DW_AT_name" sp.subprogram_name; print_flag oc "DW_AT_prototyped" sp.subprogram_prototyped; print_opt_value oc "DW_AT_type" sp.subprogram_type print_ref @@ -602,6 +605,11 @@ module DwarfPrinter(Target: DWARF_TARGET): | None -> print_location_entry_abs oc in List.iter f l + let list_opt l f = + match l with + | [] -> () + | _ -> f () + let print_diab_entries oc entries = let abbrev_start = new_label () in abbrev_start_addr := abbrev_start; @@ -614,7 +622,8 @@ module DwarfPrinter(Target: DWARF_TARGET): section oc Section_debug_loc; List.iter (fun e -> print_location_list oc e.locs) entries - let print_gnu_entries oc cp loc s = + + let print_gnu_entries oc cp (lpc,loc) s = compute_abbrev cp; let line_start = new_label () and start = new_label () @@ -623,14 +632,16 @@ module DwarfPrinter(Target: DWARF_TARGET): section oc (Section_debug_info None); print_debug_info oc start line_start cp; print_abbrev oc; - section oc Section_debug_loc; - print_location_list oc loc; + list_opt loc (fun () -> + section oc Section_debug_loc; + print_location_list oc (lpc,loc)); section oc (Section_debug_line None); print_label oc line_start; - section oc Section_debug_str; - List.iter (fun (id,s) -> - print_label oc (loc_to_label id); - fprintf oc " .asciz \"%s\"\n" s) s + list_opt s (fun () -> + section oc Section_debug_str; + List.iter (fun (id,s) -> + print_label oc (loc_to_label id); + fprintf oc " .asciz \"%s\"\n" s) s) (* Print the debug info and abbrev section *) diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index fb1725d9..ff895623 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -87,6 +87,11 @@ type dw_form = | DW_FORM_ref_udata | DW_FORM_ref_indirect +type dw_range = + | Pc_pair of reference * reference (* Simple low,high pc *) + | Offset of reference * constant (* DWARF 3 version for different range *) + | Empty (* Needed for compilation units only containing variables *) + (* Types representing the attribute information per tag value *) type dw_tag_array_type = @@ -104,8 +109,7 @@ type dw_tag_base_type = type dw_tag_compile_unit = { compile_unit_name: string_const; - compile_unit_low_pc: constant; - compile_unit_high_pc: constant; + compile_unit_range: dw_range; compile_unit_dir: string_const; compile_unit_prod_name: string_const; } @@ -146,8 +150,7 @@ type dw_tag_label = type dw_tag_lexical_block = { - lexical_block_high_pc: address option; - lexical_block_low_pc: address option; + lexical_block_range: dw_range; } type dw_tag_member = @@ -181,8 +184,7 @@ type dw_tag_subprogram = subprogram_name: string_const; subprogram_prototyped: flag; subprogram_type: reference option; - subprogram_high_pc: reference option; - subprogram_low_pc: reference option; + subprogram_range: dw_range; } type dw_tag_subrange_type = diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 1ef3938a..980c8a34 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -386,21 +386,23 @@ module Dwarfgenaux (Target: TARGET) = Some (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 = - let l_pc,h_pc = try + let r = try let r = Hashtbl.find scope_ranges id in - let lbl l = match l with - | Some l -> Some (Hashtbl.find label_translation (f_id,l)) - | None -> None in + let lbl l h = match l,h with + | Some l,Some h-> + let l = (Hashtbl.find label_translation (f_id,l)) + and h = (Hashtbl.find label_translation (f_id,h)) in + Pc_pair(l,h) + | _ -> Empty in begin match r with - | [] -> None,None - | [a] -> lbl a.start_addr, lbl a.end_addr - | a::rest -> lbl (List.hd (List.rev rest)).start_addr,lbl a.end_addr + | [] -> Empty + | [a] -> lbl a.start_addr a.end_addr + | a::rest -> lbl (List.hd (List.rev rest)).start_addr a.end_addr end - with Not_found -> None,None in + with Not_found -> Empty in let scope = { - lexical_block_high_pc = h_pc; - lexical_block_low_pc = l_pc; + lexical_block_range = r; } in let vars,acc = mmap_opt (local_to_entry f_id) acc sc.scope_variables in let entry = new_entry id (DW_TAG_lexical_block scope) in @@ -423,14 +425,16 @@ module Dwarfgenaux (Target: TARGET) = | _ -> assert false) let function_to_entry (acc,bcc) id f = + let r = match f.fun_low_pc, f.fun_high_pc with + | Some l,Some h -> Pc_pair (l,h) + | _ -> Empty in let f_tag = { subprogram_file_loc = file_loc f.fun_file_loc; subprogram_external = Some f.fun_external; subprogram_name = string_entry f.fun_name; subprogram_prototyped = true; subprogram_type = f.fun_return_type; - subprogram_high_pc = f.fun_high_pc; - subprogram_low_pc = f.fun_low_pc; + subprogram_range = r; } in let f_id = get_opt_val f.fun_atom in let acc = match f.fun_return_type with Some s -> IntSet.add s acc | None -> acc in @@ -473,8 +477,7 @@ let diab_gen_compilation_section s defs acc = and high_pc = Hashtbl.find compilation_section_end s in let cp = { compile_unit_name = Simple_string !file_name; - compile_unit_low_pc = low_pc; - compile_unit_high_pc = high_pc; + compile_unit_range = Pc_pair (low_pc,high_pc); compile_unit_dir = Simple_string (Sys.getcwd ()); compile_unit_prod_name = Simple_string prod_name } in @@ -515,8 +518,11 @@ let gnu_string_entry s = Offset_string id let gen_gnu_debug_info sec_name var_section : debug_entries = - let low_pc = Hashtbl.find compilation_section_start ".text" - and high_pc = Hashtbl.find compilation_section_end ".text" in + let r,low_pc = try + let low_pc = Hashtbl.find compilation_section_start ".text" + and high_pc = Hashtbl.find compilation_section_end ".text" in + Pc_pair (low_pc,high_pc),Some low_pc + with Not_found -> Empty,None in let module Gen = Dwarfgenaux (struct let file_loc = gnu_file_loc let string_entry = gnu_string_entry @@ -530,13 +536,12 @@ let gen_gnu_debug_info sec_name var_section : debug_entries = let types = Gen.gen_types ty in let cp = { compile_unit_name = gnu_string_entry !file_name; - compile_unit_low_pc = low_pc; - compile_unit_high_pc = high_pc; + compile_unit_range = r; compile_unit_dir = gnu_string_entry (Sys.getcwd ()); compile_unit_prod_name = gnu_string_entry prod_name; } in let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in let cp = add_children cp (types@defs) in - let loc_pc = if StringSet.cardinal sec > 1 then None else Some low_pc in + let loc_pc = if StringSet.cardinal sec > 1 then None else low_pc in let string_table = Hashtbl.fold (fun s i acc -> (i,s)::acc) string_table [] in Gnu (cp,(loc_pc,locs),string_table) |