diff options
Diffstat (limited to 'debug')
| -rw-r--r-- | debug/DwarfPrinter.ml | 396 | ||||
| -rw-r--r-- | debug/DwarfTypes.mli | 28 | ||||
| -rw-r--r-- | debug/DwarfUtil.ml | 75 |
3 files changed, 273 insertions, 226 deletions
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index b7ecb62c..abed6a91 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -27,51 +27,57 @@ module DwarfPrinter(Target: DWARF_TARGET): open Target + let print_comment oc s = + if s <> "" then + fprintf oc " %s %s" comment s + + let string_of_comment s = sprintf " %s %s" comment s + + let add_comment buf s = + Buffer.add_string buf (sprintf " %s %s" comment s) + (* Byte value to string *) - let string_of_byte value = - sprintf " .byte %s\n" (if value then "0x1" else "0x0") + let string_of_byte value ct = + sprintf " .byte %s%s\n" (if value then "0x1" else "0x0") (string_of_comment ct) (* Print a label *) let print_label oc lbl = fprintf oc "%a:\n" label lbl - (* Print a positive label *) - let print_plabel oc lbl = - print_label oc (transl_label lbl) - (* Helper functions for abbreviation printing *) - let add_byte buf value = - Buffer.add_string buf (string_of_byte value) + let add_byte buf value ct = + Buffer.add_string buf (string_of_byte value ct) - let add_abbr_uleb v buf = - Buffer.add_string buf (Printf.sprintf " .uleb128 %d\n" v) + let add_abbr_uleb v ct buf = + Buffer.add_string buf (sprintf " .uleb128 %d%s\n" v (string_of_comment ct)) + + let add_abbr_entry (v1,c1,v2) buf = + add_abbr_uleb v1 c1 buf; + let v2,c2 = code_of_dw_form v2 in + Buffer.add_string buf (sprintf " .uleb128 %d%s\n" v2 (string_of_comment c2)) - let add_abbr_entry (v1,v2) buf = - add_abbr_uleb v1 buf; - add_abbr_uleb v2 buf let add_file_loc buf = - let file,line = file_loc_type_abbr in - add_abbr_entry (0x3a,file) buf; - add_abbr_entry (0x3b,line) buf + add_abbr_entry (0x3a,"DW_AT_decl_file",DW_FORM_data4) buf; + add_abbr_entry (0x3b,"DW_AT_decl_line",DW_FORM_udata) buf - let add_type = add_abbr_entry (0x49,type_abbr) + let add_type = add_abbr_entry (0x49,"DW_AT_type",DW_FORM_ref_addr) - let add_byte_size = add_abbr_entry (0xb,byte_size_type_abbr) + let add_byte_size = add_abbr_entry (0x0b,"DW_AT_byte_size",DW_FORM_data1) - let add_member_size = add_abbr_entry (0xb,member_size_abbr) + let add_member_size = add_abbr_entry (0x0b,"DW_AT_byte_size",DW_FORM_udata) - let add_high_pc = add_abbr_entry (0x12,high_pc_type_abbr) + let add_high_pc = add_abbr_entry (0x12,"DW_AT_high_pc",DW_FORM_addr) - let add_low_pc = add_abbr_entry (0x11,low_pc_type_abbr) + let add_low_pc = add_abbr_entry (0x11,"DW_AT_low_pc",DW_FORM_addr) - let add_declaration = add_abbr_entry (0x3c,declaration_type_abbr) + let add_declaration = add_abbr_entry (0x3c,"DW_AT_declaration",DW_FORM_flag) - let add_string buf id = function - | Simple_string _ -> add_abbr_entry (id,dw_form_string) buf - | Offset_string _ -> add_abbr_entry (id,dw_form_strp) buf + let add_string buf id c = function + | Simple_string _ -> add_abbr_entry (id,c,DW_FORM_string) buf + | Offset_string _ -> add_abbr_entry (id,c,DW_FORM_strp) buf - let add_name buf = add_string buf 0x3 + let add_name buf = add_string buf 0x3 "DW_AT_name" let add_name_opt buf = function | None -> () @@ -80,10 +86,10 @@ module DwarfPrinter(Target: DWARF_TARGET): let add_location loc buf = match loc with | None -> () - | Some (LocRef _) -> add_abbr_entry (0x2,location_ref_type_abbr) buf + | Some (LocRef _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_data4) buf | Some (LocList _ ) | Some (LocSymbol _) - | Some (LocSimple _) -> add_abbr_entry (0x2,location_block_type_abbr) buf + | Some (LocSimple _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_block) buf @@ -94,125 +100,125 @@ module DwarfPrinter(Target: DWARF_TARGET): match v with | None -> () | Some _ -> f buf in - let prologue id = + let prologue id c = let has_child = match entity.children with | [] -> false | _ -> true in - add_abbr_uleb id buf; - add_byte buf has_child; - if has_sibling then add_abbr_entry (0x1,sibling_type_abbr) buf; + add_abbr_uleb id c buf; + add_byte buf has_child (if has_child then "DW_CHILDREN_yes" else "DW_CHILDREN_no"); + if has_sibling then add_abbr_entry (0x1,"DW_AT_sibling",DW_FORM_ref4) buf; in (match entity.tag with | DW_TAG_array_type e -> - prologue 0x1; + prologue 0x1 "DW_TAG_array_type"; add_type buf | DW_TAG_base_type b -> - prologue 0x24; + prologue 0x24 "DW_TAG_base_type"; add_byte_size buf; - add_attr_some b.base_type_encoding (add_abbr_entry (0x3e,encoding_type_abbr)); + add_attr_some b.base_type_encoding (add_abbr_entry (0x3e,"DW_AT_encoding",DW_FORM_data1)); add_name buf b.base_type_name; | DW_TAG_compile_unit e -> - prologue 0x11; - add_string buf 0x1b e.compile_unit_dir; + 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_abbr_entry (0x13,language_type_abbr) buf; + add_abbr_entry (0x13,"DW_AT_language",DW_FORM_udata) buf; add_name buf e.compile_unit_name; - add_string buf 0x25 e.compile_unit_prod_name; - add_abbr_entry (0x10,stmt_list_type_abbr) buf; + add_string buf 0x25 "DW_AT_producer" e.compile_unit_prod_name; + add_abbr_entry (0x10,"DW_AT_stmt_list",DW_FORM_data4) buf; | DW_TAG_const_type _ -> - prologue 0x26; + prologue 0x26 "DW_TAG_const_type"; add_type buf | DW_TAG_enumeration_type e -> - prologue 0x4; + prologue 0x4 "DW_TAG_enumeration_type"; add_attr_some e.enumeration_file_loc add_file_loc; add_byte_size buf; add_attr_some e.enumeration_declaration add_declaration; add_name buf e.enumeration_name | DW_TAG_enumerator e -> - prologue 0x28; - add_abbr_entry (0x1c,value_type_abbr) buf; + prologue 0x28 "DW_TAG_enumerator"; + add_abbr_entry (0x1c,"DW_AT_const_value",DW_FORM_sdata) buf; add_name buf e.enumerator_name | DW_TAG_formal_parameter e -> - prologue 0x5; - add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr)); + prologue 0x5 "DW_TAG_formal_parameter"; + add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,"DW_AT_artificial",DW_FORM_flag)); add_name_opt buf e.formal_parameter_name; add_type buf; - add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr)); + add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,"DW_AT_variable_parameter",DW_FORM_flag)); add_location e.formal_parameter_location buf | DW_TAG_label e -> - prologue 0xa; + prologue 0xa "DW_TAG_label"; add_low_pc buf; add_name buf e.label_name; | DW_TAG_lexical_block a -> - prologue 0xb; + 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 | DW_TAG_member e -> - prologue 0xd; + prologue 0xd "DW_TAG_member"; add_attr_some e.member_byte_size add_byte_size; - add_attr_some e.member_bit_offset (add_abbr_entry (0xc,bit_offset_type_abbr)); - add_attr_some e.member_bit_size (add_abbr_entry (0xd,bit_size_type_abbr)); + add_attr_some e.member_bit_offset (add_abbr_entry (0xc,"DW_AT_bit_offset",DW_FORM_data1)); + add_attr_some e.member_bit_size (add_abbr_entry (0xd,"DW_AT_bit_size",DW_FORM_data1)); add_attr_some e.member_declaration add_declaration; add_name buf e.member_name; add_type buf; (match e.member_data_member_location with | None -> () - | Some (DataLocBlock __) -> add_abbr_entry (0x38,data_location_block_type_abbr) buf - | Some (DataLocRef _) -> add_abbr_entry (0x38,data_location_ref_type_abbr) buf) + | Some (DataLocBlock __) -> add_abbr_entry (0x38,"DW_AT_data_member_location",DW_FORM_block) buf + | Some (DataLocRef _) -> add_abbr_entry (0x38,"DW_AT_data_member_location",DW_FORM_ref4) buf) | DW_TAG_pointer_type _ -> - prologue 0xf; + prologue 0xf "DW_TAG_pointer_type"; add_type buf | DW_TAG_structure_type e -> - prologue 0x13; + prologue 0x13 "DW_TAG_structure_type"; add_attr_some e.structure_file_loc add_file_loc; add_attr_some e.structure_byte_size add_member_size; add_attr_some e.structure_declaration add_declaration; add_name_opt buf e.structure_name | DW_TAG_subprogram e -> - prologue 0x2e; + prologue 0x2e "DW_TAG_subprogram"; add_file_loc buf; - add_attr_some e.subprogram_external (add_abbr_entry (0x3f,external_type_abbr)); - add_attr_some e.subprogram_high_pc add_high_pc; + 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_name buf e.subprogram_name; - add_abbr_entry (0x27,prototyped_type_abbr) buf; + add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf; add_attr_some e.subprogram_type add_type; | DW_TAG_subrange_type e -> - prologue 0x21; + prologue 0x21 "DW_TAG_subrange_type"; add_attr_some e.subrange_type add_type; (match e.subrange_upper_bound with | None -> () - | Some (BoundConst _) -> add_abbr_entry (0x2f,bound_const_type_abbr) buf - | Some (BoundRef _) -> add_abbr_entry (0x2f,bound_ref_type_abbr) buf) + | Some (BoundConst _) -> add_abbr_entry (0x2f,"DW_AT_upper_bound",DW_FORM_udata) buf + | Some (BoundRef _) -> add_abbr_entry (0x2f,"DW_AT_upper_bound",DW_FORM_ref4) buf) | DW_TAG_subroutine_type e -> - prologue 0x15; + prologue 0x15 "DW_TAG_subroutine_type"; add_attr_some e.subroutine_type add_type; - add_abbr_entry (0x27,prototyped_type_abbr) buf + add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf | DW_TAG_typedef e -> - prologue 0x16; + prologue 0x16 "DW_TAG_typedef"; add_attr_some e.typedef_file_loc add_file_loc; add_name buf e.typedef_name; add_type buf | DW_TAG_union_type e -> - prologue 0x17; + prologue 0x17 "DW_TAG_union_type"; add_attr_some e.union_file_loc add_file_loc; add_attr_some e.union_byte_size add_member_size; add_attr_some e.union_declaration add_declaration; add_name_opt buf e.union_name | DW_TAG_unspecified_parameter e -> - prologue 0x18; - add_attr_some e.unspecified_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr)) + prologue 0x18 "DW_TAG_unspecified_parameter"; + add_attr_some e.unspecified_parameter_artificial (add_abbr_entry (0x34,"DW_AT_artificial",DW_FORM_flag)) | DW_TAG_variable e -> - prologue 0x34; + prologue 0x34 "DW_TAG_variable"; add_file_loc buf; add_attr_some e.variable_declaration add_declaration; - add_attr_some e.variable_external (add_abbr_entry (0x3f,external_type_abbr)); - add_location e.variable_location buf; + add_attr_some e.variable_external (add_abbr_entry (0x3f,"DW_AT_external",DW_FORM_flag)); + add_location e.variable_location buf; add_name buf e.variable_name; add_type buf | DW_TAG_volatile_type _ -> - prologue 0x35; + prologue 0x35 "DW_TAG_volatile_type"; add_type buf); Buffer.contents buf @@ -253,11 +259,11 @@ module DwarfPrinter(Target: DWARF_TARGET): section oc Section_debug_abbrev; print_label oc !abbrev_start_addr; List.iter (fun (s,id) -> - fprintf oc " .uleb128 %d\n" id; + fprintf oc " .uleb128 %d%a\n" id print_comment "Abbreviation Code"; output_string oc s; - fprintf oc " .uleb128 0\n"; - fprintf oc " .uleb128 0\n\n") abbrevs; - fprintf oc " .sleb128 0\n" + fprintf oc " .uleb128 0%a\n" print_comment "EOM(1)"; + fprintf oc " .uleb128 0%a\n" print_comment "EOM(2)") abbrevs; + fprintf oc " .sleb128 0%a\n" print_comment "EOM(3)" let debug_start_addr = ref (-1) @@ -285,117 +291,117 @@ module DwarfPrinter(Target: DWARF_TARGET): Hashtbl.add loc_labels id label; label - let print_loc_ref oc r = + let print_loc_ref oc c r = let ref = loc_to_label r in - fprintf oc " .4byte %a\n" label ref + fprintf oc " .4byte %a%a\n" label ref print_comment c (* Helper functions for debug printing *) - let print_opt_value oc o f = + let print_opt_value oc c o f = match o with | None -> () - | Some o -> f oc o + | Some o -> f oc c o - let print_flag oc b = - output_string oc (string_of_byte b) + let print_flag oc c b = + output_string oc (string_of_byte b c) - let print_string oc = function + let print_string oc c = function | Simple_string s -> - fprintf oc " .asciz \"%s\"\n" s - | Offset_string o -> print_loc_ref oc o + fprintf oc " .asciz \"%s\"%a\n" s print_comment c + | Offset_string o -> print_loc_ref oc c o - let print_uleb128 oc d = - fprintf oc " .uleb128 %d\n" d + let print_uleb128 oc c d = + fprintf oc " .uleb128 %d%a\n" d print_comment c - let print_sleb128 oc d = - fprintf oc " .sleb128 %d\n" d + let print_sleb128 oc c d = + fprintf oc " .sleb128 %d%a\n" d print_comment c - let print_byte oc b = - fprintf oc " .byte 0x%X\n" b + let print_byte oc c b = + fprintf oc " .byte 0x%X%a\n" b print_comment c - let print_2byte oc b = - fprintf oc " .2byte 0x%X\n" b + let print_2byte oc c b = + fprintf oc " .2byte 0x%X%a\n" b print_comment c - let print_ref oc r = + let print_ref oc c r = let ref = entry_to_label r in - fprintf oc " .4byte %a\n" label ref + fprintf oc " .4byte %a%a\n" label ref print_comment c let print_file_loc oc = function | Some (Diab_file_loc (file,col)) -> - fprintf oc " .4byte %a\n" label file; - print_uleb128 oc col + fprintf oc " .4byte %a%a\n" label file print_comment "DW_AT_decl_file"; + print_uleb128 oc "DW_AT_decl_line" col | Some (Gnu_file_loc (file,col)) -> - fprintf oc " .4byte %l\n" file; - print_uleb128 oc col + fprintf oc " .4byte %l%a\n" file print_comment "DW_AT_decl_file"; + print_uleb128 oc "DW_AT_decl_line" col | None -> () let print_loc_expr oc = function | DW_OP_bregx (a,b) -> - print_byte oc dw_op_bregx; - print_uleb128 oc a; - fprintf oc " .sleb128 %ld\n" b + print_byte oc "" dw_op_bregx; + print_uleb128 oc "" a; + fprintf oc " .sleb128 %ld\n" b; | DW_OP_plus_uconst i -> - print_byte oc dw_op_plus_uconst; - print_uleb128 oc i + print_byte oc "" dw_op_plus_uconst; + print_uleb128 oc "" i | DW_OP_piece i -> - print_byte oc dw_op_piece; - print_uleb128 oc i + print_byte oc "" dw_op_piece; + print_uleb128 oc "" i | DW_OP_reg i -> if i < 32 then - print_byte oc (dw_op_reg0 + i) + print_byte oc "" (dw_op_reg0 + i) else begin - print_byte oc dw_op_regx; - print_uleb128 oc i + print_byte oc "" dw_op_regx; + print_uleb128 oc "" i end - let print_loc oc loc = + let print_loc oc c loc = match loc with | LocSymbol s -> - print_sleb128 oc 5; - print_byte oc dw_op_addr; + print_sleb128 oc c 5; + print_byte oc "" dw_op_addr; fprintf oc " .4byte %a\n" symbol s | LocSimple e -> - print_sleb128 oc (size_of_loc_expr e); + print_sleb128 oc c (size_of_loc_expr e); print_loc_expr oc e | LocList e -> let size = List.fold_left (fun acc a -> acc + size_of_loc_expr a) 0 e in - print_sleb128 oc size; + print_sleb128 oc "" size; List.iter (print_loc_expr oc) e - | LocRef f -> print_loc_ref oc f + | LocRef f -> print_loc_ref oc c f let print_list_loc oc = function | LocSymbol s -> - print_2byte oc 5; - print_byte oc dw_op_addr; + print_2byte oc "" 5; + print_byte oc "" dw_op_addr; fprintf oc " .4byte %a\n" symbol s | LocSimple e -> - print_2byte oc (size_of_loc_expr e); + print_2byte oc "" (size_of_loc_expr e); print_loc_expr oc e | LocList e -> let size = List.fold_left (fun acc a -> acc + size_of_loc_expr a) 0 e in - print_2byte oc size; + print_2byte oc "" size; List.iter (print_loc_expr oc) e - | LocRef f -> print_loc_ref oc f + | LocRef f -> print_loc_ref oc "" f - let print_data_location oc dl = + let print_data_location oc c dl = match dl with | DataLocBlock e -> - print_sleb128 oc (size_of_loc_expr e); + print_sleb128 oc c (size_of_loc_expr e); print_loc_expr oc e | _ -> () - let print_addr oc a = - fprintf oc " .4byte %a\n" label a + let print_addr oc c a = + fprintf oc " .4byte %a%a\n" label a print_comment c let print_array_type oc at = - print_ref oc at.array_type + print_ref oc "DW_AT_type" at.array_type - let print_bound_value oc = function - | BoundConst bc -> print_uleb128 oc bc - | BoundRef br -> print_ref oc br + let print_bound_value oc c = function + | BoundConst bc -> print_uleb128 oc c bc + | BoundRef br -> print_ref oc c br let print_base_type oc bt = - print_byte oc bt.base_type_byte_size; + print_byte oc "DW_AT_byte_size" bt.base_type_byte_size; (match bt.base_type_encoding with | Some e -> let encoding = match e with @@ -408,66 +414,66 @@ module DwarfPrinter(Target: DWARF_TARGET): | DW_ATE_unsigned -> 0x7 | DW_ATE_unsigned_char -> 0x8 in - print_byte oc encoding; + print_byte oc "DW_AT_encoding" encoding; | None -> ()); - print_string oc bt.base_type_name + print_string oc "DW_AT_name" bt.base_type_name let print_compilation_unit oc tag = - print_string oc tag.compile_unit_dir; - 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 tag.compile_unit_prod_name; - print_addr oc !debug_stmt_list + 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_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; + print_addr oc "DW_AT_stmt_list" !debug_stmt_list let print_const_type oc ct = - print_ref oc ct.const_type + print_ref oc "DW_AT_type" 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 + print_uleb128 oc "DW_AT_byte_size" et.enumeration_byte_size; + print_opt_value oc "DW_AT_declaration" et.enumeration_declaration print_flag; + print_string oc "DW_AT_name" et.enumeration_name let print_enumerator oc en = - print_sleb128 oc en.enumerator_value; - print_string oc en.enumerator_name + print_sleb128 oc "DW_AT_const_value" en.enumerator_value; + print_string oc "DW_AT_name" en.enumerator_name let print_formal_parameter oc fp = - print_opt_value oc fp.formal_parameter_artificial print_flag; - print_opt_value oc fp.formal_parameter_name print_string; - print_ref oc fp.formal_parameter_type; - print_opt_value oc fp.formal_parameter_variable_parameter print_flag; - print_opt_value oc fp.formal_parameter_location print_loc + print_opt_value oc "DW_AT_artificial" fp.formal_parameter_artificial print_flag; + print_opt_value oc "DW_AT_name" fp.formal_parameter_name print_string; + print_ref oc "DW_AT_type" fp.formal_parameter_type; + print_opt_value oc "DW_AT_variable_parameter" fp.formal_parameter_variable_parameter print_flag; + print_opt_value oc "DW_AT_location" fp.formal_parameter_location print_loc let print_tag_label oc tl = - print_ref oc tl.label_low_pc; - print_string oc tl.label_name + print_ref oc "DW_AT_low_pc" tl.label_low_pc; + print_string oc "DW_AT_name" tl.label_name let print_lexical_block oc lb = - print_opt_value oc lb.lexical_block_high_pc print_addr; - print_opt_value oc lb.lexical_block_low_pc print_addr + 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 let print_member oc mb = - 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_declaration print_flag; - print_string oc mb.member_name; - print_ref oc mb.member_type; - print_opt_value oc mb.member_data_member_location print_data_location + print_opt_value oc "DW_AT_byte_size" mb.member_byte_size print_byte; + print_opt_value oc "DW_AT_bit_offset" mb.member_bit_offset print_byte; + print_opt_value oc "DW_AT_bit_size" mb.member_bit_size print_byte; + print_opt_value oc "DW_AT_declaration" mb.member_declaration print_flag; + print_string oc "DW_AT_name" mb.member_name; + print_ref oc "DW_AT_type" mb.member_type; + print_opt_value oc "DW_AT_data_member_location" mb.member_data_member_location print_data_location let print_pointer oc pt = - print_ref oc pt.pointer_type + print_ref oc "DW_AT_type" pt.pointer_type let print_structure oc st = print_file_loc oc st.structure_file_loc; - print_opt_value oc st.structure_byte_size print_uleb128; - print_opt_value oc st.structure_declaration print_flag; - print_opt_value oc st.structure_name print_string + print_opt_value oc "DW_AT_byte_size" st.structure_byte_size print_uleb128; + 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; @@ -475,45 +481,45 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_subprogram oc sp = print_file_loc oc (Some sp.subprogram_file_loc); - print_opt_value oc sp.subprogram_external print_flag; - print_opt_value oc sp.subprogram_high_pc print_addr; - print_opt_value oc sp.subprogram_low_pc print_addr; - print_string oc sp.subprogram_name; - print_flag oc sp.subprogram_prototyped; - print_opt_value oc sp.subprogram_type print_ref + 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_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 let print_subrange oc sr = - print_opt_value oc sr.subrange_type print_ref; - print_opt_value oc sr.subrange_upper_bound print_bound_value + print_opt_value oc "DW_AT_type" sr.subrange_type print_ref; + print_opt_value oc "DW_AT_upper_bound" sr.subrange_upper_bound print_bound_value let print_subroutine oc st = - print_opt_value oc st.subroutine_type print_ref; - print_flag oc st.subroutine_prototyped + print_opt_value oc "DW_AT_type" st.subroutine_type print_ref; + print_flag oc "DW_AT_prototyped" st.subroutine_prototyped let print_typedef oc td = print_file_loc oc td.typedef_file_loc; - print_string oc td.typedef_name; - print_ref oc td.typedef_type + print_string oc "DW_AT_name" td.typedef_name; + print_ref oc "DW_AT_type" td.typedef_type let print_union_type oc ut = print_file_loc oc ut.union_file_loc; - print_opt_value oc ut.union_byte_size print_uleb128; - print_opt_value oc ut.union_declaration print_flag; - print_opt_value oc ut.union_name print_string + print_opt_value oc "DW_AT_byte_size" ut.union_byte_size print_uleb128; + print_opt_value oc "DW_AT_declaration" ut.union_declaration print_flag; + print_opt_value oc "DW_AT_name" ut.union_name print_string let print_unspecified_parameter oc up = - print_opt_value oc up.unspecified_parameter_artificial print_flag + print_opt_value oc "DW_AT_artificial" up.unspecified_parameter_artificial print_flag let print_variable oc var = print_file_loc oc (Some var.variable_file_loc); - print_opt_value oc var.variable_declaration print_flag; - print_opt_value oc var.variable_external print_flag; - print_opt_value oc var.variable_location print_loc; - print_string oc var.variable_name; - print_ref oc var.variable_type + print_opt_value oc "DW_AT_declaration" var.variable_declaration print_flag; + print_opt_value oc "DW_AT_external" var.variable_external print_flag; + print_opt_value oc "DW_AT_location" var.variable_location print_loc; + print_string oc "DW_AT_name" var.variable_name; + print_ref oc "DW_AT_type" var.variable_type let print_volatile_type oc vt = - print_ref oc vt.volatile_type + print_ref oc "DW_AT_type" vt.volatile_type (* Print an debug entry *) let print_entry oc entry = @@ -523,11 +529,11 @@ module DwarfPrinter(Target: DWARF_TARGET): | None -> false | Some _ -> true in let id = get_abbrev entry has_sib in - print_sleb128 oc id; + print_sleb128 oc (sprintf "Abbrev [%d] %s" id (string_of_dw_tag entry.tag)) 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); + fprintf oc " .4byte %a-%a%a\n" label lbl label !debug_start_addr print_comment "DW_AT_sibling"); begin match entry.tag with | DW_TAG_array_type arr_type -> print_array_type oc arr_type @@ -552,7 +558,7 @@ module DwarfPrinter(Target: DWARF_TARGET): | DW_TAG_volatile_type vt -> print_volatile_type oc vt end) (fun e -> if e.children <> [] then - print_sleb128 oc 0) entry + print_sleb128 oc "End Of Children Mark" 0) entry (* Print the debug info section *) let print_debug_info oc start line_start entry = @@ -562,13 +568,13 @@ module DwarfPrinter(Target: DWARF_TARGET): 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; + fprintf oc " .4byte %a-%a%a\n" label debug_end label debug_length_start print_comment "Length of Unit"; print_label oc debug_length_start; - fprintf oc " .2byte 0x2\n"; (* Dwarf version *) - print_addr oc !abbrev_start_addr; (* Offset into the abbreviation *) - print_byte oc !Machine.config.Machine.sizeof_ptr; (* Sizeof pointer type *) + fprintf oc " .2byte 0x2%a\n" print_comment "DWARF version number"; (* Dwarf version *) + print_addr oc "Offset Into Abbrev. Section" !abbrev_start_addr; (* Offset into the abbreviation *) + print_byte oc "Address Size (in bytes)" !Machine.config.Machine.sizeof_ptr; (* Sizeof pointer type *) print_entry oc entry; - print_sleb128 oc 0; + print_sleb128 oc "" 0; print_label oc debug_end (* End of the debug section *) let print_location_entry oc c_low l = diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index 7048d8d3..fb1725d9 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -60,12 +60,35 @@ type string_const = | Simple_string of string | Offset_string of reference -(* Types representing the attribute information per tag value *) - type file_loc = | Diab_file_loc of constant * constant | Gnu_file_loc of constant * constant +type dw_form = + | DW_FORM_addr + | DW_FORM_block2 + | DW_FORM_block4 + | DW_FORM_data2 + | DW_FORM_data4 + | DW_FORM_data8 + | DW_FORM_string + | DW_FORM_block + | DW_FORM_block1 + | DW_FORM_data1 + | DW_FORM_flag + | DW_FORM_sdata + | DW_FORM_strp + | DW_FORM_udata + | DW_FORM_ref_addr + | DW_FORM_ref1 + | DW_FORM_ref2 + | DW_FORM_ref4 + | DW_FORM_ref8 + | DW_FORM_ref_udata + | DW_FORM_ref_indirect + +(* Types representing the attribute information per tag value *) + type dw_tag_array_type = { array_type: reference; @@ -273,4 +296,5 @@ module type DWARF_TARGET= val label: out_channel -> int -> unit val section: out_channel -> section_name -> unit val symbol: out_channel -> atom -> unit + val comment: string end diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml index 16e446ee..3e252dd2 100644 --- a/debug/DwarfUtil.ml +++ b/debug/DwarfUtil.ml @@ -53,6 +53,30 @@ let rec entry_fold f acc entry = let acc = f acc entry.tag in List.fold_left (entry_fold f) acc entry.children +(* Return the code and the corresponding comment for a DW_FORM *) +let code_of_dw_form = function + | DW_FORM_addr -> 0x01,"DW_FORM_addr" + | DW_FORM_block2 -> 0x03,"DW_FORM_block2" + | DW_FORM_block4 -> 0x04,"DW_FORM_block4" + | DW_FORM_data2 -> 0x05,"DW_FORM_data2" + | DW_FORM_data4 -> 0x06,"DW_FORM_data4" + | DW_FORM_data8 -> 0x07,"DW_FORM_data8" + | DW_FORM_string -> 0x08,"DW_FORM_string" + | DW_FORM_block -> 0x09,"DW_FORM_block" + | DW_FORM_block1 -> 0x0a,"DW_FORM_block1" + | DW_FORM_data1 -> 0x0b,"DW_FORM_data1" + | DW_FORM_flag -> 0x0c,"DW_FORM_flag" + | DW_FORM_sdata -> 0x0d,"DW_FORM_sdata" + | DW_FORM_strp -> 0x0e,"DW_FORM_strp" + | DW_FORM_udata -> 0x0f,"DW_FORM_udata" + | DW_FORM_ref_addr -> 0x10,"DW_FORM_ref_addr" + | DW_FORM_ref1 -> 0x11,"DW_FORM_ref1" + | DW_FORM_ref2 -> 0x12,"DW_FORM_ref2" + | DW_FORM_ref4 -> 0x13,"DW_FORM_ref4" + | DW_FORM_ref8 -> 0x14,"DW_FORM_ref8" + | DW_FORM_ref_udata -> 0x15,"DW_FORM_ref_udata" + | DW_FORM_ref_indirect -> 0x16,"DW_FORM_ref_indirect" + (* Attribute form encoding *) let dw_form_addr = 0x01 let dw_form_block2 = 0x03 @@ -84,35 +108,28 @@ let dw_op_regx = 0x90 let dw_op_bregx = 0x92 let dw_op_piece = 0x93 - -(* Default corresponding encoding for the different abbreviations *) -let sibling_type_abbr = dw_form_ref4 -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 -let byte_size_type_abbr = dw_form_data1 -let member_size_abbr = dw_form_udata -let high_pc_type_abbr = dw_form_addr -let low_pc_type_abbr = dw_form_addr -let stmt_list_type_abbr = dw_form_data4 -let declaration_type_abbr = dw_form_flag -let external_type_abbr = dw_form_flag -let prototyped_type_abbr = dw_form_flag -let bit_offset_type_abbr = dw_form_data1 -let comp_dir_type_abbr = dw_form_string -let language_type_abbr = dw_form_udata -let producer_type_abbr = dw_form_string -let value_type_abbr = dw_form_sdata -let artificial_type_abbr = dw_form_flag -let variable_parameter_type_abbr = dw_form_flag -let bit_size_type_abbr = dw_form_data1 -let location_ref_type_abbr = dw_form_data4 -let location_block_type_abbr = dw_form_block -let data_location_block_type_abbr = dw_form_block -let data_location_ref_type_abbr = dw_form_ref4 -let bound_const_type_abbr = dw_form_udata -let bound_ref_type_abbr=dw_form_ref4 +(* Tag to string function *) +let string_of_dw_tag = function + | DW_TAG_array_type _ -> "DW_TAG_array_type" + | DW_TAG_compile_unit _ -> "DW_TAG_compile_unit" + | DW_TAG_base_type _ -> "DW_TAG_base_type" + | DW_TAG_const_type _ -> "DW_TAG_const_type" + | DW_TAG_enumeration_type _ -> "DW_TAG_enumeration_type" + | DW_TAG_enumerator _ -> "DW_TAG_enumerator" + | DW_TAG_formal_parameter _ -> "DW_TAG_formal_parameter" + | DW_TAG_label _ -> "DW_TAG_label" + | DW_TAG_lexical_block _ -> "DW_TAG_lexical_block" + | DW_TAG_member _ -> "DW_TAG_member" + | DW_TAG_pointer_type _ -> "DW_TAG_pointer_type" + | DW_TAG_structure_type _ -> "DW_TAG_structure_type" + | DW_TAG_subprogram _ -> "DW_TAG_subprogram" + | DW_TAG_subrange_type _ -> "DW_TAG_subrange_type" + | DW_TAG_subroutine_type _ -> "DW_TAG_subroutine_type" + | DW_TAG_typedef _ -> "DW_TAG_typedef" + | DW_TAG_union_type _ -> "DW_TAG_union_type" + | DW_TAG_unspecified_parameter _ -> "DW_TAG_unspecified_parameter" + | DW_TAG_variable _ -> "DW_TAG_variable" + | DW_TAG_volatile_type _ -> "DW_TAG_volatile_type" (* Sizeof functions for the encoding of uleb128 and sleb128 *) let sizeof_uleb128 value = |