////////////////////////////////////////////////////////////////////// // // // dwarfUtils.pas: DWARF debugging backend support // // // // The contents of this file are subject to the Bottled Light // // Public License Version 1.0 (the "License"); you may not use this // // file except in compliance with the License. You may obtain a // // copy of the License at http://www.bottledlight.com/BLPL/ // // // // Software distributed under the License is distributed on an // // "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or // // implied. See the License for the specific language governing // // rights and limitations under the License. // // // // The Original Code is the Mappy VM User Interface, released // // April 1st, 2003. The Initial Developer of the Original Code is // // Bottled Light, Inc. Portions created by Bottled Light, Inc. are // // Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. // // // // Author(s): // // Michael Noland (joat), michael@bottledlight.com // // // // Changelog: // // 1.0: First public release (April 1st, 2003) // // // // Notes: // // Welcome to hell my friends. For more info, see the DWARF 2 // // specification PDF. // // // ////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// unit dwarfUtils; ///////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// interface //////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// uses Classes, SysUtils, Contnrs, Math, elfUtils, nexus, console, AddressSpace; ////////////////////////////////////////////////////////////////////// function DwarfFormToString(form: uint32): string; function DwarfAttributeToString(attrib: uint32): string; function DwarfTagToString(tag: uint32): string; function dwarfLookupVal(cmd: string): string; ////////////////////////////////////////////////////////////////////// const // DWARF Attribute Tags DW_TAG_null = $00; DW_TAG_array_type = $01; DW_TAG_class_type = $02; DW_TAG_entry_point = $03; DW_TAG_enumeration_type = $04; DW_TAG_formal_parameter = $05; DW_TAG_imported_declaration = $08; DW_TAG_label = $0A; DW_TAG_lexical_block = $0B; DW_TAG_member = $0D; DW_TAG_pointer_type = $0F; DW_TAG_reference_type = $10; DW_TAG_compile_unit = $11; DW_TAG_string_type = $12; DW_TAG_structure_type = $13; DW_TAG_subroutine_type = $15; DW_TAG_typedef = $16; DW_TAG_union_type = $17; DW_TAG_unspecified_parameters = $18; DW_TAG_variant = $19; DW_TAG_common_block = $1A; DW_TAG_common_inclusion = $1B; DW_TAG_inheritance = $1C; DW_TAG_inlined_subroutine = $1D; DW_TAG_module = $1E; DW_TAG_ptr_to_member_type = $1F; DW_TAG_set_type = $20; DW_TAG_subrange_type = $21; DW_TAG_with_stmt = $22; DW_TAG_access_declaration = $23; DW_TAG_base_type = $24; DW_TAG_catch_block = $25; DW_TAG_const_type = $26; DW_TAG_constant = $27; DW_TAG_enumerator = $28; DW_TAG_file_type = $29; DW_TAG_friend = $2A; DW_TAG_namelist = $2B; DW_TAG_namelist_item = $2C; DW_TAG_packed_type = $2D; DW_TAG_subprogram = $2E; DW_TAG_template_type_param = $2F; DW_TAG_template_value_param = $30; DW_TAG_thrown_type = $31; DW_TAG_try_block = $32; DW_TAG_variant_part = $33; DW_TAG_variable = $34; DW_TAG_volatile_type = $35; DW_TAG_lo_user = $4080; DW_TAG_hi_user = $FFFF; // DW_CHILDREN_no = 0; DW_CHILDREN_yes = 1; DW_AT_sibling = $01; // reference DW_AT_location = $02; // block, constant DW_AT_name = $03; // string DW_AT_ordering = $09; // constant DW_AT_byte_size = $0B; // constant DW_AT_bit_offset = $0C; // constant DW_AT_bit_size = $0D; // constant DW_AT_stmt_list = $10; // constant DW_AT_low_pc = $11; // address DW_AT_high_pc = $12; // address DW_AT_language = $13; // constant DW_AT_discr = $15; // reference DW_AT_discr_value = $16; // constant DW_AT_visibility = $17; // constant DW_AT_import = $18; // reference DW_AT_string_length = $19; // block, constant DW_AT_common_reference = $1A; // reference DW_AT_comp_dir = $1B; // string DW_AT_const_value = $1C; // string, constant, block DW_AT_containing_type = $1D; // reference DW_AT_default_value = $1E; // reference DW_AT_inline = $20; // constant DW_AT_is_optional = $21; // flag DW_AT_lower_bound = $22; // constant, reference DW_AT_producer = $25; // string DW_AT_prototyped = $27; // flag DW_AT_return_addr = $2A; // block, constant DW_AT_start_scope = $2C; // constant DW_AT_stride_size = $2E; // constant DW_AT_upper_bound = $2F; // constant, reference DW_AT_abstract_origin = $31; // reference DW_AT_accessibility = $32; // constant DW_AT_address_class = $33; // constant DW_AT_artificial = $34; // flag DW_AT_base_types = $35; // reference DW_AT_calling_convention = $36; // constant DW_AT_count = $37; // constant, reference DW_AT_data_member_location = $38; // block, reference DW_AT_decl_column = $39; // constant DW_AT_decl_file = $3A; // constant DW_AT_decl_line = $3B; // constant DW_AT_declaration = $3C; // flag DW_AT_discr_list = $3D; // block DW_AT_encoding = $3E; // constant DW_AT_external = $3F; // flag DW_AT_frame_base = $40; // block, constant DW_AT_friend = $41; // reference DW_AT_identifier_case = $42; // constant DW_AT_macro_info = $43; // constant DW_AT_namelist_item = $44; // block DW_AT_priority = $45; // reference DW_AT_segment = $46; // block, constant DW_AT_specification = $47; // reference DW_AT_static_link = $48; // block, constant DW_AT_type = $49; // reference DW_AT_use_location = $4A; // block, constant DW_AT_variable_parameter = $4B; // flag DW_AT_virtuality = $4C; // constant DW_AT_vtable_elem_location = $4D; // block, reference // ARM Compiler extensions DW_AT_proc_body = $2000; DW_AT_save_offset = $2001; DW_AT_codeseg_base = $2002; // MIPS extensions DW_AT_MIPS_linkage_name = $2007; DW_AT_lo_user = $2000; DW_AT_hi_user = $3FFF; // DWARF data attribute formats DW_FORM_addr = $01; // address DW_FORM_block2 = $03; // block DW_FORM_block4 = $04; // block DW_FORM_data2 = $05; // constant DW_FORM_data4 = $06; // constant DW_FORM_data8 = $07; // constant DW_FORM_string = $08; // string (null term string) DW_FORM_block = $09; // block DW_FORM_block1 = $0A; // block DW_FORM_data1 = $0B; // constant DW_FORM_flag = $0C; // flag DW_FORM_sdata = $0D; // constant DW_FORM_strp = $0E; // string (offset into .debug_str) DW_FORM_udata = $0F; // constant DW_FORM_ref_addr = $10; // reference DW_FORM_ref1 = $11; // reference DW_FORM_ref2 = $12; // reference DW_FORM_ref4 = $13; // reference DW_FORM_ref8 = $14; // reference DW_FORM_ref_udata = $15; // reference DW_FORM_indirect = $16; // (see section 7.5.3) // DWARF location stack machine opcodes (the comments indicate operands) DW_OP_addr = $03; // constant address (size target specific) DW_OP_deref = $06; DW_OP_const1u = $08; // 1-byte constant DW_OP_const1s = $09; // 1-byte constant DW_OP_const2u = $0A; // 2-byte constant DW_OP_const2s = $0B; // 2-byte constant DW_OP_const4u = $0C; // 4-byte constant DW_OP_const4s = $0D; // 4-byte constant DW_OP_const8u = $0E; // 8-byte constant DW_OP_const8s = $0F; // 8-byte constant DW_OP_constu = $10; // ULEB128 constant DW_OP_consts = $11; // SLEB128 constant DW_OP_dup = $12; DW_OP_drop = $13; DW_OP_over = $14; DW_OP_pick = $15; // 1 1-byte stack index DW_OP_swap = $16; DW_OP_rot = $17; DW_OP_xderef = $18; DW_OP_abs = $19; DW_OP_and = $1A; DW_OP_div = $1B; DW_OP_minus = $1C; DW_OP_mod = $1D; DW_OP_mul = $1E; DW_OP_neg = $1F; DW_OP_not = $20; DW_OP_or = $21; DW_OP_plus = $22; DW_OP_plus_uconst = $23; // ULEB128 addend DW_OP_shl = $24; DW_OP_shr = $25; DW_OP_shra = $26; DW_OP_xor = $27; DW_OP_bra = $28; // signed 2-byte constant DW_OP_eq = $29; DW_OP_ge = $2A; DW_OP_gt = $2B; DW_OP_le = $2C; DW_OP_lt = $2D; DW_OP_ne = $2E; DW_OP_skip = $2F; // signed 2-byte constant DW_OP_lit0 = $30; DW_OP_lit31 = $4F; DW_OP_reg0 = $50; DW_OP_reg31 = $6F; DW_OP_breg0 = $70; // SLEB128 offset DW_OP_breg31 = $8F; DW_OP_regx = $90; // ULEB128 register DW_OP_fbreg = $91; // SLEB128 offset DW_OP_bregx = $92; // ULEB128 register followed by SLEB128 offset DW_OP_piece = $93; // ULEB128 size of piece addressed DW_OP_deref_size = $94; // 1-byte size of data retrieved DW_OP_xderef_size = $95; // 1-byte size of data retrieved DW_OP_nop = $96; DW_OP_lo_user = $E0; DW_OP_hi_user = $FF; // DWARF simple types DW_ATE_address = $1; DW_ATE_boolean = $2; DW_ATE_complex_float = $3; DW_ATE_float = $4; DW_ATE_signed = $5; DW_ATE_signed_char = $6; DW_ATE_unsigned = $7; DW_ATE_unsigned_char = $8; DW_ATE_lo_user = $80; DW_ATE_hi_user = $FF; // DWARF access types DW_ACCESS_public = 1; DW_ACCESS_protected = 2; DW_ACCESS_private = 3; // Visibility code name DW_VIS_local = 1; DW_VIS_exported = 2; DW_VIS_qualified = 3; // Virtuality code name DW_VIRTUALITY_none = 0; DW_VIRTUALITY_virtual = 1; DW_VIRTUALITY_pure_virtual = 2; // DWARF Language Constants DW_LANG_C89 = $0001; DW_LANG_C = $0002; DW_LANG_Ada83 = $0003; DW_LANG_C_plus_plus = $0004; DW_LANG_Cobol74 = $0005; DW_LANG_Cobol85 = $0006; DW_LANG_Fortran77 = $0007; DW_LANG_Fortran90 = $0008; DW_LANG_Pascal83 = $0009; DW_LANG_Modula2 = $000A; DW_LANG_lo_user = $8000; DW_LANG_hi_user = $FFFF; // DWARF identifier case sensitivity mode DW_ID_case_sensitive = 0; DW_ID_up_case = 1; DW_ID_down_case = 2; DW_ID_case_insensitive = 3; DW_CC_normal = $1; DW_CC_program = $2; DW_CC_nocall = $3; DW_CC_lo_user = $40; DW_CC_hi_user = $ff; DW_INL_not_inlined = 0; DW_INL_inlined = 1; DW_INL_declared_not_inlined = 2; DW_INL_declared_inlined = 3; DW_ORD_row_major = 0; DW_ORD_col_major = 1; DW_DSC_label = 0; DW_DSC_range = 1; // Statement program opcodes DW_LNS_extended_opcode = 0; DW_LNS_copy = 1; DW_LNS_advance_pc = 2; DW_LNS_advance_line = 3; DW_LNS_set_file = 4; DW_LNS_set_column = 5; DW_LNS_negate_stmt = 6; DW_LNS_set_basic_block = 7; DW_LNS_const_add_pc = 8; DW_LNS_fixed_advance_pc = 9; // Extended opcodes DW_LNE_end_sequence = 1; DW_LNE_set_address = 2; DW_LNE_define_file = 3; DW_MACINFO_define = 1; DW_MACINFO_undef = 2; DW_MACINFO_start_file = 3; DW_MACINFO_end_file = 4; DW_MACINFO_vendor_ext = 255; DW_CFA_advance_loc = $1; // delta DW_CFA_offset = $2; // register ULEB128 offset DW_CFA_restore = $3; // register DW_CFA_set_loc = $1; // address DW_CFA_advance_loc1 = $2; // 1-byte delta DW_CFA_advance_loc2 = $3; // 2-byte delta DW_CFA_advance_loc4 = $4; // 4-byte delta DW_CFA_offset_extended = $5; // ULEB128 register ULEB128 offset DW_CFA_restore_extended = $6; // ULEB128 register DW_CFA_undefined = $7; // ULEB128 register DW_CFA_same_value = $8; // ULEB128 register DW_CFA_register = $9; // ULEB128 register ULEB128 register DW_CFA_remember_state = $A; DW_CFA_restore_state = $B; DW_CFA_def_cfa = $C; // ULEB128 register ULEB128 offset DW_CFA_def_cfa_register = $D; // ULEB128 register DW_CFA_def_cfa_offset = $E; // ULEB128 offset DW_CFA_nop = $0; DW_CFA_lo_user = $1C; DW_CFA_hi_user = $3F; ////////////////////////////////////////////////////////////////////// type TDwarfBlock = record size: integer; data: pointer; end; PDwarfAttribute = ^TDwarfAttribute; TDwarfAttribute = record name: uint32; next: PDwarfAttribute; case format: uint32 of DW_FORM_addr: (address: uint32); DW_FORM_block, DW_FORM_block1, DW_FORM_block2, DW_FORM_block4: (block: TDwarfBlock); DW_FORM_sdata, DW_FORM_udata, DW_FORM_data1, DW_FORM_data2, DW_FORM_data4, DW_FORM_data8: (data: uint32); DW_FORM_string, DW_FORM_strp: (st: PChar); DW_FORM_flag: (flag: boolean); DW_FORM_ref_addr, DW_FORM_ref_udata, DW_FORM_ref1, DW_FORM_ref2, DW_FORM_ref4, DW_FORM_ref8: (offset: uint32); end; PDwarfNode = ^TDwarfNode; TDwarfNode = record abbreviation, tag: uint32; hasChildren: boolean; next, kids: PDwarfNode; attribs: PDwarfAttribute; end; PPDwarfNode = ^PDwarfNode; ////////////////////////////////////////////////////////////////////// TCompilationUnit = class unitLength: uint32; // length of the contribution to the .debug_info section, not including the length field producerVersion: uint16; // version of the DWARF producer, should be 2 abbrevOffset: uint32; // offset into the .debug_abbrev section addressSize: uint8; // size in bytes of an address on the target (is the offset portion of a segmented arch) rootNode: PDwarfNode; macroOffset: uint32; lowPC, highPC: uint32; lang: uint32; // Misc. lists for quick use functions, types, classes, variables: TStringList; // Stuff for the statement program statementOffset, rStatementOffset: uint32; dirs, files: TStringList; constructor Create; destructor Destroy; override; end; ////////////////////////////////////////////////////////////////////// TPubnamesUnitHeader = packed record length: uint32; // length of the contribution to the .debug_pubnames section, not including the lengthfield version: uint16; // version of the DWARF producer, should be 2 offset: uint32; // offset of the information in .debug_info for this compilation unit size: uint32; // size in bytes of the information in .debug_info for this compilation unit end; TARangesUnitHeader = packed record length: uint32; // length of the contribution to the .debug_arranges section, not including the length field version: uint16; // version of the DWARF producer, should be 2 offseet: uint32; // offset into the .debug_info section addrSize: uint8; // size in bytes of an address on the target (is the offset portion of a segmented arch) segSize: uint8; // size in bytes of a segment descriptor on the target end; TARangeTuple = packed record start, size: uint32; end; TARangeTuples = array[0..0] of TARangeTuple; PARangeTuples = ^TARangeTuples; TARangeData = record count: integer; data: PARangeTuples; end; TDwarfStatementPrologue = packed record totalLength: uint32; version: uint16; prologueLength: uint32; minInstructionLength: uint8; defaultIsStatement: uint8; lineBase: int8; lineRange: uint8; opcodeBase: uint8; // variable sized data follows end; TDwarfFile = class compUnits: TObjectList; baseDir: string; varList: TStringList; procedure DestroyNode(node: PDwarfNode); destructor Destroy; override; constructor Create; function FindContainingUnit(address: uint32): TCompilationUnit; end; TLineHit = record line, column: uint32; endSequence, isStatement, basicBlock: boolean; filename: string; end; TDwarfSubroutine = class name: string; node: PDwarfNode; lowPC, highPC: uint32; fileIndex, line, column: integer; end; TDwarfVariable = class name: string; node: PDwarfNode; fileIndex, line, column: integer; startScope: uint32; loc: PDwarfAttribute; typ: PDwarfAttribute; end; TDwarfType = class name: string; node: PDwarfNode; fileIndex, line, column: integer; isBasic: boolean; // Whether or not its a basic type (if true, encoding is valid) encoding: integer; // DW_ATE_* size: integer; // size (in bytes) bitSize, bitOffset: integer; // for sub-byte variables (I'll probably ignore it) end; ////////////////////////////////////////////////////////////////////// var dwarf: TDwarfFile; function ProcessDWARF(elf: TELFFile; dir: string): TDwarfFile; procedure ProcessNode(cunit: TCompilationUnit; node: PDwarfNode); function DoLineProgram(building: boolean; cunit: TCompilationUnit; target: uint32; var hit: TLineHit): boolean; function FindLineInP(target: uint32; var hit: TLineHit): boolean; procedure WalkVariables(var res: TStringList); function ExamineVariable(name: string): integer; function LocationSM(block: TDwarfBlock; var inRegister, notOptimized: boolean): uint32; function FindAttribute(node: PDwarfNode; name: uint32): PDwarfAttribute; ////////////////////////////////////////////////////////////////////// implementation /////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// uses observerCSource; ////////////////////////////////////////////////////////////////////// const tagStrings: array[0..DW_TAG_volatile_type] of string = ( 'DW_TAG_null', 'DW_TAG_array_type', 'DW_TAG_class_type', 'DW_TAG_entry_point', 'DW_TAG_enumeration_type', 'DW_TAG_formal_parameter', '', '', 'DW_TAG_imported_declaration', '', 'DW_TAG_label', 'DW_TAG_lexical_block', '', 'DW_TAG_member', '', 'DW_TAG_pointer_type', 'DW_TAG_reference_type', 'DW_TAG_compile_unit', 'DW_TAG_string_type', 'DW_TAG_structure_type', '', 'DW_TAG_subroutine_type', 'DW_TAG_typedef', 'DW_TAG_union_type', 'DW_TAG_unspecified_parameters', 'DW_TAG_variant', 'DW_TAG_common_block', 'DW_TAG_common_inclusion', 'DW_TAG_inheritance', 'DW_TAG_inlined_subroutine', 'DW_TAG_module', 'DW_TAG_ptr_to_member_type', 'DW_TAG_set_type', 'DW_TAG_subrange_type', 'DW_TAG_with_stmt', 'DW_TAG_access_declaration', 'DW_TAG_base_type', 'DW_TAG_catch_block', 'DW_TAG_const_type', 'DW_TAG_constant', 'DW_TAG_enumerator', 'DW_TAG_file_type', 'DW_TAG_friend', 'DW_TAG_namelist', 'DW_TAG_namelist_item', 'DW_TAG_packed_type', 'DW_TAG_subprogram', 'DW_TAG_template_type_param', 'DW_TAG_template_value_param', 'DW_TAG_thrown_type', 'DW_TAG_try_block', 'DW_TAG_variant_part', 'DW_TAG_variable', 'DW_TAG_volatile_type' ); attribStrings: array[0..DW_AT_vtable_elem_location] of string = ( '', 'DW_AT_sibling', 'DW_AT_location', 'DW_AT_name', '', '', '', '', '', 'DW_AT_ordering', '', 'DW_AT_byte_size', 'DW_AT_bit_offset', 'DW_AT_bit_size', '', '', 'DW_AT_stmt_list', 'DW_AT_low_pc', 'DW_AT_high_pc', 'DW_AT_language', '', 'DW_AT_discr', 'DW_AT_discr_value', 'DW_AT_visibility', 'DW_AT_import', 'DW_AT_string_length', 'DW_AT_common_reference', 'DW_AT_comp_dir', 'DW_AT_const_value', 'DW_AT_containing_type', 'DW_AT_default_value', '', 'DW_AT_inline', 'DW_AT_is_optional', 'DW_AT_lower_bound', '', '', 'DW_AT_producer', '', 'DW_AT_prototyped', '', '', 'DW_AT_return_addr', '', 'DW_AT_start_scope', '', 'DW_AT_stride_size', 'DW_AT_upper_bound', '', 'DW_AT_abstract_origin', 'DW_AT_accessibility', 'DW_AT_address_class', 'DW_AT_artificial', 'DW_AT_base_types', 'DW_AT_calling_convention', 'DW_AT_count', 'DW_AT_data_member_location', 'DW_AT_decl_column', 'DW_AT_decl_file', 'DW_AT_decl_line', 'DW_AT_declaration', 'DW_AT_discr_list', 'DW_AT_encoding', 'DW_AT_external', 'DW_AT_frame_base', 'DW_AT_friend', 'DW_AT_identifier_case', 'DW_AT_macro_info', 'DW_AT_namelist_item', 'DW_AT_priority', 'DW_AT_segment', 'DW_AT_specification', 'DW_AT_static_link', 'DW_AT_type', 'DW_AT_use_location', 'DW_AT_variable_parameter', 'DW_AT_virtuality', 'DW_AT_vtable_elem_location' ); formStrings: array[0..DW_FORM_indirect] of string = ( 'Unknown form 0', 'DW_FORM_addr', 'Unknown form 2', '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_indirect'); langStrings: array[0..DW_LANG_Modula2] of string = ( '', 'DW_LANG_C89', 'DW_LANG_C', 'DW_LANG_Ada83', 'DW_LANG_C_plus_plus', 'DW_LANG_Cobol74', 'DW_LANG_Cobol85', 'DW_LANG_Fortran77', 'DW_LANG_Fortran90', 'DW_LANG_Pascal83', 'DW_LANG_Modula2'); ////////////////////////////////////////////////////////////////////// function DwarfFormToString(form: uint32): string; begin if form <= DW_FORM_indirect then Result := formStrings[form] else Result := Format('', [form]); end; ////////////////////////////////////////////////////////////////////// function DwarfAttributeToString(attrib: uint32): string; begin if attrib <= DW_AT_vtable_elem_location then Result := attribStrings[attrib] else begin if attrib = $2000 then Result := 'DW_AT_proc_body' else if attrib = $2001 then Result := 'DW_AT_save_offset' else if attrib = $2002 then Result := 'DW_AT_codeseg_base' else if attrib = $2007 then Result := 'DW_AT_MIPS_linkage_name' else Result := Format('', [attrib]); end; end; ////////////////////////////////////////////////////////////////////// function DwarfTagToString(tag: uint32): string; begin if tag <= DW_TAG_volatile_type then Result := tagStrings[tag] else Result := Format('', [tag]); end; ////////////////////////////////////////////////////////////////////// function DwarfLangToString(lang: uint32): string; begin if lang <= DW_LANG_Modula2 then Result := langStrings[lang] else Result := Format('', [lang]); end; ////////////////////////////////////////////////////////////////////// var debugAbbrev, debugAranges, debugFrame, debugInfo, debugLine, debugLoc, debugMacInfo, debugPubNames, debugStr: TElfSection; ////////////////////////////////////////////////////////////////////// function ReadTSRegister(index: integer): integer; begin Result := vmGetRegister(index); end; ////////////////////////////////////////////////////////////////////// function ReadTSAddress(addr: uint32): uint32; begin Result := vmReadWord(addr); end; ////////////////////////////////////////////////////////////////////// function ReadTSUint8(addr: uint32): uint32; begin Result := vmReadByte(addr); end; ////////////////////////////////////////////////////////////////////// procedure ReadAttribute(attrib: PDwarfAttribute); var temp: uint32; begin with debugInfo do begin case attrib^.format of DW_FORM_addr: attrib^.address := ReadAddress; DW_FORM_block2: begin attrib^.block.size := ReadUint16; attrib^.block.data := dataPointer; SeekRelAddress(attrib^.block.size); end; DW_FORM_block4: begin attrib^.block.size := ReadUint32; attrib^.block.data := dataPointer; SeekRelAddress(attrib^.block.size); end; DW_FORM_data2: attrib^.data := ReadUint16; DW_FORM_data4: attrib^.data := ReadUint32; DW_FORM_data8: attrib^.data := ReadUint64; DW_FORM_string: attrib^.st := ReadString; DW_FORM_block: begin attrib^.block.size := ReadLEB128; attrib^.block.data := dataPointer; SeekRelAddress(attrib^.block.size); end; DW_FORM_block1: begin attrib^.block.size := ReadUint8; attrib^.block.data := dataPointer; SeekRelAddress(attrib^.block.size); end; DW_FORM_data1: attrib^.data := ReadUint8; DW_FORM_flag: attrib^.flag := ReadUint8 <> 0; DW_FORM_sdata: attrib^.data := ReadSLEB128; DW_FORM_strp: begin temp := ReadUint32; if debugStr <> nil then attrib^.st := pointer(uint32(debugStr.data) + temp);// todo: should be a readstring? end; DW_FORM_udata: attrib^.data := ReadLEB128; DW_FORM_ref_addr: attrib^.offset := ReadAddress; DW_FORM_ref1: attrib^.offset := ReadUint8; DW_FORM_ref2: attrib^.offset := ReadUint16; DW_FORM_ref4: attrib^.offset := ReadUint32; DW_FORM_ref8: attrib^.offset := ReadUint64; DW_FORM_ref_udata: attrib^.offset := ReadLEB128; DW_FORM_indirect: begin attrib^.format := ReadLEB128; if attrib^.format <> DW_FORM_indirect then ReadAttribute(attrib) else logWriteLn('dwarfUtils.ReadAttribute: Error, DW_FORM_indirect loop'); end; else logWriteLn('dwarfUtils.ReadAttribute: Error, unknown form ' + IntToStr(attrib^.format)); end; end; end; ////////////////////////////////////////////////////////////////////// // returns true if found, false otherwise function FindAbbreviation(cunit: TCompilationUnit; abbreviation: uint32): boolean; var code, a, b: uint32; begin debugAbbrev.Seek(cunit.abbrevOffset); repeat // Read the abbreviation code (abbrev = 0 denotes the end entry) code := debugAbbrev.ReadLEB128; if code = abbreviation then begin Result := true; Exit; end; // Eat the tag and children flag debugAbbrev.ReadLEB128; debugAbbrev.ReadUint8; // Skip over the attributes repeat a := debugAbbrev.ReadLEB128; b := debugAbbrev.ReadLEB128; until (a = 0) and (b = 0); until code = 0; Result := false; end; ////////////////////////////////////////////////////////////////////// function ReadNode(cunit: TCompilationUnit): PDwarfNode; var lastAttrib: ^PDwarfAttribute; attrib: PDwarfAttribute; abbrev: uint32; lnode, node: PDwarfNode; name, format: uint32; begin Result := nil; node := nil; // Read the abbreviation from the .debug_info section repeat // Check the abbreviation code (0 is a reserved code) abbrev := debugInfo.ReadLEB128; if abbrev = 0 then Break; // Create a new sibling node lnode := node; GetMem(node, SizeOf(TDwarfNode)); if Assigned(lnode) then lnode^.next := node else Result := node; // Initialize the new node node^.abbreviation := abbrev; node^.next := nil; node^.attribs := nil; node^.kids := nil; node^.tag := DW_TAG_friend; // Read the attribute names and formats from the .debug_abbrev section if FindAbbreviation(cunit, node^.abbreviation) then begin node^.tag := debugAbbrev.ReadLEB128; node^.hasChildren := debugAbbrev.ReadUint8 = DW_CHILDREN_yes; lastAttrib := @(node^.attribs); repeat name := debugAbbrev.ReadLEB128; format := debugAbbrev.ReadLEB128; if (name = 0) and (format = 0) then begin lastAttrib^ := nil; Break; end else begin // Create a new attribute GetMem(attrib, SizeOf(TDwarfAttribute)); attrib^.name := name; attrib^.format := format; attrib^.next := nil; ReadAttribute(attrib); lastAttrib^ := attrib; lastAttrib := @(attrib^.next); end; until false; // Read the attribute data from the .debug_info section { attrib := node^.attribs; while attrib <> nil do begin ReadAttribute(attrib); attrib := attrib^.next; end;} // Recursively get all the children if node^.hasChildren then node^.kids := ReadNode(cunit); end else logWriteLn('dwarfUtils.ReadNode: Error, abbreviation ' + IntToStr(node^.abbreviation) + ' not found in .debug_abbrev contribution for current compilation unit'); until false; end; ////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// function LocationSM(block: TDwarfBlock; var inRegister, notOptimized: boolean): uint32; var stackIndex: integer; stack: array[0..63] of uint32; procedure Push(addr: uint32); begin stackIndex := (stackIndex-1) and 63; stack[stackIndex] := addr; end; function Pop: uint32; begin Result := stack[stackIndex]; stackIndex := (stackIndex+1) and 63; end; function Peek(offset: integer): uint32; begin Result := stack[(stackIndex+offset) and 63]; end; var u1, u2, u3: uint32; s1, s2: integer; opcode: byte; data: TReadableResource; begin // Position the reader data := TReadableResource.Create; data.data := block.data; data.Seek(0); stackIndex := 63; stack[stackIndex] := 0; inRegister := false; with data do begin notOptimized := false; while integer(dataPointer) - integer(block.data) < block.size do begin notOptimized := true; opcode := ReadUint8; case opcode of DW_OP_addr: Push(ReadAddress); DW_OP_deref: Push(ReadTSAddress(Pop)); DW_OP_const1u: Push(ReadUint8); DW_OP_const1s: Push(ReadInt8); DW_OP_const2u: Push(ReadUint16); DW_OP_const2s: Push(ReadInt16); DW_OP_const4u: Push(ReadUint32); DW_OP_const4s: Push(ReadInt32); DW_OP_const8u: Push(ReadUint64); DW_OP_const8s: Push(ReadInt64); DW_OP_constu: Push(ReadLEB128); DW_OP_consts: Push(ReadSLEB128); DW_OP_dup: Push(Peek(stackIndex)); DW_OP_drop: Pop; DW_OP_over: Push(Peek(1)); DW_OP_pick: Push(Peek(ReadUint8)); DW_OP_swap: begin u1 := Pop; u2 := Pop; Push(u1); Push(u2); end; DW_OP_rot: begin u1 := Pop; u2 := Pop; u3 := Pop; Push(u1); Push(u2); Push(u3); end; DW_OP_xderef: begin // fixme, todo, error Push(ReadTSAddress(Pop + Pop)); // todo: incorrect hack} end; DW_OP_abs: Push(Abs(integer(Pop))); DW_OP_and: Push(Pop and Pop); DW_OP_div: begin s1 := Pop; s2 := Pop; if s1 = 0 then s1 := 1; Push(s2 div s1); end; DW_OP_minus: begin u1 := Pop; Push(Pop - u1); end; DW_OP_mod: begin u1 := Pop; u2 := Pop; if u1 = 0 then u1 := 1; Push(u2 mod u1); end; DW_OP_mul: Push(Pop * Pop); DW_OP_neg: begin s1 := Pop; Push(-s1); end; DW_OP_not: Push(not Pop); DW_OP_or: Push(Pop or Pop); DW_OP_plus: Push(Pop + Pop); DW_OP_plus_uconst: Push(Pop + ReadLEB128); DW_OP_shl: begin u1 := Pop; Push(Pop shl u1); end; DW_OP_shr: begin u1 := Pop; Push(Pop shr u1); end; DW_OP_shra: begin u1 := Pop; u2 := Pop; u3 := u2 shr u1; if u2 shr 31 <> 0 then u3 := u3 or ($FFFFFFFF shl u1); Push(u3); end; DW_OP_xor: Push(Pop xor Pop); DW_OP_skip: SeekRelAddress(ReadInt16); DW_OP_bra: begin s1 := ReadInt16; if Pop = 0 then SeekRelAddress(s1); end; // todo: are these in the correct order (i.e. is GE s2 >= s1 or s1 >= s2)? DW_OP_eq: begin s1 := Pop; s2 := Pop; if s1 = s2 then Push(1) else Push(0); end; DW_OP_ge: begin s1 := Pop; s2 := Pop; if s1 >= s2 then Push(1) else Push(0); end; DW_OP_gt: begin s1 := Pop; s2 := Pop; if s1 > s2 then Push(1) else Push(0); end; DW_OP_le: begin s1 := Pop; s2 := Pop; if s1 <= s2 then Push(1) else Push(0); end; DW_OP_lt: begin s1 := Pop; s2 := Pop; if s1 < s2 then Push(1) else Push(0); end; DW_OP_ne: begin s1 := Pop; s2 := Pop; if s1 <> s2 then Push(1) else Push(0); end; DW_OP_lit0..DW_OP_lit31: Push(opcode and $1F); DW_OP_reg0..DW_OP_reg31: begin inRegister := true; Result := opcode and $1F; Exit; end; DW_OP_breg0: Push(ReadTSRegister(opcode and $1F) + ReadSLEB128); DW_OP_regx: begin inRegister := true; Result := ReadLEB128; Exit; end; DW_OP_fbreg: begin // fixme! s1 := ReadTSRegister(0); Push(s1 + ReadSLEB128); end; DW_OP_bregx: begin s1 := ReadTSRegister(ReadLEB128); Push(s1 + ReadSLEB128); end; DW_OP_piece: begin // todo: not supported yet ReadLEB128; // size of piece addressed // error, fixme, todo end; DW_OP_deref_size: begin // fixme, todo, error u1 := Pop; u2 := 0; u3 := Min(ReadUint8, 4)-1; for s1 := 0 to u3 do begin u2 := u2 shl 8 + ReadTSUint8(u1); Inc(u1); end; Push(u2); end; DW_OP_xderef_size: begin // todo: incorrect hack u1 := Pop + Pop; u2 := 0; u3 := Min(ReadUint8, 4)-1; for s1 := 0 to u3 do begin u2 := u2 shl 8 + ReadTSUint8(u1); Inc(u1); end; Push(u2); end; DW_OP_nop: ; else // balls, unsuported opcode logWriteLn('Error: Unsupported location state machine opcode $' + IntToHex(opcode, 2)); end; end; Result := Pop; end; data.Free; end; ////////////////////////////////////////////////////////////////////// function FindLineInP(target: uint32; var hit: TLineHit): boolean; var cunit: TCompilationUnit; begin Result := false; if Assigned(dwarf) then begin cunit := Dwarf.FindContainingUnit(target); if cunit <> nil then Result := DoLineProgram(false, cunit, target, hit); end; end; ////////////////////////////////////////////////////////////////////// function DoLineProgram(building: boolean; cunit: TCompilationUnit; target: uint32; var hit: TLineHit): boolean; var line, sourceFile: int32; address, column: uint32; isStatement, basicBlock, endSequence: boolean; header: TDwarfStatementPrologue; sizes: PByteArray; procedure ResetRegs; begin // Set up the registers of the state machine address := 0; sourceFile := 1; line := 1; column := 0; isStatement := header.defaultIsStatement <> 0; basicBlock := false; end; procedure LoadFile(st: string); var dirIndex: integer; st2: string; begin dirIndex := debugLine.ReadLEB128; if (dirIndex > -1) and (dirIndex < cunit.dirs.Count) then begin st2 := cunit.dirs.Strings[dirIndex]; if st2 <> '' then st2 := st2 + '\' + st else st2 := st; if building then cunit.files.AddObject(st2, loadSourceFile(st2)); end; debugLine.ReadLEB128; // skip the time debugLine.ReadLEB128; // skip the length end; // Appends a row to the matrix procedure AppendRow; var st: TStringList; i: integer; begin if isStatement and building and (cunit.files <> nil) then begin if (sourceFile > 0) and (sourceFile <= cunit.files.Count) then begin if findFile(cunit.files.Strings[sourceFile-1]) <> nil then vmAddBreakpoint(address, true); st := TStringList(cunit.files.Objects[sourceFile-1]); if st <> nil then begin i := line-1; if (i >= 0) and (i < st.Count) then st.Objects[i] := TObject(address); end; end; end; end; var st: string; temp: pointer; i: uint32; opcode: byte; begin // Initialization Result := false; if cunit = nil then Exit; if (cunit.statementOffset >= debugLine.size) then Exit; debugLine.Seek(cunit.statementOffset); // Read in the fixed portion of the prologue debugLine.ReadBlock(header, SizeOf(TDwarfStatementPrologue)); if header.lineRange = 0 then header.lineRange := 1; // Read in the standard opcode sizes if header.opcodeBase > 0 then begin GetMem(sizes, header.opcodeBase-1); for i := 0 to header.opcodeBase - 2 do sizes^[i] := debugLine.ReadUint8; end else begin logWriteLn('Error: Line program state machine opcode base cannot be 0'); Exit; end; if building then begin // Read in the include directories cunit.dirs.Clear; cunit.dirs.Add(dwarf.baseDir); st := debugLine.ReadString; while st <> '' do begin cunit.dirs.Add(st); st := debugLine.ReadString; end; // Read in the contributing files cunit.files.Clear; repeat st := debugLine.ReadString; if st <> '' then LoadFile(st); until st = ''; cunit.rStatementOffset := uint32(debugLine.dataPointer) - uint32(debugLine.data) - uint32(cunit.statementOffset); end else debugLine.Seek(cunit.rStatementOffset); // Set up the registers of the state machine ResetRegs; endSequence := false; // Run the program temp := pointer(header.totalLength + 4 + uint32(debugLine.data) + cunit.statementOffset); if uint32(temp) > debugLine.size + uint32(debugLine.data) then begin // Clean up logWriteLn('Dwarf Processor: Invalid state machine segment'); FreeMem(sizes, header.opcodeBase-1); Exit; end; // logWriteLn(Format('tl = %d temp = %8.8x dp = %8.8x', [header.totalLength, uint32(temp), uint32(datapointer)])); while integer(debugLine.dataPointer) < integer(temp) do begin // logwrite('.'); // Check for the target address and leave if (address = target) and not building then begin if (sourceFile <= cunit.files.Count) and (sourceFile > 0) then begin hit.line := line; hit.column := column; hit.isStatement := isStatement; hit.basicBlock := basicBlock; hit.endSequence := endSequence; hit.filename := cunit.files.Strings[sourceFile-1]; Result := true; end; Break; end; // Process the opcode opcode := debugLine.ReadUint8; if opcode < header.opcodeBase then case opcode of DW_LNS_extended_opcode: begin debugLine.ReadUint8; opcode := debugLine.ReadUint8; case opcode of DW_LNE_end_sequence: begin endSequence := true; AppendRow; ResetRegs; end; DW_LNE_set_address: address := debugLine.ReadAddress; DW_LNE_define_file: begin st := debugLine.ReadString; if st <> '' then LoadFile(st); end; end; end; DW_LNS_copy: begin AppendRow; basicBlock := false; end; DW_LNS_advance_pc: address := address + debugLine.ReadLEB128 * header.minInstructionLength; DW_LNS_advance_line: line := line + debugLine.ReadSLEB128; DW_LNS_set_file: sourceFile := debugLine.ReadLEB128; DW_LNS_set_column: column := debugLine.ReadLEB128; DW_LNS_negate_stmt: isStatement := not isStatement; DW_LNS_set_basic_block: basicBlock := true; DW_LNS_const_add_pc: address := address + uint32(((255-header.opcodeBase) div header.lineRange) * header.minInstructionLength); DW_LNS_fixed_advance_pc: address := address + debugLine.ReadUint16; else // Parse an unknown standard opcode by skipping its operands for i := 1 to sizes[opcode] do debugLine.ReadLEB128; end else begin // Parse a special opcode opcode := opcode - header.opcodeBase; line := line + header.lineBase + opcode mod header.lineRange; address := address + (opcode div header.lineRange) * header.minInstructionLength; AppendRow; basicBlock := false; end; end; // Clean up if header.opcodeBase > 0 then FreeMem(sizes, header.opcodeBase-1); end; ////////////////////////////////////////////////////////////////////// // Needs to be pointed towards the .debug_pubnames section for a compilation unit procedure ProcessNameLookups(var list: TStringList); var header: TPubnamesUnitHeader; offset: uint32; begin if assigned(debugPubNames) then begin debugPubNames.Seek(0); debugPubNames.ReadBlock(header, SizeOf(TPubnamesUnitHeader)); repeat offset := debugPubNames.ReadUint32; if offset > 0 then list.AddObject(debugPubNames.ReadString, TObject(header.offset+offset)) else Break until false; end; end; ////////////////////////////////////////////////////////////////////// (* procedure ProcessAddressLookups(var rangeData: TARangeData); var header: TARangesUnitHeader; i: integer; begin ReadBlock(header, SizeOf(TARangesUnitHeader)); for i := 1 to SizeOf(TARangesUnitHeader) mod (SizeOf(uint32)*2) do ReadUint8; rangeData.data := dataPointer; rangeData.count := 0; while not ((rangeData.data^[rangeData.count].start = 0) and (rangeData.data^[rangeData.count].size = 0)) do Inc(rangeData.count); end; *) ////////////////////////////////////////////////////////////////////// function ProcessDWARF(elf: TELFFile; dir: string): TDwarfFile; var offset: uint32; compUnit: TCompilationUnit; begin logWriteLn('Processing DWARF file'); Result := TDwarfFile.Create; Dwarf := Result; Result.baseDir := Copy(dir, 1, Length(dir)-1); // Find sections debugAbbrev := elf.FindSectionByName('.debug_abbrev'); debugAranges := elf.FindSectionByName('.debug_aranges'); debugFrame := elf.FindSectionByName('.debug_frame'); debugInfo := elf.FindSectionByName('.debug_info'); debugLine := elf.FindSectionByName('.debug_line'); debugLoc := elf.FindSectionByName('.debug_loc'); debugMacInfo := elf.FindSectionByName('.debug_macinfo'); debugPubNames := elf.FindSectionByName('.debug_pubnames'); debugStr := elf.FindSectionByName('.debug_str'); // Fixme: verify that we have all the sections we need if (debugInfo = nil) or (debugAbbrev = nil) then Exit; offset := 0; while offset < debugInfo.size do begin debugInfo.Seek(offset); compUnit := TCompilationUnit.Create; dwarf.compUnits.Add(compUnit); offset := offset + compUnit.unitLength + 4; end; { ProcessNameLookups(dwarf.varList); if dwarf.varList.Count > 0 then begin logWrite(dwarf.varList.Strings[0]); for i := 1 to dwarf.varList.count-1 do logWrite(', ' + dwarf.varList.Strings[i]); logWriteLn('.'); end;} end; ////////////////////////////////////////////////////////////////////// function FindAttribute(node: PDwarfNode; name: uint32): PDwarfAttribute; var attrib: PDwarfAttribute; begin Result := nil; attrib := node^.attribs; while attrib <> nil do begin if attrib^.name = name then begin Result := attrib; Exit; end; attrib := attrib^.next; end; end; ////////////////////////////////////////////////////////////////////// procedure ReadSubroutine(cunit: TCompilationUnit; node: PDwarfNode); var attrib: PDwarfAttribute; sub: TDwarfSubroutine; begin sub := TDwarfSubroutine.Create; sub.node := node; // Read the name attrib := FindAttribute(node, DW_AT_name); if attrib <> nil then sub.name := attrib^.st else sub.name := ''; // Read the PC ranges attrib := FindAttribute(node, DW_AT_low_pc); if attrib = nil then sub.lowPC := $FFFFFFFF else sub.lowPC := attrib^.address; attrib := FindAttribute(node, DW_AT_high_pc); if attrib = nil then sub.highPC := 0 else sub.highPC := attrib^.address; // Read the possible declaration position in the source code attrib := FindAttribute(node, DW_AT_decl_file); if attrib = nil then sub.fileIndex := 0 else sub.fileIndex := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_line); if attrib = nil then sub.line := 0 else sub.line := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_column); if attrib = nil then sub.column := 0 else sub.column := attrib^.data; cunit.functions.AddObject(sub.name, sub); logWriteLn(Format('Function "%s" compiles to %8.8x..%8.8x, defined in file %d at (%d: %d)', [sub.name, sub.lowPC, sub.highPC, sub.fileIndex, sub.line, sub.column])); end; ////////////////////////////////////////////////////////////////////// procedure ReadVariable(cunit: TCompilationUnit; node: PDwarfNode); var attrib: PDwarfAttribute; v: TDwarfVariable; begin v := TDwarfVariable.Create; v.node := node; // Read the name attrib := FindAttribute(node, DW_AT_name); if attrib <> nil then v.name := attrib^.st else v.name := ''; // if its defining, it'll have a DW_AT_location, otherwise, it // will have a DW_AT_declaration // however, if its missing the DW_AT_declaration, and the // DW_AT_location is also missing or if it describes a null entry // then the variable was in the source code, but not in the compiled // program, i.e. unused variables compiled out // C++ union/struct/class defining declarations will have a // DW_AT_specification attribute and will not duplicate any data // contained in the DW_AT_specs pointed to // Read the possible declaration position in the source code attrib := FindAttribute(node, DW_AT_decl_file); if attrib = nil then v.fileIndex := 0 else v.fileIndex := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_line); if attrib = nil then v.line := 0 else v.line := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_column); if attrib = nil then v.column := 0 else v.column := attrib^.data; attrib := FindAttribute(node, DW_AT_location); if attrib <> nil then v.loc := attrib; attrib := FindAttribute(node, DW_AT_type); if attrib <> nil then v.typ := attrib; attrib := FindAttribute(v.node, DW_AT_start_scope); if attrib <> nil then v.startScope := attrib.address else v.startScope := 0; cunit.variables.AddObject(v.name, v); logWriteLn(Format('Variable "%s", defined in file %d at (%d: %d)', [v.name, v.fileIndex, v.line, v.column])); end; ////////////////////////////////////////////////////////////////////// function dwarfLookupVal(cmd: string): string; var cunit: TCompilationUnit; i: integer; v: TDwarfVariable; inReg, notOptimized: boolean; addr: uint32; begin logwriteln('fixme in dwarfLookupVal'); Result := cmd + ' is not accessable at this location or the expression is too complex'; if Assigned(dwarf) then begin // Find the current compilation unit cunit := Dwarf.FindContainingUnit(vmCurrentPC); if cunit <> nil then begin i := cunit.variables.IndexOf(cmd); if i > -1 then begin v := TDwarfVariable(cunit.variables.Objects[i]); // Result := Format('defined in %d at (%d: %d)', [v.fileIndex, v.line, v.column]); if Assigned(v.loc) and (v.startScope <= vmCurrentPC) then begin addr := LocationSM(v.loc.block, inReg, notOptimized); if inReg then begin addr := addr and 15; Result := Format('%s is %8.8x, in r%d', [cmd, vmGetRegister(addr), addr]); end else begin Result := Format('%s is %8.8x, at u32[$%8.8x]', [cmd, vmReadWord(addr), addr]); end; end; end; end; end; logWriteLn(Result); end; ////////////////////////////////////////////////////////////////////// procedure ReadType(cunit: TCompilationUnit; node: PDwarfNode); var attrib: PDwarfAttribute; v: TDwarfType; begin v := TDwarfType.Create; v.node := node; // Read the name attrib := FindAttribute(node, DW_AT_name); if attrib <> nil then v.name := attrib^.st else v.name := ''; // Read the possible declaration position in the source code attrib := FindAttribute(node, DW_AT_decl_file); if attrib = nil then v.fileIndex := 0 else v.fileIndex := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_line); if attrib = nil then v.line := 0 else v.line := attrib^.data; attrib := FindAttribute(node, DW_AT_decl_column); if attrib = nil then v.column := 0 else v.column := attrib^.data; cunit.types.AddObject(v.name, v); logWriteLn(Format('Type "%s", defined in file %d at (%d: %d)', [v.name, v.fileIndex, v.line, v.column])); end; ////////////////////////////////////////////////////////////////////// procedure ProcessNode(cunit: TCompilationUnit; node: PDwarfNode); var attrib: PDwarfAttribute; hitless: TLineHit; begin while node <> nil do begin case node^.tag of DW_TAG_array_type: ; DW_TAG_class_type: ; DW_TAG_entry_point: ; DW_TAG_enumeration_type: ; DW_TAG_formal_parameter: ; DW_TAG_imported_declaration: ; DW_TAG_label: ; DW_TAG_lexical_block: ; DW_TAG_member: ; DW_TAG_pointer_type: ; DW_TAG_reference_type: ; DW_TAG_compile_unit: begin attrib := FindAttribute(node, DW_AT_language); if attrib = nil then cunit.lang := DW_LANG_C89 else cunit.lang := attrib^.data; // if (cunit.lang <> DW_LANG_C89) and (cunit.lang <> DW_LANG_C) and (cunit.lang <> DW_LANG_C_plus_plus) then // raise EBadDwarf.CreateFmt('DWARF compilation unit contains an unsupported language %s', [DwarfLangToString(cunit.lang)]); // Read the PC ranges attrib := FindAttribute(node, DW_AT_low_pc); if attrib = nil then cunit.lowPC := $FFFFFFFF else cunit.lowPC := attrib^.address; attrib := FindAttribute(node, DW_AT_high_pc); if attrib = nil then cunit.highPC := 0 else cunit.highPC := attrib^.address; // Read the statement offset attrib := FindAttribute(node, DW_AT_stmt_list); if attrib <> nil then begin cunit.statementOffset := attrib^.data; DoLineProgram(true, cunit, 0, hitless); end else cunit.statementOffset := $FFFFFFFF; // Read the macro offset attrib := FindAttribute(node, DW_AT_macro_info); if attrib <> nil then cunit.macroOffset := attrib^.address; logWriteLn(Format('*** Compilation Unit with a range of %.8x to %.8x', [cunit.lowPC, cunit.highPC])); end; DW_TAG_string_type: ; DW_TAG_structure_type: ; DW_TAG_subroutine_type: ; DW_TAG_typedef: ; DW_TAG_union_type: ; DW_TAG_unspecified_parameters: ; DW_TAG_variant: ; DW_TAG_common_block: ; DW_TAG_common_inclusion: ; DW_TAG_inheritance: ; DW_TAG_inlined_subroutine: ; DW_TAG_module: ; DW_TAG_ptr_to_member_type: ; // DW_TAG_set_type: ; DW_TAG_subrange_type: ; // DW_TAG_with_stmt: ; DW_TAG_access_declaration: ; DW_TAG_base_type: ReadType(cunit, node); DW_TAG_catch_block: ; DW_TAG_const_type: ; DW_TAG_constant: ; DW_TAG_enumerator: ; DW_TAG_file_type: ; DW_TAG_friend: ; DW_TAG_namelist: ; DW_TAG_namelist_item: ; DW_TAG_packed_type: ; DW_TAG_subprogram: ReadSubroutine(cunit, node); DW_TAG_template_type_param: ; DW_TAG_template_value_param: ; DW_TAG_thrown_type: ; DW_TAG_try_block: ; DW_TAG_variant_part: ; DW_TAG_variable: ReadVariable(cunit, node); DW_TAG_volatile_type: ; end; if node.hasChildren then ProcessNode(cunit, node^.kids); node := node^.next; end; end; ////////////////////////////////////////////////////////////////////// function ExamineVariable(name: string): integer; var compUnit: TCompilationUnit; // attrib: PDwarfAttribute; i: integer; v: TDwarfVariable; inReg, notOptimized: boolean; addr: uint32; currentPC: uint32; begin Result := 0; if not assigned(dwarf) then Exit; currentPC := vmCurrentPC; compUnit := dwarf.FindContainingUnit(currentPC); if compUnit <> nil then begin for i := 0 to compUnit.variables.Count - 1 do begin v := TDwarfVariable(compUnit.variables.Objects[i]); if v.name = name then begin if Assigned(v.loc) and (v.startScope <= currentPC) then begin addr := LocationSM(v.loc.block, inReg, notOptimized); if inReg then Result := vmGetRegister(addr and 15) else Result := vmReadWord(addr); end; Exit; end; end; end; end; ////////////////////////////////////////////////////////////////////// procedure WalkVariables(var res: TStringList); var compUnit: TCompilationUnit; // attrib: PDwarfAttribute; i, k: integer; v: TDwarfVariable; inReg, notOptimized: boolean; addr: uint32; begin if not assigned(dwarf) then Exit; res.clear; res.Add('Valid variables at PC = ' + IntToHex(vmCurrentPC, 8)); for k := 0 to dwarf.compUnits.Count - 1 do begin compUnit := TCompilationUnit(dwarf.compUnits[k]); if (vmCurrentPC >= compUnit.lowPC) and (vmCurrentPC <= compUnit.highPC) then begin for i := 0 to compUnit.variables.Count - 1 do begin v := TDwarfVariable(compUnit.variables.Objects[i]); // attrib := FindAttribute(v.node, DW_AT_location); if Assigned(v.loc) and (v.startScope <= vmCurrentPC) then begin addr := LocationSM(v.loc.block, inReg, notOptimized); if inReg then begin addr := addr and 15; res.Add(Format('%s is $%8.8x, in r%d', [v.name, vmGetRegister(addr), addr])); end else begin res.Add(Format('%s is $%8.8x, at u32[$%8.8x]', [v.name, vmReadWord(addr), addr])); end; end; end; end; end; for i := 0 to res.count - 1 do logWriteLn(res.strings[i]); end; ////////////////////////////////////////////////////////////////////// function conWalkVariables(params: string): string; var junk: TStringList; begin junk := TStringList.Create; WalkVariables(junk); junk.Free; end; ////////////////////////////////////////////////////////////////////// // TDwarfFile //////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// constructor TDwarfFile.Create; begin varList := TStringList.Create; compUnits := TObjectList.Create; end; ////////////////////////////////////////////////////////////////////// destructor TDwarfFile.Destroy; begin logWriteLn('Clearing DWARF file'); varList.Free; compUnits.Free; closeSourceFiles; inherited; end; ////////////////////////////////////////////////////////////////////// procedure TDwarfFile.DestroyNode(node: PDwarfNode); var lastNode: PDwarfNode; lastAttrib, attrib: PDwarfAttribute; begin // Destroy a node and all of its siblings while node <> nil do begin // Free the attributes attrib := node^.attribs; while attrib <> nil do begin lastAttrib := attrib; attrib := attrib^.next; FreeMem(lastAttrib, SizeOf(TDwarfAttribute)); end; // Recursively wax all the children if node.hasChildren then DestroyNode(node^.kids); // Free the node lastNode := node; node := node^.next; FreeMem(lastNode, SizeOf(TDwarfNode)); end; end; ////////////////////////////////////////////////////////////////////// function TDwarfFile.FindContainingUnit(address: uint32): TCompilationUnit; var i: integer; cunit: TCompilationUnit; begin Result := nil; for i := 0 to dwarf.compUnits.Count - 1 do begin cunit := TCompilationUnit(dwarf.compUnits.Items[i]); if (address >= cunit.lowPC) and (address < cunit.highPC) then begin Result := cunit; Exit; end; end; end; ////////////////////////////////////////////////////////////////////// // TCompilationUnit ////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////// constructor TCompilationUnit.Create; begin // Read the compilation unit header unitLength := debugInfo.ReadUint32; producerVersion := debugInfo.ReadUint16; abbrevOffset := debugInfo.ReadUint32; addressSize := debugInfo.ReadUint8; // Chunk out some memory dirs := TStringList.Create; files := TStringList.Create; functions := TStringList.Create; types := TStringList.Create; classes := TStringList.Create; variables := TStringList.Create; // Read all the nodes in the compilation unit rootNode := ReadNode(self); // Read all the nodes hither and dither ProcessNode(self, rootNode); end; ////////////////////////////////////////////////////////////////////// destructor TCompilationUnit.Destroy; begin // Free all of the nodes that belong to this compilation unit dwarf.DestroyNode(rootNode); // Free the string lists variables.Free; classes.Free; types.Free; functions.Free; files.Free; dirs.Free; end; ////////////////////////////////////////////////////////////////////// begin logAddCommand('expressionEvaluator', dwarfLookupVal, 'Evaluates an expression'); logAddCommand('walkVariables', conWalkVariables, 'Display active variables if valid DWARF data is present'); end. //////////////////////////////////////////////////////////////////////