diff options
| -rw-r--r-- | Makefile | 1 | ||||
| -rw-r--r-- | arm/TargetPrinter.ml | 6 | ||||
| -rw-r--r-- | backend/PrintAsm.ml | 7 | ||||
| -rw-r--r-- | backend/PrintAsmaux.ml | 5 | ||||
| -rw-r--r-- | checklink/Check.ml | 4 | ||||
| -rwxr-xr-x | configure | 5 | ||||
| -rw-r--r-- | debug/DwarfPrinter.ml | 358 | ||||
| -rw-r--r-- | debug/DwarfTypes.ml | 88 | ||||
| -rw-r--r-- | debug/DwarfUtil.ml | 3 | ||||
| -rw-r--r-- | driver/Configuration.ml | 6 | ||||
| -rw-r--r-- | ia32/TargetPrinter.ml | 6 | ||||
| -rw-r--r-- | powerpc/TargetPrinter.ml | 12 |
12 files changed, 343 insertions, 158 deletions
@@ -203,6 +203,7 @@ compcert.ini: Makefile.config VERSION echo "system=$(SYSTEM)"; \ echo "has_runtime_lib=$(HAS_RUNTIME_LIB)"; \ echo "asm_supports_cfi=$(ASM_SUPPORTS_CFI)"; \ + echo "advanced_debug=$(ADVANCED_DEBUG)"; \ version=`cat VERSION`; \ echo version=$$version) \ > compcert.ini diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml index 7c8c373c..ee33353b 100644 --- a/arm/TargetPrinter.ml +++ b/arm/TargetPrinter.ml @@ -1128,6 +1128,12 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = let get_end_addr () = -1 (* Dummy constant *) let get_stmt_list_addr () = -1 (* Dummy constant *) + + module DwarfAbbrevs = DwarfUtil.DefaultAbbrevs (* Dummy Abbrev types *) + + let label = print_label + + let new_label = new_label end let sel_target () = diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml index a48bd910..a394cf8e 100644 --- a/backend/PrintAsm.ml +++ b/backend/PrintAsm.ml @@ -99,4 +99,9 @@ let print_program oc p = Target.print_prologue oc; List.iter (Printer.print_globdef oc) p.prog_defs; Target.print_epilogue oc; - PrintAnnot.close_filenames () + PrintAnnot.close_filenames (); + if !Clflags.option_g && Configuration.advanced_debug then + begin + let module DebugPrinter = DwarfPrinter(Target) in + () + end diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index aa0f4214..8bc961ef 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -14,6 +14,7 @@ open AST open Asm open Camlcoq +open DwarfTypes open Datatypes open Printf open Sections @@ -46,6 +47,10 @@ module type TARGET = val get_start_addr: unit -> int val get_end_addr: unit -> int val get_stmt_list_addr: unit -> int + val new_label: unit -> int + val label: out_channel -> int -> unit + val print_file_loc: out_channel -> file_loc -> unit + module DwarfAbbrevs: DWARF_ABBREVS end (* On-the-fly label renaming *) diff --git a/checklink/Check.ml b/checklink/Check.ml index db0159c4..4924744c 100644 --- a/checklink/Check.ml +++ b/checklink/Check.ml @@ -75,6 +75,8 @@ let name_of_section_Linux: section_name -> string = function | Section_literal -> ".rodata.cst8" | Section_jumptable -> ".text" | Section_user(s, wr, ex) -> s +| Section_debug_info -> ".debug_info" +| Section_debug_abbrev -> ".debug_abbrev" (** Adapted from CompCert *) let name_of_section_Diab: section_name -> string = function @@ -87,6 +89,8 @@ let name_of_section_Diab: section_name -> string = function | Section_literal -> ".text" | Section_jumptable -> ".text" | Section_user(s, wr, ex) -> s +| Section_debug_info -> ".debug_info" +| Section_debug_abbrev -> ".debug_abbrev" (** Taken from CompCert *) let name_of_section: section_name -> string = @@ -19,6 +19,7 @@ toolprefix='' target='' has_runtime_lib=true build_checklink=true +advanced_debug=false usage='Usage: ./configure [options] target @@ -104,7 +105,8 @@ case "$target" in asm_supports_cfi=false clinker="${toolprefix}dcc" libmath="-lm" - cchecklink=${build_checklink};; + cchecklink=${build_checklink} + advanced_debug=true;; arm*-*) arch="arm" case "$target" in @@ -336,6 +338,7 @@ LIBMATH=$libmath HAS_RUNTIME_LIB=$has_runtime_lib CCHECKLINK=$cchecklink ASM_SUPPORTS_CFI=$asm_supports_cfi +ADVANCED_DEBUG=$advanced_debug EOF else cat >> Makefile.config <<'EOF' diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index b3d554dc..4f79584f 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -14,102 +14,104 @@ open DwarfTypes open DwarfUtil open Printf +open PrintAsmaux +open Sections -module DwarfPrinter : +module DwarfPrinter(Target: TARGET) : sig val print_debug: out_channel -> dw_entry -> unit end = struct - - - module Defs = DefaultAbbrevs - - let string_of_abbrv_entry v = - Printf.sprintf " .uleb128 %d\n" v + + open Target let string_of_byte value = - Printf.sprintf " .byte %s\n" (if value then "0x1" else "0x2") + sprintf " .byte %s\n" (if value then "0x1" else "0x0") - let curr_abbrv = ref 0 + let print_label oc lbl = + fprintf oc "%a:\n" label lbl + + let curr_abbrev = ref 1 - let next_abbrv = - let abbrv = !curr_abbrv in - incr curr_abbrv;abbrv + let next_abbrev = + let abbrev = !curr_abbrev in + incr curr_abbrev;abbrev let abbrevs: (string * int) list ref = ref [] - let abbrv_mapping: (string,int) Hashtbl.t = Hashtbl.create 7 + let abbrev_mapping: (string,int) Hashtbl.t = Hashtbl.create 7 let add_byte buf value = Buffer.add_string buf (string_of_byte value) let add_abbr_uleb v buf = - Buffer.add_string buf (string_of_abbrv_entry v) + Buffer.add_string buf (Printf.sprintf " .uleb128 %d\n" v) let add_abbr_entry (v1,v2) buf = add_abbr_uleb v1 buf; add_abbr_uleb v2 buf - let add_sibling = add_abbr_entry (0x1,Defs.sibling_type_abbr) - - let add_decl_file = add_abbr_entry (0x3a,Defs.decl_file_type_abbr) + let add_sibling = add_abbr_entry (0x1,DwarfAbbrevs.sibling_type_abbr) - let add_decl_line = add_abbr_entry (0x3b,Defs.decl_line_type_abbr) + let add_file_loc buf = + let file,line = DwarfAbbrevs.file_loc_type_abbr in + add_abbr_entry (0x3a,file) buf; + add_abbr_entry (0x3b,line) buf - let add_type = add_abbr_entry (0x49,Defs.type_abbr) + let add_type = add_abbr_entry (0x49,DwarfAbbrevs.type_abbr) - let add_name = add_abbr_entry (0x3,Defs.name_type_abbr) + let add_name = add_abbr_entry (0x3,DwarfAbbrevs.name_type_abbr) - let add_encoding = add_abbr_entry (0x3e,Defs.encoding_type_abbr) + let add_encoding = add_abbr_entry (0x3e,DwarfAbbrevs.encoding_type_abbr) - let add_byte_size = add_abbr_entry (0xb,Defs.byte_size_type_abbr) + let add_byte_size = add_abbr_entry (0xb,DwarfAbbrevs.byte_size_type_abbr) - let add_high_pc = add_abbr_entry (0x12,Defs.high_pc_type_abbr) + let add_high_pc = add_abbr_entry (0x12,DwarfAbbrevs.high_pc_type_abbr) - let add_low_pc = add_abbr_entry (0x11,Defs.low_pc_type_abbr) + let add_low_pc = add_abbr_entry (0x11,DwarfAbbrevs.low_pc_type_abbr) - let add_stmt_list = add_abbr_entry (0x10,Defs.stmt_list_type_abbr) + let add_stmt_list = add_abbr_entry (0x10,DwarfAbbrevs.stmt_list_type_abbr) - let add_declaration = add_abbr_entry (0x3c,Defs.declaration_type_abbr) + let add_declaration = add_abbr_entry (0x3c,DwarfAbbrevs.declaration_type_abbr) - let add_external = add_abbr_entry (0x3f,Defs.external_type_abbr) + let add_external = add_abbr_entry (0x3f,DwarfAbbrevs.external_type_abbr) - let add_prototyped = add_abbr_entry (0x27,Defs.prototyped_type_abbr) + let add_prototyped = add_abbr_entry (0x27,DwarfAbbrevs.prototyped_type_abbr) - let add_bit_offset = add_abbr_entry (0xd,Defs.bit_offset_type_abbr) + let add_bit_offset = add_abbr_entry (0xd,DwarfAbbrevs.bit_offset_type_abbr) - let add_comp_dir = add_abbr_entry (0x1b,Defs.comp_dir_type_abbr) + let add_comp_dir = add_abbr_entry (0x1b,DwarfAbbrevs.comp_dir_type_abbr) - let add_language = add_abbr_entry (0x13,Defs.language_type_abbr) + let add_language = add_abbr_entry (0x13,DwarfAbbrevs.language_type_abbr) - let add_producer = add_abbr_entry (0x25,Defs.producer_type_abbr) + let add_producer = add_abbr_entry (0x25,DwarfAbbrevs.producer_type_abbr) - let add_value = add_abbr_entry (0x1c,Defs.value_type_abbr) + let add_value = add_abbr_entry (0x1c,DwarfAbbrevs.value_type_abbr) - let add_artificial = add_abbr_entry (0x34,Defs.artificial_type_abbr) + let add_artificial = add_abbr_entry (0x34,DwarfAbbrevs.artificial_type_abbr) - let add_variable_parameter = add_abbr_entry (0x4b,Defs.variable_parameter_type_abbr) + let add_variable_parameter = add_abbr_entry (0x4b,DwarfAbbrevs.variable_parameter_type_abbr) - let add_bit_size = add_abbr_entry (0xc,Defs.bit_size_type_abbr) + let add_bit_size = add_abbr_entry (0xc,DwarfAbbrevs.bit_size_type_abbr) let add_location loc buf = match loc with | None -> () - | Some (LocConst _) -> add_abbr_entry (0x2,Defs.location_const_type_abbr) buf - | Some (LocBlock _) -> add_abbr_entry (0x2,Defs.location_block_type_abbr) buf + | Some (LocConst _) -> add_abbr_entry (0x2,DwarfAbbrevs.location_const_type_abbr) buf + | Some (LocBlock _) -> add_abbr_entry (0x2,DwarfAbbrevs.location_block_type_abbr) buf let add_data_location loc buf = match loc with | None -> () - | Some (DataLocBlock __) -> add_abbr_entry (0x38,Defs.data_location_block_type_abbr) buf - | Some (DataLocRef _) -> add_abbr_entry (0x38,Defs.data_location_ref_type_abbr) buf + | Some (DataLocBlock __) -> add_abbr_entry (0x38,DwarfAbbrevs.data_location_block_type_abbr) buf + | Some (DataLocRef _) -> add_abbr_entry (0x38,DwarfAbbrevs.data_location_ref_type_abbr) buf let add_bound_value bound = match bound with - | BoundConst _ -> add_abbr_entry (0x2f,Defs.bound_const_type_abbr) - | BoundRef _ -> add_abbr_entry (0x2f,Defs.bound_ref_type_abbr) + | BoundConst _ -> add_abbr_entry (0x2f,DwarfAbbrevs.bound_const_type_abbr) + | BoundRef _ -> add_abbr_entry (0x2f,DwarfAbbrevs.bound_ref_type_abbr) - let abbrv_string_of_entity entity has_sibling = + let abbrev_string_of_entity entity has_sibling = let buf = Buffer.create 12 in let add_attr_some v f = match v with @@ -126,8 +128,7 @@ module DwarfPrinter : (match entity.tag with | DW_TAG_array_type e -> prologue 0x1; - add_attr_some e.array_type_decl_file add_decl_file; - add_attr_some e.array_type_decl_line add_decl_line; + add_attr_some e.array_type_file_loc add_file_loc; add_type buf | DW_TAG_base_type _ -> prologue 0x24; @@ -142,27 +143,24 @@ module DwarfPrinter : add_language buf; add_name buf; add_producer buf; - add_attr_some e.compile_unit_stmt_list add_stmt_list + add_stmt_list buf; | DW_TAG_const_type _ -> prologue 0x26; add_type buf | DW_TAG_enumeration_type e -> prologue 0x4; - add_attr_some e.enumeration_decl_file add_decl_file; - add_attr_some e.enumeration_decl_line add_decl_line; + add_attr_some e.enumeration_file_loc add_file_loc; add_byte_size buf; add_name buf; add_attr_some e.enumeration_declaration add_declaration | DW_TAG_enumerator e -> prologue 0x28; - add_attr_some e.enumerator_decl_file add_decl_file; - add_attr_some e.enumerator_decl_line add_decl_line; + add_attr_some e.enumerator_file_loc add_file_loc; add_value buf; add_name buf | DW_TAG_formal_parameter e -> prologue 0x34; - add_attr_some e.formal_parameter_decl_file add_decl_file; - add_attr_some e.formal_parameter_decl_line add_decl_line; + add_attr_some e.formal_parameter_file_loc add_file_loc; add_attr_some e.formal_parameter_artificial add_artificial; add_location e.formal_parameter_location buf; add_name buf; @@ -179,8 +177,7 @@ module DwarfPrinter : add_low_pc buf | DW_TAG_member e -> prologue 0xd; - add_attr_some e.member_decl_file add_decl_file; - add_attr_some e.member_decl_line add_decl_line; + add_attr_some e.member_file_loc add_file_loc; add_attr_some e.member_byte_size add_byte_size; add_attr_some e.member_bit_offset add_bit_offset; add_attr_some e.member_bit_size add_bit_size; @@ -193,15 +190,13 @@ module DwarfPrinter : add_type buf | DW_TAG_structure_type e -> prologue 0x13; - add_attr_some e.structure_decl_file add_decl_file; - add_attr_some e.structure_decl_line add_decl_line; + add_attr_some e.structure_file_loc add_file_loc; add_byte_size buf; add_attr_some e.structure_declaration add_declaration; add_name buf | DW_TAG_subprogram e -> prologue 0x2e; - add_attr_some e.subprogram_decl_file add_decl_file; - add_attr_some e.subprogram_decl_line add_decl_line; + add_attr_some e.subprogram_file_loc add_file_loc; add_attr_some e.subprogram_external add_external; add_high_pc buf; add_low_pc buf; @@ -217,25 +212,21 @@ module DwarfPrinter : add_prototyped buf | DW_TAG_typedef e -> prologue 0x16; - add_attr_some e.typedef_decl_file add_decl_file; - add_attr_some e.typedef_decl_line add_decl_line; + add_attr_some e.typedef_file_loc add_file_loc; add_name buf; add_type buf | DW_TAG_union_type e -> prologue 0x17; - add_attr_some e.union_decl_file add_decl_file; - add_attr_some e.union_decl_line add_decl_line; + add_attr_some e.union_file_loc add_file_loc; add_byte_size buf; add_name buf | DW_TAG_unspecified_parameter e -> prologue 0x18; - add_attr_some e.unspecified_parameter_decl_file add_decl_file; - add_attr_some e.unspecified_parameter_decl_line add_decl_line; + add_attr_some e.unspecified_parameter_file_loc add_file_loc; add_attr_some e.unspecified_parameter_artificial add_artificial | DW_TAG_variable e -> prologue 0x34; - add_attr_some e.variable_decl_file add_decl_file; - add_attr_some e.variable_decl_line add_decl_line; + add_attr_some e.variable_file_loc add_file_loc; add_attr_some e.variable_declaration add_declaration; add_attr_some e.variable_external add_external; add_location e.variable_location buf; @@ -247,78 +238,215 @@ module DwarfPrinter : add_type buf); Buffer.contents buf - let get_abbrv entity has_sibling = - let abbrv_string = abbrv_string_of_entity entity has_sibling in + let get_abbrev entity has_sibling = + let abbrev_string = abbrev_string_of_entity entity has_sibling in (try - Hashtbl.find abbrv_mapping abbrv_string + Hashtbl.find abbrev_mapping abbrev_string with Not_found -> - let id = next_abbrv in - abbrevs:=(abbrv_string,id)::!abbrevs; - Hashtbl.add abbrv_mapping abbrv_string id; + let id = next_abbrev in + abbrevs:=(abbrev_string,id)::!abbrevs; + Hashtbl.add abbrev_mapping abbrev_string id; id) - let compute_abbrv entry = + let compute_abbrev entry = entry_iter_sib (fun sib entry -> let has_sib = match sib with | None -> false | Some _ -> true in - ignore (get_abbrv entry has_sib)) entry + ignore (get_abbrev entry has_sib)) entry - let abbrv_section_start oc = - fprintf oc " .section .debug_abbrev,,n\n"(* ; *) - (* let lbl = new_label () in *) - (* abbrv_start_addr := lbl; *) - (* fprintf oc "%a:\n" label lbl *) + let abbrev_start_addr = ref (-1) + + let abbrev_section_start oc = + fprintf oc " .section %s\n" (name_of_section Section_debug_abbrev); + let lbl = new_label () in + abbrev_start_addr := lbl; + print_label oc lbl - let abbrv_section_end oc = - fprintf oc " .section .debug_abbrev,,n\n"; + let abbrev_section_end oc = fprintf oc " .sleb128 0\n" - let abbrv_prologue oc id = - fprintf oc " .section .debug_abbrev,,n\n"; + let abbrev_prologue oc id = fprintf oc " .uleb128 %d\n" id - let abbrv_epilogue oc = + let abbrev_epilogue oc = fprintf oc " .uleb128 0\n"; fprintf oc " .uleb128 0\n" - let print_abbrv occ = + let print_abbrev oc = let abbrevs = List.sort (fun (_,a) (_,b) -> Pervasives.compare a b) !abbrevs in - () - (*Defs.abbrv_section_start oc; + abbrev_section_start oc; List.iter (fun (s,id) -> - Defs.abbrv_prologue oc id; + abbrev_prologue oc id; output_string oc s; - Defs.abbrv_epilogue oc) abbrvs; - Defs.abbrv_section_end oc*) + abbrev_epilogue oc) abbrevs; + abbrev_section_end oc + + let debug_start_addr = ref (-1) + + let entry_labels: (int,int) Hashtbl.t = Hashtbl.create 7 + + let entry_to_label id = + try + Hashtbl.find entry_labels id + with Not_found -> + let label = new_label () in + Hashtbl.add entry_labels id label; + label + + let print_opt_value oc o f = + match o with + | 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) + let print_string oc s = + fprintf oc " .asciz \"%s\"\n" s - let rec print_entry oc entry has_sibling = + let print_uleb128 oc d = + fprintf oc " .uleb128 %d\n" d + + let print_sleb128 oc d = + fprintf oc " .sleb128 %d\n" d + + let print_byte oc b = + fprintf oc " .byte 0x%X\n" b + + let print_loc oc loc = () - let print_debug_abbrv oc entry = - compute_abbrv entry; - print_abbrv oc - - let print_debug_info oc entry = - print_debug_abbrv oc entry - (* (\* let abbrv_start = DwarfDiab.AbbrvPrinter.get_abbrv_start_addr () in *\) *) - (* (\* let debug_start = new_label () in *\) *) - (* let print_info () = *) - (* fprintf oc" .section .debug_info,,n\n" in *) - (* print_info (); *) - (* fprintf oc "%a\n" label debug_start; *) - (* let debug_length_start = new_label () in (\* Address used for length calculation *\) *) - (* let debug_end = new_label () in *) - (* fprintf oc " .4byte %a-%a\n" label debug_end label debug_length_start; *) - (* fprintf oc "%a\n" label debug_length_start; *) - (* fprintf oc " .2byte 0x2\n"; (\* Dwarf version *\) *) - (* fprintf oc " .4byte %a\n" label abbrv_start; (\* Offset into the abbreviation *\) *) - (* fprintf oc " .byte %X\n" !Machine.config.Machine.sizeof_ptr; (\* Sizeof pointer type *\) *) - (* print_entry oc entry false; *) - (* fprintf oc "%a\n" label debug_end; (\* End of the debug section *\) *) - (* fprintf oc " .sleb128 0\n" *) - - let print_debug _ _ = failwith "TODO implement" + let print_data_location oc dl = + () + + let print_ref oc r = + print_label oc (entry_to_label r) + + let print_array_type oc at = + print_file_loc oc at.array_type_file_loc; + print_label oc (entry_to_label at.array_type) + + let print_base_type oc bt = + print_byte oc bt.base_type_byte_size; + let encoding = match bt.base_type_encoding with + | DW_ATE_address -> 0x1 + | DW_ATE_boolean -> 0x2 + | DW_ATE_complex_float -> 0x3 + | DW_ATE_float -> 0x4 + | DW_ATE_signed -> 0x5 + | DW_ATE_signed_char -> 0x6 + | DW_ATE_unsigned -> 0x7 + | DW_ATE_unsigned_char -> 0x8 + in + print_byte oc encoding; + print_string oc bt.base_type_name + + let print_compilation_unit oc tag = + print_string oc (Sys.getcwd ()); + print_label oc (get_start_addr ()); + print_label oc (get_end_addr ()); + print_uleb128 oc 1; + print_string oc tag.compile_unit_name; + print_string oc ("CompCert "^Configuration.version); + print_label oc (get_stmt_list_addr ()) + + let print_const_type oc ct = + print_ref oc ct.const_type + + let print_enumeration_type oc et = + print_file_loc oc et.enumeration_file_loc; + print_uleb128 oc et.enumeration_byte_size; + print_opt_value oc et.enumeration_declaration print_flag; + print_string oc et.enumeration_name + + let print_enumerator oc en = + print_file_loc oc en.enumerator_file_loc; + print_sleb128 oc en.enumerator_value; + print_string oc en.enumerator_name + + let print_formal_parameter oc fp = + print_file_loc oc fp.formal_parameter_file_loc; + print_opt_value oc fp.formal_parameter_artificial print_flag; + print_opt_value oc fp.formal_parameter_location print_loc; + print_string oc fp.formal_parameter_name; + print_opt_value oc fp.formal_parameter_segment print_loc; + print_ref oc fp.formal_parameter_type; + print_opt_value oc fp.formal_parameter_variable_parameter print_flag + + let print_tag_label oc tl = + print_ref oc tl.label_low_pc; + print_string oc tl.label_name + + let print_lexical_block oc lb = + print_ref oc lb.lexical_block_high_pc; + print_ref oc lb.lexical_block_low_pc + + let print_member oc mb = + print_file_loc oc mb.member_file_loc; + print_opt_value oc mb.member_byte_size print_byte; + print_opt_value oc mb.member_bit_offset print_byte; + print_opt_value oc mb.member_bit_size print_byte; + print_opt_value oc mb.member_data_member_location print_data_location; + print_opt_value oc mb.member_declaration print_flag; + print_string oc mb.member_name; + print_ref oc mb.member_type + + let print_pointer oc pt = + print_ref oc pt.pointer_type + + let print_structure oc st = + print_file_loc oc st.structure_file_loc; + print_uleb128 oc st.structure_byte_size; + print_opt_value oc st.structure_declaration print_flag; + print_string oc st.structure_name + + let print_entry oc entry = + entry_iter_sib (fun sib entry -> + print_ref oc entry.id; + let has_sib = match sib with + | None -> false + | Some _ -> true in + let id = get_abbrev entry has_sib in + print_sleb128 oc id; + (match sib with + | None -> () + | Some s -> let lbl = entry_to_label s in + fprintf oc " .4byte %a-%a\n" label lbl label !debug_start_addr); + begin + match entry.tag with + | DW_TAG_array_type arr_type -> print_array_type oc arr_type + | DW_TAG_compile_unit comp -> print_compilation_unit oc comp + | DW_TAG_base_type bt -> print_base_type oc bt + | DW_TAG_const_type ct -> print_const_type oc ct + | _ -> () + end; + if entry.children = [] then + print_sleb128 oc 0) entry + + let print_debug_abbrev oc entry = + compute_abbrev entry; + print_abbrev oc + + let print_debug oc entry = + print_debug_abbrev 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 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; + print_label oc debug_length_start; + fprintf oc " .2byte 0x2\n"; (* Dwarf version *) + fprintf oc " .4byte %a\n" label !abbrev_start_addr; (* Offset into the abbreviation *) + print_byte oc !Machine.config.Machine.sizeof_ptr; (* Sizeof pointer type *) + print_entry oc entry; + print_sleb128 oc 0; + print_label oc debug_end (* End of the debug section *) + end diff --git a/debug/DwarfTypes.ml b/debug/DwarfTypes.ml index 5a832bdf..81c4b858 100644 --- a/debug/DwarfTypes.ml +++ b/debug/DwarfTypes.ml @@ -32,10 +32,6 @@ type encoding = type address = int -type language = - | DW_LANG_C - | DW_LANG_C89 - type block = string type location_value = @@ -52,11 +48,12 @@ type bound_value = (* Types representing the attribute information per tag value *) +type file_loc = string * constant + type dw_tag_array_type = { - array_type_decl_file: string option; - array_type_decl_line: constant option; - array_type: reference; + array_type_file_loc: file_loc option; + array_type: reference; } type dw_tag_base_type = @@ -68,13 +65,7 @@ type dw_tag_base_type = type dw_tag_compile_unit = { - compile_unit_comp_dir: string; - compile_unit_high_pc: address; - compile_unit_low_pc: address; - compile_unit_language: language; compile_unit_name: string; - compile_unit_producer: string; - compile_unit_stmt_list: constant option; } type dw_tag_const_type = @@ -84,8 +75,7 @@ type dw_tag_const_type = type dw_tag_enumeration_type = { - enumeration_decl_file: string option; - enumeration_decl_line: constant option; + enumeration_file_loc: file_loc option; enumeration_byte_size: constant; enumeration_declaration: flag option; enumeration_name: string; @@ -93,16 +83,14 @@ type dw_tag_enumeration_type = type dw_tag_enumerator = { - enumerator_decl_file: string option; - enumerator_decl_line: constant option; - enumerator_value: constant; - enumerator_name: string; + enumerator_file_loc: file_loc option; + enumerator_value: constant; + enumerator_name: string; } type dw_tag_formal_parameter = { - formal_parameter_decl_file: string option; - formal_parameter_decl_line: constant option; + formal_parameter_file_loc: file_loc option; formal_parameter_artificial: flag option; formal_parameter_location: location_value option; formal_parameter_name: string; @@ -119,14 +107,13 @@ type dw_tag_label = type dw_tag_lexical_block = { - lexical_block__high_pc: address; - lexical_block_low_pc: address; + lexical_block_high_pc: address; + lexical_block_low_pc: address; } type dw_tag_member = { - member_decl_file: string option; - member_decl_line: constant option; + member_file_loc: file_loc option; member_byte_size: constant option; member_bit_offset: constant option; member_bit_size: constant option; @@ -143,8 +130,7 @@ type dw_tag_pointer_type = type dw_tag_structure_type = { - structure_decl_file: string option; - structure_decl_line: constant option; + structure_file_loc: file_loc option; structure_byte_size: constant; structure_declaration: flag option; structure_name: string; @@ -152,8 +138,7 @@ type dw_tag_structure_type = type dw_tag_subprogram = { - subprogram_decl_file: string option; - subprogram_decl_line: constant option; + subprogram_file_loc: file_loc option; subprogram_external: flag option; subprogram_frame_base: location_value option; subprogram_high_pc: address; @@ -176,31 +161,27 @@ type dw_tag_subroutine_type = type dw_tag_typedef = { - typedef_decl_file: string option; - typedef_decl_line: constant option; - typedef_name: string; - typedef_type: reference; + typedef_file_loc: file_loc option; + typedef_name: string; + typedef_type: reference; } type dw_tag_union_type = { - union_decl_file: string option; - union_decl_line: constant option; + union_file_loc: file_loc option; union_byte_size: constant; union_name: string; } type dw_tag_unspecified_parameter = { - unspecified_parameter_decl_file: string option; - unspecified_parameter_decl_line: constant option; + unspecified_parameter_file_loc: file_loc option; unspecified_parameter_artificial: flag option; } type dw_tag_variable = { - variable_decl_file: string option; - variable_decl_line: constant option; + variable_file_loc: file_loc option; variable_declaration: flag option; variable_external: flag option; variable_location: location_value option; @@ -246,3 +227,32 @@ type dw_entry = } +module type DWARF_ABBREVS = + sig + val sibling_type_abbr: int + val file_loc_type_abbr: int * int + val type_abbr: int + val name_type_abbr: int + val encoding_type_abbr: int + val byte_size_type_abbr: int + val high_pc_type_abbr: int + val low_pc_type_abbr: int + val stmt_list_type_abbr: int + val declaration_type_abbr: int + val external_type_abbr: int + val prototyped_type_abbr: int + val bit_offset_type_abbr: int + val comp_dir_type_abbr: int + val language_type_abbr: int + val producer_type_abbr: int + val value_type_abbr: int + val artificial_type_abbr: int + val variable_parameter_type_abbr: int + val bit_size_type_abbr: int + val location_const_type_abbr: int + val location_block_type_abbr: int + val data_location_block_type_abbr: int + val data_location_ref_type_abbr: int + val bound_const_type_abbr: int + val bound_ref_type_abbr: int + end diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml index cc1f267d..b3cef748 100644 --- a/debug/DwarfUtil.ml +++ b/debug/DwarfUtil.ml @@ -90,8 +90,7 @@ let dw_ref_indirect = 0x16 module DefaultAbbrevs = struct let sibling_type_abbr = dw_form_ref4 - let decl_file_type_abbr = dw_form_data4 - let decl_line_type_abbr = dw_form_udata + let file_loc_type_abbr = dw_form_data4,dw_form_udata let type_abbr = dw_form_ref_addr let name_type_abbr = dw_form_string let encoding_type_abbr = dw_form_data1 diff --git a/driver/Configuration.ml b/driver/Configuration.ml index 0012dc0c..48c31767 100644 --- a/driver/Configuration.ml +++ b/driver/Configuration.ml @@ -93,4 +93,10 @@ let asm_supports_cfi = | "false" -> false | v -> bad_config "asm_supports_cfi" [v] +let advanced_debug = + match get_config_string "advanced_debug" with + | "true" -> true + | "false" -> false + | v -> bad_config "advanced_debug" [v] + let version = get_config_string "version" diff --git a/ia32/TargetPrinter.ml b/ia32/TargetPrinter.ml index cc16890c..7663b7e7 100644 --- a/ia32/TargetPrinter.ml +++ b/ia32/TargetPrinter.ml @@ -977,6 +977,12 @@ module Target(System: SYSTEM):TARGET = let get_stmt_list_addr () = -1 (* Dummy constant *) + module DwarfAbbrevs = DwarfUtil.DefaultAbbrevs (* Dummy Abbrev types *) + + let label = label + + let new_label = new_label + end let sel_target () = diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml index 90e9b880..50a00b9e 100644 --- a/powerpc/TargetPrinter.ml +++ b/powerpc/TargetPrinter.ml @@ -39,6 +39,7 @@ module type SYSTEM = val cfi_rel_offset: out_channel -> string -> int32 -> unit val print_prologue: out_channel -> unit val print_epilogue: out_channel -> unit + val print_file_loc: out_channel -> DwarfTypes.file_loc -> unit end let symbol = elf_symbol @@ -145,6 +146,8 @@ module Linux_System : SYSTEM = let print_prologue oc = () let print_epilogue oc = () + + let print_file_loc _ _ = () end @@ -243,6 +246,11 @@ module Diab_System : SYSTEM = fprintf oc ".L%d: .d2filenum \"%s\"\n" label file) PrintAnnot.filename_info; fprintf oc " .d2_line_end\n" end + + let print_file_loc oc (file,col) = + fprintf oc " .4byte %a\n" label (Hashtbl.find filenum file); + fprintf oc " .uleb128 %d\n" col + end module Target (System : SYSTEM):TARGET = @@ -790,6 +798,10 @@ module Target (System : SYSTEM):TARGET = let get_stmt_list_addr () = !stmt_list_addr + module DwarfAbbrevs = DwarfUtil.DefaultAbbrevs + + let new_label = new_label + end let sel_target () = |