1 { 2 Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl 3 4 This units contains support for DWARF debug info generation 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 { 23 This units contains support for DWARF debug info generation. 24 25 Currently a lot of code looks like being mergable with dbgstabs. This might 26 change however when improved dwarf info is generated, so the stuff shouldn't be 27 merged yet. (FK) 28 29 The easiest way to debug dwarf debug info generation is the usage of 30 readelf --debug-dump <executable> 31 This works only with elf targets though. 32 33 There is a similar utility called dwarfdump which is not elf-specific and 34 which has been ported to most systems. 35 } 36 unit dbgdwarf; 37 38 {$i fpcdefs.inc} 39 40 interface 41 42 uses 43 cclasses,globtype, 44 cgbase, 45 aasmbase,aasmtai,aasmdata, 46 symbase,symconst,symtype,symdef,symsym, 47 finput, 48 DbgBase; 49 50 type 51 { Tag names and codes. } 52 tdwarf_tag = (DW_TAG_padding := $00,DW_TAG_array_type := $01, 53 DW_TAG_class_type := $02,DW_TAG_entry_point := $03, 54 DW_TAG_enumeration_type := $04,DW_TAG_formal_parameter := $05, 55 DW_TAG_imported_declaration := $08,DW_TAG_label := $0a, 56 DW_TAG_lexical_block := $0b,DW_TAG_member := $0d, 57 DW_TAG_pointer_type := $0f,DW_TAG_reference_type := $10, 58 DW_TAG_compile_unit := $11,DW_TAG_stringtypee := $12, 59 DW_TAG_structure_type := $13,DW_TAG_subroutine_type := $15, 60 DW_TAG_typedef := $16,DW_TAG_union_type := $17, 61 DW_TAG_unspecified_parameters := $18, 62 DW_TAG_variant := $19,DW_TAG_common_block := $1a, 63 DW_TAG_common_inclusion := $1b,DW_TAG_inheritance := $1c, 64 DW_TAG_inlined_subroutine := $1d,DW_TAG_module := $1e, 65 DW_TAG_ptr_to_member_type := $1f,DW_TAG_set_type := $20, 66 DW_TAG_subrange_type := $21,DW_TAG_with_stmt := $22, 67 DW_TAG_access_declaration := $23,DW_TAG_base_type := $24, 68 DW_TAG_catch_block := $25,DW_TAG_const_type := $26, 69 DW_TAG_constant := $27,DW_TAG_enumerator := $28, 70 DW_TAG_file_type := $29,DW_TAG_friend := $2a, 71 DW_TAG_namelist := $2b,DW_TAG_namelist_item := $2c, 72 DW_TAG_packed_type := $2d,DW_TAG_subprogram := $2e, 73 DW_TAG_template_type_param := $2f,DW_TAG_template_value_param := $30, 74 DW_TAG_thrown_type := $31,DW_TAG_try_block := $32, 75 DW_TAG_variant_part := $33,DW_TAG_variable := $34, 76 DW_TAG_volatile_type := $35, 77 { DWARF 3. } 78 DW_TAG_dwarf_procedure := $36, 79 DW_TAG_restrict_type := $37,DW_TAG_interface_type := $38, 80 DW_TAG_namespace := $39,DW_TAG_imported_module := $3a, 81 DW_TAG_unspecified_type := $3b,DW_TAG_partial_unit := $3c, 82 DW_TAG_imported_unit := $3d, 83 DW_TAG_condition := $3f, 84 DW_TAG_shared_type := $40, 85 86 { DWARF 4 } 87 DW_TAG_type_unit := $41, 88 DW_TAG_rvalue_reference_type := $42, 89 DW_TAG_template_alias := $43, 90 91 92 { SGI/MIPS Extensions. } 93 DW_TAG_MIPS_loop := $4081, 94 95 { HP extensions. See: ftp://ftp.hp.com/pub/lang/tools/WDB/wdb-4.0.tar.gz . } 96 DW_TAG_HP_array_descriptor := $4090, 97 98 { GNU extensions. } 99 { For FORTRAN 77 and Fortran 90. } 100 DW_TAG_format_label := $4101, 101 { For C++. } 102 DW_TAG_function_template := $4102,DW_TAG_class_template := $4103, 103 104 DW_TAG_GNU_BINCL := $4104,DW_TAG_GNU_EINCL := $4105, 105 { Extensions for UPC. See: http://upc.gwu.edu/~upc. } 106 DW_TAG_upc_shared_type := $8765,DW_TAG_upc_strict_type := $8766, 107 DW_TAG_upc_relaxed_type := $8767, 108 109 { PGI (STMicroelectronics) extensions. No documentation available. } 110 DW_TAG_PGI_kanji_type := $A000, 111 DW_TAG_PGI_interface_block := $A020 112 ); 113 114 {$push} 115 {$notes off} 116 { Attribute names and codes. } 117 tdwarf_attribute = (DW_AT_sibling := $01,DW_AT_location := $02, 118 DW_AT_name := $03,DW_AT_ordering := $09, 119 DW_AT_subscr_data := $0a,DW_AT_byte_size := $0b, 120 DW_AT_bit_offset := $0c,DW_AT_bit_size := $0d, 121 DW_AT_element_list := $0f,DW_AT_stmt_list := $10, 122 DW_AT_low_pc := $11,DW_AT_high_pc := $12, 123 DW_AT_language := $13,DW_AT_member := $14, 124 DW_AT_discr := $15,DW_AT_discr_value := $16, 125 DW_AT_visibility := $17,DW_AT_import := $18, 126 DW_AT_string_length := $19,DW_AT_common_reference := $1a, 127 DW_AT_comp_dir := $1b,DW_AT_const_value := $1c, 128 DW_AT_containing_type := $1d,DW_AT_default_value := $1e, 129 DW_AT_inline := $20,DW_AT_is_optional := $21, 130 DW_AT_lower_bound := $22,DW_AT_producer := $25, 131 DW_AT_prototyped := $27,DW_AT_return_addr := $2a, 132 DW_AT_start_scope := $2c,DW_AT_stride_size := $2e, 133 DW_AT_upper_bound := $2f,DW_AT_abstract_origin := $31, 134 DW_AT_accessibility := $32,DW_AT_address_class := $33, 135 DW_AT_artificial := $34,DW_AT_base_types := $35, 136 DW_AT_calling_convention := $36,DW_AT_count := $37, 137 DW_AT_data_member_location := $38,DW_AT_decl_column := $39, 138 DW_AT_decl_file := $3a,DW_AT_decl_line := $3b, 139 DW_AT_declaration := $3c,DW_AT_discr_list := $3d, 140 DW_AT_encoding := $3e,DW_AT_external := $3f, 141 DW_AT_frame_base := $40,DW_AT_friend := $41, 142 DW_AT_identifier_case := $42,DW_AT_macro_info := $43, 143 DW_AT_namelist_items := $44,DW_AT_priority := $45, 144 DW_AT_segment := $46,DW_AT_specification := $47, 145 DW_AT_static_link := $48,DW_AT_type := $49, 146 DW_AT_use_location := $4a,DW_AT_variable_parameter := $4b, 147 DW_AT_virtuality := $4c,DW_AT_vtable_elem_location := $4d, 148 149 { DWARF 3 values. } 150 DW_AT_allocated := $4e,DW_AT_associated := $4f, 151 DW_AT_data_location := $50,DW_AT_byte_stride := $51, 152 DW_AT_entry_pc := $52,DW_AT_use_UTF8 := $53, 153 DW_AT_extension := $54,DW_AT_ranges := $55, 154 DW_AT_trampoline := $56,DW_AT_call_column := $57, 155 DW_AT_call_file := $58,DW_AT_call_line := $59, 156 DW_AT_description := $5a, { string } 157 DW_AT_binary_scale := $5b, { constant } 158 DW_AT_decimal_scale := $5c, { constant } 159 DW_AT_small := $5d, { reference } 160 DW_AT_decimal_sign := $5e, { constant } 161 DW_AT_digit_count := $5f, { constant } 162 DW_AT_picture_string := $60, { string } 163 DW_AT_mutable := $61, { flag } 164 DW_AT_threads_scaled := $62, { flag } 165 DW_AT_explicit := $63, { flag } 166 DW_AT_object_pointer := $64, { reference } 167 DW_AT_endianity := $65, { constant } 168 DW_AT_elemental := $66, { flag } 169 DW_AT_pure := $67, { flag } 170 DW_AT_recursive := $68, { flag } 171 172 { DWARF 4 values } 173 DW_AT_signature := $69, { reference } 174 DW_AT_main_subprogram := $6a, { flag } 175 DW_AT_data_bit_offset := $6b, { constant } 176 DW_AT_const_expr := $6c, { flag } 177 DW_AT_enum_class := $6d, { flag } 178 DW_AT_linkage_name := $6e, { string } 179 180 181 { SGI/MIPS extensions. } 182 DW_AT_MIPS_fde := $2001,DW_AT_MIPS_loop_begin := $2002, 183 DW_AT_MIPS_tail_loop_begin := $2003,DW_AT_MIPS_epilog_begin := $2004, 184 DW_AT_MIPS_loop_unroll_factor := $2005, 185 DW_AT_MIPS_software_pipeline_depth := $2006, 186 DW_AT_MIPS_linkage_name := $2007,DW_AT_MIPS_stride := $2008, 187 DW_AT_MIPS_abstract_name := $2009,DW_AT_MIPS_clone_origin := $200a, 188 DW_AT_MIPS_has_inlines := $200b, 189 190 { HP extensions. } 191 DW_AT_HP_block_index := $2000, 192 DW_AT_HP_unmodifiable := $2001,DW_AT_HP_actuals_stmt_list := $2010, 193 DW_AT_HP_proc_per_section := $2011,DW_AT_HP_raw_data_ptr := $2012, 194 DW_AT_HP_pass_by_reference := $2013,DW_AT_HP_opt_level := $2014, 195 DW_AT_HP_prof_version_id := $2015,DW_AT_HP_opt_flags := $2016, 196 DW_AT_HP_cold_region_low_pc := $2017,DW_AT_HP_cold_region_high_pc := $2018, 197 DW_AT_HP_all_variables_modifiable := $2019, 198 DW_AT_HP_linkage_name := $201a,DW_AT_HP_prof_flags := $201b, 199 200 { WATCOM extensions. } 201 DW_AT_WATCOM_memory_model := $2082, 202 DW_AT_WATCOM_references_start := $2083, 203 DW_AT_WATCOM_parm_entry := $2084, 204 205 { GNU extensions. } 206 DW_AT_sf_names := $2101,DW_AT_src_info := $2102, 207 DW_AT_mac_info := $2103,DW_AT_src_coords := $2104, 208 DW_AT_body_begin := $2105,DW_AT_body_end := $2106, 209 DW_AT_GNU_vector := $2107, 210 211 { VMS extensions. } 212 DW_AT_VMS_rtnbeg_pd_address := $2201, 213 214 { UPC extension. } 215 DW_AT_upc_threads_scaled := $3210, 216 217 { PGI (STMicroelectronics) extensions. } 218 DW_AT_PGI_lbase := $3a00, 219 DW_AT_PGI_soffset := $3a01,DW_AT_PGI_lstride := $3a02, 220 221 { Apple extensions } 222 DW_AT_APPLE_optimized := $3fe1, 223 DW_AT_APPLE_flags := $3fe2, 224 DW_AT_APPLE_major_runtime_vers := $3fe5, 225 DW_AT_APPLE_runtime_class := $3fe6 226 ); 227 {$pop} 228 229 { Form names and codes. } 230 Tdwarf_form = (DW_FORM_addr := $01,DW_FORM_block2 := $03, 231 DW_FORM_block4 := $04,DW_FORM_data2 := $05, 232 DW_FORM_data4 := $06,DW_FORM_data8 := $07, 233 DW_FORM_string := $08,DW_FORM_block := $09, 234 DW_FORM_block1 := $0a,DW_FORM_data1 := $0b, 235 DW_FORM_flag := $0c,DW_FORM_sdata := $0d, 236 DW_FORM_strp := $0e,DW_FORM_udata := $0f, 237 DW_FORM_ref_addr := $10,DW_FORM_ref1 := $11, 238 DW_FORM_ref2 := $12,DW_FORM_ref4 := $13, 239 DW_FORM_ref8 := $14,DW_FORM_ref_udata := $15, 240 DW_FORM_indirect := $16, 241 242 { DWARF 4 } 243 DW_FORM_sec_offset := $17, { lineptr, loclistptr, macptr, rangelistptr } 244 DW_FORM_exprloc := $18, { exprloc } 245 DW_FORM_flag_present := $19, { flag } 246 DW_FORM_ref_sig8 := $20 { reference } 247 ); 248 249 { values of DW_AT_address_class } 250 Tdwarf_addr = ( 251 DW_ADDR_none := 0, 252 DW_ADDR_near16 := 1, 253 DW_ADDR_far16 := 2, 254 DW_ADDR_huge16 := 3, 255 DW_ADDR_near32 := 4, 256 DW_ADDR_far32 := 5 257 ); 258 259 { values of DW_AT_WATCOM_memory_model } 260 Tdwarf_watcom_memory_model = ( 261 DW_WATCOM_MEMORY_MODEL_none := 0, 262 DW_WATCOM_MEMORY_MODEL_flat := 1, 263 DW_WATCOM_MEMORY_MODEL_small := 2, 264 DW_WATCOM_MEMORY_MODEL_medium := 3, 265 DW_WATCOM_MEMORY_MODEL_compact := 4, 266 DW_WATCOM_MEMORY_MODEL_large := 5, 267 DW_WATCOM_MEMORY_MODEL_huge := 6 268 ); 269 270 TDwarfFile = record 271 Index: integer; 272 Name: PChar; 273 end; 274 275 { flags for emitting variables/parameters } 276 tdwarfvarsymflag = 277 { force the sym to be emitted as a local variable regardless of its 278 type; used for "absolute" local variables referring to parameters. 279 } 280 (dvf_force_local_var 281 ); 282 tdwarfvarsymflags = set of tdwarfvarsymflag; 283 284 pAbbrevSearchTreeItem = ^tAbbrevSearchTreeItem; 285 tAbbrevSearchTreeItem = record 286 value: QWord; 287 Abbrev: longint; 288 // When this item does not match the abbrev-value, look for it 289 // in the next SearchItem 290 SearchItem: pAbbrevSearchTreeItem; 291 // Next and prior item of the abbrev-section 292 NextItem: pAbbrevSearchTreeItem; 293 PriorItem: pAbbrevSearchTreeItem; 294 bit8: boolean; 295 end; 296 297 TDwarfHashSetItem = record 298 HashSetItem: THashSetItem; 299 lab, ref_lab: tasmsymbol; 300 struct_lab: tasmsymbol; 301 end; 302 PDwarfHashSetItem = ^TDwarfHashSetItem; 303 304 TDwarfLabHashSet = class(THashSet) SizeOfItemnull305 class function SizeOfItem: Integer; override; 306 end; 307 308 { TDebugInfoDwarf } 309 310 TDebugInfoDwarf = class(TDebugInfo) 311 private 312 currabbrevnumber : longint; 313 314 { use this defs to create info for variants and file handles } 315 { unused (MWE) 316 filerecdef, 317 textrecdef : tdef; 318 } 319 320 dirlist: TFPHashObjectList; 321 filesequence: Integer; 322 loclist: tdynamicarray; 323 asmline: TAsmList; 324 325 { lookup table for def -> DWARF-labels } 326 dwarflabels: TDwarfLabHashSet; 327 328 // The current entry in dwarf_info with the link to the abbrev-section 329 dwarf_info_abbref_tai: tai_const; 330 // Empty start-item of the abbrev-searchtree 331 AbbrevSearchTree: pAbbrevSearchTreeItem; 332 // The current abbrev-item 333 CurrentSearchTreeItem: pAbbrevSearchTreeItem; 334 // Is true when the abbrev-section is newly created 335 NewAbbrev: boolean; 336 procedure StartAbbrevSearch; 337 procedure AddConstToAbbrev(Value: QWord; bit8:boolean=false); 338 procedure StartAbbrevSectionFromSearchtree; 339 procedure WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem); FinishAbbrevSearchnull340 function FinishAbbrevSearch: longint; 341 def_dwarf_labnull342 function def_dwarf_lab(def:tdef) : tasmsymbol; def_dwarf_ref_labnull343 function def_dwarf_ref_lab(def:tdef) : tasmsymbol; def_dwarf_class_struct_labnull344 function def_dwarf_class_struct_lab(def:tobjectdef) : tasmsymbol; get_file_indexnull345 function get_file_index(afile: tinputfile): Integer; relative_dwarf_pathnull346 function relative_dwarf_path(const s:tcmdstr):tcmdstr; 347 protected 348 // set if we should use 64bit headers (dwarf3 and up) 349 _use_64bit_headers: Boolean; 350 // set to ait_const32bit if use_64bit_headers is false, otherwise 351 // to ait_const64bit 352 offsetreltype, 353 offsetabstype : taiconst_type; 354 // set if we generated any lineinfo at all. If not, we have to terminate 355 // when insertmoduleinfo is called. 356 generated_lineinfo: boolean; 357 358 vardatadef: trecorddef; 359 360 procedure set_use_64bit_headers(state: boolean); 361 property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers; 362 get_def_dwarf_labsnull363 function get_def_dwarf_labs(def:tdef): PDwarfHashSetItem; 364 is_fbregnull365 function is_fbreg(reg:tregister):boolean; 366 367 { Convenience version of the method below, so the compiler creates the 368 tvarrec for us (must only pass one element in the last parameter). } 369 procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const); 370 procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec); 371 procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const); 372 procedure append_block1(attr: tdwarf_attribute; size: aint); 373 procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol); 374 procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); virtual; 375 procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol); 376 procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol); 377 procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol); 378 procedure append_labelentry_dataptr_common(attr : tdwarf_attribute); 379 procedure append_pointerclass(list:TAsmList;def:tpointerdef); 380 procedure append_proc_frame_base(list:TAsmList;def:tprocdef); 381 {$ifdef i8086} 382 procedure append_seg_name(const name:string); 383 procedure append_seg_reg(const segment_register:tregister); 384 {$endif i8086} 385 386 procedure beforeappenddef(list:TAsmList;def:tdef);override; 387 procedure afterappenddef(list:TAsmList;def:tdef);override; 388 procedure appenddef_ord(list:TAsmList;def:torddef);override; 389 procedure appenddef_float(list:TAsmList;def:tfloatdef);override; 390 procedure appenddef_enum(list:TAsmList;def:tenumdef);override; 391 procedure appenddef_array(list:TAsmList;def:tarraydef);override; 392 procedure appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring); 393 procedure appenddef_record(list:TAsmList;def:trecorddef);override; 394 procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override; 395 procedure appenddef_string(list:TAsmList;def:tstringdef);override; 396 procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override; 397 procedure appendprocdef(list:TAsmList;def:tprocdef);override; 398 get_symlist_sym_offsetnull399 function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean; 400 procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); 401 procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags); 402 { used for fields and properties mapped to fields } 403 procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint); 404 procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean); 405 406 procedure beforeappendsym(list:TAsmList;sym:tsym);override; 407 procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override; 408 procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override; 409 procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override; 410 procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override; 411 procedure appendsym_const(list:TAsmList;sym:tconstsym);override; 412 procedure appendsym_type(list:TAsmList;sym:ttypesym);override; 413 procedure appendsym_label(list:TAsmList;sym:tlabelsym);override; 414 procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override; 415 procedure appendsym_property(list:TAsmList;sym:tpropertysym);override; 416 symdebugnamenull417 function symdebugname(sym:tsym): String; virtual; symnamenull418 function symname(sym: tsym; manglename: boolean): String; virtual; 419 procedure append_visibility(vis: tvisibility); 420 421 procedure enum_membersyms_callback(p:TObject;arg:pointer); 422 423 procedure finish_children; 424 procedure finish_entry; 425 procedure finish_lineinfo; 426 public 427 constructor Create;override; 428 destructor Destroy;override; 429 procedure insertmoduleinfo;override; 430 procedure inserttypeinfo;override; 431 procedure referencesections(list:TAsmList);override; 432 procedure insertlineinfo(list:TAsmList);override; dwarf_versionnull433 function dwarf_version: Word; virtual; abstract; 434 end; 435 436 { TDebugInfoDwarf2 } 437 438 TDebugInfoDwarf2 = class(TDebugInfoDwarf) 439 private 440 protected 441 procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean); 442 procedure append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString); 443 444 procedure appenddef_file(list:TAsmList;def:tfiledef); override; 445 procedure appenddef_formal(list:TAsmList;def:tformaldef); override; 446 procedure appenddef_object(list:TAsmList;def:tobjectdef); override; 447 procedure appenddef_set(list:TAsmList;def:tsetdef); override; 448 procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override; 449 procedure appenddef_variant(list:TAsmList;def:tvariantdef); override; 450 public dwarf_versionnull451 function dwarf_version: Word; override; 452 end; 453 454 { TDebugInfoDwarf3 } 455 456 TDebugInfoDwarf3 = class(TDebugInfoDwarf2) 457 private 458 protected 459 procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); override; 460 procedure appenddef_array(list:TAsmList;def:tarraydef); override; 461 procedure appenddef_string(list:TAsmList;def:tstringdef);override; 462 procedure appenddef_file(list:TAsmList;def:tfiledef); override; 463 procedure appenddef_formal(list:TAsmList;def:tformaldef); override; 464 procedure appenddef_object(list:TAsmList;def:tobjectdef); override; 465 procedure appenddef_set(list:TAsmList;def: tsetdef); override; 466 procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override; 467 procedure appenddef_variant(list:TAsmList;def:tvariantdef); override; 468 symdebugnamenull469 function symdebugname(sym:tsym): String; override; 470 public dwarf_versionnull471 function dwarf_version: Word; override; 472 end; 473 474 475 TDebugInfoDwarf4 = class(TDebugInfoDwarf3) 476 public dwarf_versionnull477 function dwarf_version: Word; override; 478 end; 479 480 481 implementation 482 483 uses 484 sysutils,cutils,cfileutl,constexp, 485 version,globals,verbose,systems, 486 cpubase,cpuinfo,paramgr, 487 fmodule, 488 defutil,symtable,symcpu,ppu 489 {$ifdef OMFOBJSUPPORT} 490 ,dbgcodeview 491 {$endif OMFOBJSUPPORT} 492 ; 493 494 const 495 LINE_BASE = 1; 496 OPCODE_BASE = 13; 497 498 const 499 DW_TAG_lo_user = $4080; 500 DW_TAG_hi_user = $ffff; 501 502 { Flag that tells whether entry has a child or not. } 503 DW_children_no = 0; 504 DW_children_yes = 1; 505 506 const 507 { Implementation-defined range start. } 508 DW_AT_lo_user = $2000; 509 { Implementation-defined range end. } 510 DW_AT_hi_user = $3ff0; 511 512 type 513 { Source language names and codes. } 514 tdwarf_source_language = (DW_LANG_C89 := $0001,DW_LANG_C := $0002,DW_LANG_Ada83 := $0003, 515 DW_LANG_C_plus_plus := $0004,DW_LANG_Cobol74 := $0005, 516 DW_LANG_Cobol85 := $0006,DW_LANG_Fortran77 := $0007, 517 DW_LANG_Fortran90 := $0008,DW_LANG_Pascal83 := $0009, 518 DW_LANG_Modula2 := $000a,DW_LANG_Java := $000b, 519 520 { DWARF 3. } 521 DW_LANG_C99 := $000c,DW_LANG_Ada95 := $000d, 522 DW_LANG_Fortran95 := $000e, 523 524 { Objective-C } 525 DW_LANG_ObjC := $10, 526 527 { MIPS. } 528 DW_LANG_Mips_Assembler := $8001, 529 530 { UPC. } 531 DW_LANG_Upc := $8765 532 ); 533 534 const 535 { Implementation-defined range start. } 536 DW_LANG_lo_user = $8000; 537 538 { Implementation-defined range start. } 539 DW_LANG_hi_user = $ffff; 540 541 type 542 { Names and codes for macro information. } 543 tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2, 544 DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4, 545 DW_MACINFO_vendor_ext := 255); 546 547 548 type 549 { Type encodings. } 550 Tdwarf_type = (DW_ATE_void := $0,DW_ATE_address := $1, 551 DW_ATE_boolean := $2,DW_ATE_complex_float := $3, 552 DW_ATE_float := $4,DW_ATE_signed := $5, 553 DW_ATE_signed_char := $6,DW_ATE_unsigned := $7, 554 DW_ATE_unsigned_char := $8,DW_ATE_imaginary_float := $9, 555 556 { HP extensions. } 557 DW_ATE_HP_float80 := $80,DW_ATE_HP_complex_float80 := $81, 558 DW_ATE_HP_float128 := $82,DW_ATE_HP_complex_float128 := $83, 559 DW_ATE_HP_floathpintel := $84,DW_ATE_HP_imaginary_float80 := $85, 560 DW_ATE_HP_imaginary_float128 := $86 561 ); 562 563 564 const 565 DW_ATE_lo_user = $80; 566 DW_ATE_hi_user = $ff; 567 568 569 type 570 Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1 571 ); 572 573 { Access attribute. } 574 Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2, 575 DW_ACCESS_private := 3); 576 577 { Visibility. } 578 Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2, 579 DW_VIS_qualified := 3); 580 581 { Virtuality. } 582 Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1, 583 DW_VIRTUALITY_pure_virtual := 2); 584 585 { Case sensitivity. } 586 Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1, 587 DW_ID_down_case := 2,DW_ID_case_insensitive := 3 588 ); 589 590 { Calling convention. } 591 Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2, 592 DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40, DW_CC_GNU_borland_fastcall_i386 := $41 593 ); 594 {$push} 595 {$notes off} 596 { Location atom names and codes. } 597 Tdwarf_location_atom = (DW_OP_addr := $03,DW_OP_deref := $06,DW_OP_const1u := $08, 598 DW_OP_const1s := $09,DW_OP_const2u := $0a, 599 DW_OP_const2s := $0b,DW_OP_const4u := $0c, 600 DW_OP_const4s := $0d,DW_OP_const8u := $0e, 601 DW_OP_const8s := $0f,DW_OP_constu := $10, 602 DW_OP_consts := $11,DW_OP_dup := $12,DW_OP_drop := $13, 603 DW_OP_over := $14,DW_OP_pick := $15,DW_OP_swap := $16, 604 DW_OP_rot := $17,DW_OP_xderef := $18,DW_OP_abs := $19, 605 DW_OP_and := $1a,DW_OP_div := $1b,DW_OP_minus := $1c, 606 DW_OP_mod := $1d,DW_OP_mul := $1e,DW_OP_neg := $1f, 607 DW_OP_not := $20,DW_OP_or := $21,DW_OP_plus := $22, 608 DW_OP_plus_uconst := $23,DW_OP_shl := $24, 609 DW_OP_shr := $25,DW_OP_shra := $26,DW_OP_xor := $27, 610 DW_OP_bra := $28,DW_OP_eq := $29,DW_OP_ge := $2a, 611 DW_OP_gt := $2b,DW_OP_le := $2c,DW_OP_lt := $2d, 612 DW_OP_ne := $2e,DW_OP_skip := $2f,DW_OP_lit0 := $30, 613 DW_OP_lit1 := $31,DW_OP_lit2 := $32,DW_OP_lit3 := $33, 614 DW_OP_lit4 := $34,DW_OP_lit5 := $35,DW_OP_lit6 := $36, 615 DW_OP_lit7 := $37,DW_OP_lit8 := $38,DW_OP_lit9 := $39, 616 DW_OP_lit10 := $3a,DW_OP_lit11 := $3b, 617 DW_OP_lit12 := $3c,DW_OP_lit13 := $3d, 618 DW_OP_lit14 := $3e,DW_OP_lit15 := $3f, 619 DW_OP_lit16 := $40,DW_OP_lit17 := $41, 620 DW_OP_lit18 := $42,DW_OP_lit19 := $43, 621 DW_OP_lit20 := $44,DW_OP_lit21 := $45, 622 DW_OP_lit22 := $46,DW_OP_lit23 := $47, 623 DW_OP_lit24 := $48,DW_OP_lit25 := $49, 624 DW_OP_lit26 := $4a,DW_OP_lit27 := $4b, 625 DW_OP_lit28 := $4c,DW_OP_lit29 := $4d, 626 DW_OP_lit30 := $4e,DW_OP_lit31 := $4f, 627 DW_OP_reg0 := $50,DW_OP_reg1 := $51,DW_OP_reg2 := $52, 628 DW_OP_reg3 := $53,DW_OP_reg4 := $54,DW_OP_reg5 := $55, 629 DW_OP_reg6 := $56,DW_OP_reg7 := $57,DW_OP_reg8 := $58, 630 DW_OP_reg9 := $59,DW_OP_reg10 := $5a,DW_OP_reg11 := $5b, 631 DW_OP_reg12 := $5c,DW_OP_reg13 := $5d, 632 DW_OP_reg14 := $5e,DW_OP_reg15 := $5f, 633 DW_OP_reg16 := $60,DW_OP_reg17 := $61, 634 DW_OP_reg18 := $62,DW_OP_reg19 := $63, 635 DW_OP_reg20 := $64,DW_OP_reg21 := $65, 636 DW_OP_reg22 := $66,DW_OP_reg23 := $67, 637 DW_OP_reg24 := $68,DW_OP_reg25 := $69, 638 DW_OP_reg26 := $6a,DW_OP_reg27 := $6b, 639 DW_OP_reg28 := $6c,DW_OP_reg29 := $6d, 640 DW_OP_reg30 := $6e,DW_OP_reg31 := $6f, 641 DW_OP_breg0 := $70,DW_OP_breg1 := $71, 642 DW_OP_breg2 := $72,DW_OP_breg3 := $73, 643 DW_OP_breg4 := $74,DW_OP_breg5 := $75, 644 DW_OP_breg6 := $76,DW_OP_breg7 := $77, 645 DW_OP_breg8 := $78,DW_OP_breg9 := $79, 646 DW_OP_breg10 := $7a,DW_OP_breg11 := $7b, 647 DW_OP_breg12 := $7c,DW_OP_breg13 := $7d, 648 DW_OP_breg14 := $7e,DW_OP_breg15 := $7f, 649 DW_OP_breg16 := $80,DW_OP_breg17 := $81, 650 DW_OP_breg18 := $82,DW_OP_breg19 := $83, 651 DW_OP_breg20 := $84,DW_OP_breg21 := $85, 652 DW_OP_breg22 := $86,DW_OP_breg23 := $87, 653 DW_OP_breg24 := $88,DW_OP_breg25 := $89, 654 DW_OP_breg26 := $8a,DW_OP_breg27 := $8b, 655 DW_OP_breg28 := $8c,DW_OP_breg29 := $8d, 656 DW_OP_breg30 := $8e,DW_OP_breg31 := $8f, 657 DW_OP_regx := $90,DW_OP_fbreg := $91,DW_OP_bregx := $92, 658 DW_OP_piece := $93,DW_OP_deref_size := $94, 659 DW_OP_xderef_size := $95,DW_OP_nop := $96, 660 661 { DWARF 3 extensions. } 662 DW_OP_push_object_address := $97,DW_OP_call2 := $98, 663 DW_OP_call4 := $99,DW_OP_call_ref := $9a, 664 665 { DWARF 4 extensions. } 666 DW_OP_implicit_value := $9e, DW_OP_stack_value := $9f, 667 668 { GNU extensions. } 669 DW_OP_GNU_push_tls_address := $e0, 670 671 { HP extensions. } 672 DW_OP_HP_unknown := $e0, 673 DW_OP_HP_is_value := $e1,DW_OP_HP_fltconst4 := $e2, 674 DW_OP_HP_fltconst8 := $e3,DW_OP_HP_mod_range := $e4, 675 DW_OP_HP_unmod_range := $e5,DW_OP_HP_tls := $e6 676 ); 677 {$pop} 678 679 const 680 { Implementation-defined range start. } 681 DW_OP_lo_user = $e0; 682 { Implementation-defined range end. } 683 DW_OP_hi_user = $ff; 684 685 686 const 687 DW_LNS_extended_op = $00; 688 689 { next copied from cfidwarf, need to go to something shared } 690 DW_LNS_copy = $01; 691 DW_LNS_advance_pc = $02; 692 DW_LNS_advance_line = $03; 693 DW_LNS_set_file = $04; 694 DW_LNS_set_column = $05; 695 DW_LNS_negate_stmt = $06; 696 DW_LNS_set_basic_block = $07; 697 DW_LNS_const_add_pc = $08; 698 699 DW_LNS_fixed_advance_pc = $09; 700 DW_LNS_set_prologue_end = $0a; 701 DW_LNS_set_epilogue_begin = $0b; 702 DW_LNS_set_isa = $0c; 703 704 DW_LNE_end_sequence = $01; 705 DW_LNE_set_address = $02; 706 DW_LNE_define_file = $03; 707 { DW_LNE_set_segment is a non-standard Open Watcom extension. It might 708 create conflicts with future versions of the DWARF standard. } 709 DW_LNE_set_segment = $04; 710 DW_LNE_lo_user = $80; 711 DW_LNE_hi_user = $ff; 712 713 type 714 { TDirIndexItem } 715 716 TDirIndexItem = class(TFPHashObject) 717 private 718 FFiles: TFPHashObjectList; 719 public 720 IndexNr : Integer; 721 constructor Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer); 722 destructor Destroy;override; 723 property Files: TFPHashObjectList read FFiles; 724 end; 725 726 { TFileIndexItem } 727 728 TFileIndexItem = class(TFPHashObject) 729 private 730 FDirIndex: Integer; 731 public 732 IndexNr : Integer; 733 constructor Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer); 734 property DirIndex: Integer read FDirIndex; 735 end; 736 737 738 {**************************************************************************** 739 procs 740 ****************************************************************************} 741 DirListSortComparenull742 function DirListSortCompare(AItem1, AItem2: Pointer): Integer; 743 begin 744 Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr; 745 end; 746 747 FileListSortComparenull748 function FileListSortCompare(AItem1, AItem2: Pointer): Integer; 749 begin 750 Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr; 751 end; 752 753 AllocateNewAiSearchItemnull754 function AllocateNewAiSearchItem: pAbbrevSearchTreeItem; 755 begin 756 new(result); 757 FillChar(result^,sizeof(result^),#0); 758 end; 759 760 procedure FreeSearchItem(SI: pAbbrevSearchTreeItem); 761 begin 762 if assigned(SI^.NextItem) then 763 FreeSearchItem(SI^.NextItem); 764 if assigned(SI^.SearchItem) then 765 FreeSearchItem(SI^.SearchItem); 766 Dispose(SI); 767 end; 768 769 770 {**************************************************************************** 771 TDwarfLabHashSet 772 ****************************************************************************} 773 TDwarfLabHashSet.SizeOfItemnull774 class function TDwarfLabHashSet.SizeOfItem: Integer; 775 begin 776 Result:=sizeof(TDwarfHashSetItem); 777 end; 778 779 {**************************************************************************** 780 TDirIndexItem 781 ****************************************************************************} 782 783 constructor TDirIndexItem.Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer); 784 begin 785 inherited Create(AList,AName); 786 FFiles := TFPHashObjectList.Create; 787 IndexNr := AIndex; 788 end; 789 790 791 destructor TDirIndexItem.Destroy; 792 begin 793 FFiles.Free; 794 inherited Destroy; 795 end; 796 797 798 {**************************************************************************** 799 TFileIndexItem 800 ****************************************************************************} 801 802 constructor TFileIndexItem.Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer); 803 begin 804 inherited Create(AList,Aname); 805 FDirIndex := ADirIndex; 806 IndexNr := AIndex; 807 end; 808 809 810 {**************************************************************************** 811 TDebugInfoDwarf 812 ****************************************************************************} 813 814 procedure TDebugInfoDwarf.StartAbbrevSearch; 815 begin 816 CurrentSearchTreeItem:=AbbrevSearchTree; 817 end; 818 819 820 procedure TDebugInfoDwarf.WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem); 821 begin 822 if SI^.bit8 then 823 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_8bit(SI^.value)) 824 else 825 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_uleb128bit(SI^.value)); 826 end; 827 828 829 procedure TDebugInfoDwarf.StartAbbrevSectionFromSearchtree; 830 831 procedure AddCurrentAndPriorItemsToAbrev(SI: pAbbrevSearchTreeItem); 832 begin 833 if assigned(SI^.PriorItem) then 834 AddCurrentAndPriorItemsToAbrev(SI^.PriorItem); 835 WriteSearchItemToAbbrevSection(SI); 836 end; 837 838 begin 839 NewAbbrev:=true; 840 inc(currabbrevnumber); 841 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber)))); 842 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber)); 843 844 if CurrentSearchTreeItem<>AbbrevSearchTree then 845 AddCurrentAndPriorItemsToAbrev(CurrentSearchTreeItem); 846 end; 847 848 TDebugInfoDwarf.FinishAbbrevSearchnull849 function TDebugInfoDwarf.FinishAbbrevSearch: longint; 850 851 procedure FinalizeAbbrevSection; 852 begin 853 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); 854 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); 855 CurrentSearchTreeItem^.Abbrev:=currabbrevnumber; 856 NewAbbrev := false; 857 end; 858 859 begin 860 if NewAbbrev then 861 FinalizeAbbrevSection; 862 result := CurrentSearchTreeItem^.Abbrev; 863 if result=0 then 864 begin 865 // In this case the abbrev-section equals an existing longer abbrev section. 866 // So a new abbrev-section has to be made which ends on the current 867 // searchtree item 868 StartAbbrevSectionFromSearchtree; 869 FinalizeAbbrevSection; 870 result := CurrentSearchTreeItem^.Abbrev; 871 end; 872 end; 873 874 875 procedure TDebugInfoDwarf.AddConstToAbbrev(Value: QWord; bit8:boolean); 876 877 procedure AddCurrentItemToAbbrev; 878 begin 879 CurrentSearchTreeItem^.value:=value; 880 CurrentSearchTreeItem^.bit8:=bit8; 881 WriteSearchItemToAbbrevSection(CurrentSearchTreeItem); 882 end; 883 884 var si: pAbbrevSearchTreeItem; 885 begin 886 // Instead of adding this value directly to the ai-tree, search if an 887 // abbrev section with the same values already exist, and use the existing 888 // one or create one. 889 if NewAbbrev then 890 begin 891 // The current abbrev-section is new, so add the value to the abbrev-section 892 // and add it to the search-list. 893 CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem; 894 CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem; 895 CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem; 896 AddCurrentItemToAbbrev; 897 end 898 else 899 begin 900 // Search for the value which is added in the next sections of the 901 // searchtree for a match 902 si := CurrentSearchTreeItem^.NextItem; 903 while assigned(si) do 904 begin 905 if (SI^.value=Value) and (si^.bit8=bit8) then 906 begin 907 // If a match is found, set the current searchtree item to the next item 908 CurrentSearchTreeItem:=SI; 909 Exit; 910 end 911 else if si^.SearchItem=nil then 912 begin 913 // If no match is found, add a new item to the searchtree and write 914 // a new abbrev-section. 915 StartAbbrevSectionFromSearchtree; 916 917 si^.SearchItem:=AllocateNewAiSearchItem; 918 if currentsearchtreeitem<>AbbrevSearchTree then 919 si^.SearchItem^.PriorItem:=CurrentSearchTreeItem; 920 CurrentSearchTreeItem := si^.SearchItem; 921 922 AddCurrentItemToAbbrev; 923 Exit; 924 end; 925 Si := SI^.SearchItem; 926 end; 927 // The abbrev section we are looking for is longer than the one 928 // which is already in the search-tree. So expand the searchtree with 929 // the new value and write a new abbrev section 930 StartAbbrevSectionFromSearchtree; 931 932 CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem; 933 if currentsearchtreeitem^.PriorItem<>AbbrevSearchTree then 934 CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem; 935 CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem; 936 937 AddCurrentItemToAbbrev; 938 end; 939 end; 940 941 TDebugInfoDwarf.relative_dwarf_pathnull942 function TDebugInfoDwarf.relative_dwarf_path(const s:tcmdstr):tcmdstr; 943 begin 944 { Make a clean path for gdb. Remove trailing / and ./ prefixes and 945 use always a / } 946 result:=BsToSlash(ExcludeTrailingPathDelimiter(ExtractRelativePath(GetCurrentDir,FixFileName(ExpandFileName(s))))); 947 end; 948 949 950 procedure TDebugInfoDwarf.set_use_64bit_headers(state: boolean); 951 begin 952 _use_64bit_headers:=state; 953 if not(state) then 954 begin 955 if (target_info.system in systems_windows+systems_wince) then 956 offsetabstype:=aitconst_secrel32_symbol 957 else 958 offsetabstype:=aitconst_32bit_unaligned; 959 if (target_info.system in systems_darwin) then 960 offsetreltype:=aitconst_darwin_dwarf_delta32 961 else 962 offsetreltype:=aitconst_32bit_unaligned; 963 end 964 else 965 begin 966 if (target_info.system in systems_darwin) then 967 offsetreltype:=aitconst_darwin_dwarf_delta64 968 else 969 offsetreltype:=aitconst_64bit_unaligned; 970 offsetabstype:=aitconst_64bit_unaligned; 971 end; 972 end; 973 974 TDebugInfoDwarf.get_def_dwarf_labsnull975 function TDebugInfoDwarf.get_def_dwarf_labs(def:tdef): PDwarfHashSetItem; 976 var 977 needstructdeflab: boolean; 978 begin 979 { Keep track of used dwarf entries, this info is only useful for dwarf entries 980 referenced by the symbols. Definitions will always include all 981 required stabs } 982 if def.dbg_state=dbg_state_unused then 983 def.dbg_state:=dbg_state_used; 984 { Need a new label? } 985 result:=PDwarfHashSetItem(dwarflabels.FindOrAdd(@def,sizeof(def))); 986 { the other fields besides Data are not initialised } 987 if not assigned(result^.HashSetItem.Data) then 988 begin 989 { Mark as initialised } 990 result^.HashSetItem.Data:=self; 991 needstructdeflab:=is_implicit_pointer_object_type(def); 992 if not(tf_dwarf_only_local_labels in target_info.flags) then 993 begin 994 if (ds_dwarf_dbg_info_written in def.defstates) then 995 begin 996 if not assigned(def.typesym) then 997 internalerror(200610011); 998 result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_METADATA); 999 result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_METADATA); 1000 if needstructdeflab then 1001 result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_METADATA); 1002 def.dbg_state:=dbg_state_written; 1003 end 1004 else 1005 begin 1006 { Create an exported DBG symbol if we are generating a def defined in the 1007 globalsymtable of the current unit } 1008 if assigned(def.typesym) and 1009 (def.owner.symtabletype=globalsymtable) and 1010 (def.owner.iscurrentunit) then 1011 begin 1012 result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype); 1013 result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype); 1014 if needstructdeflab then 1015 result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype); 1016 include(def.defstates,ds_dwarf_dbg_info_written); 1017 end 1018 else 1019 begin 1020 { The pointer typecast is needed to prevent a problem with range checking 1021 on when the typecast is changed to 'as' } 1022 current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.lab))); 1023 current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.ref_lab))); 1024 if needstructdeflab then 1025 current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.struct_lab))); 1026 end; 1027 end; 1028 end 1029 else 1030 begin 1031 { The pointer typecast is needed to prevent a problem with range checking 1032 on when the typecast is changed to 'as' } 1033 { addrlabel instead of datalabel because it must be a local one } 1034 current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.lab))); 1035 current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.ref_lab))); 1036 if needstructdeflab then 1037 current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.struct_lab))); 1038 end; 1039 if def.dbg_state=dbg_state_used then 1040 deftowritelist.Add(def); 1041 defnumberlist.Add(def); 1042 end; 1043 end; 1044 TDebugInfoDwarf.is_fbregnull1045 function TDebugInfoDwarf.is_fbreg(reg: tregister): boolean; 1046 begin 1047 {$ifdef i8086} 1048 result:=reg=NR_BP; 1049 {$else i8086} 1050 { always return false, because we don't emit DW_AT_frame_base attributes yet } 1051 result:=false; 1052 {$endif i8086} 1053 end; 1054 TDebugInfoDwarf.def_dwarf_labnull1055 function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol; 1056 begin 1057 result:=get_def_dwarf_labs(def)^.lab; 1058 end; 1059 TDebugInfoDwarf.def_dwarf_class_struct_labnull1060 function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tobjectdef): tasmsymbol; 1061 begin 1062 result:=get_def_dwarf_labs(def)^.struct_lab; 1063 end; 1064 TDebugInfoDwarf.def_dwarf_ref_labnull1065 function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol; 1066 begin 1067 result:=get_def_dwarf_labs(def)^.ref_lab; 1068 end; 1069 1070 constructor TDebugInfoDwarf.Create; 1071 begin 1072 inherited Create; 1073 { 64bit headers are only supported for dwarf3 and up, so default off } 1074 use_64bit_headers := false; 1075 { we haven't generated any lineinfo yet } 1076 generated_lineinfo := false; 1077 1078 dirlist := TFPHashObjectList.Create; 1079 { add current dir as first item (index=0) } 1080 TDirIndexItem.Create(dirlist,'.', 0); 1081 asmline := TAsmList.create; 1082 loclist := tdynamicarray.Create(4096); 1083 1084 AbbrevSearchTree:=AllocateNewAiSearchItem; 1085 1086 vardatadef := nil; 1087 end; 1088 1089 1090 destructor TDebugInfoDwarf.Destroy; 1091 begin 1092 dirlist.Free; 1093 if assigned(AbbrevSearchTree) then 1094 FreeSearchItem(AbbrevSearchTree); 1095 dirlist := nil; 1096 asmline.free; 1097 asmline:=nil; 1098 loclist.Free; 1099 loclist := nil; 1100 inherited Destroy; 1101 end; 1102 1103 1104 procedure TDebugInfoDwarf.enum_membersyms_callback(p:TObject; arg: pointer); 1105 begin 1106 case tsym(p).typ of 1107 fieldvarsym: 1108 appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p)); 1109 propertysym: 1110 appendsym_property(TAsmList(arg),tpropertysym(p)); 1111 constsym: 1112 appendsym_const_member(TAsmList(arg),tconstsym(p),true); 1113 end; 1114 end; 1115 1116 TDebugInfoDwarf.get_file_indexnull1117 function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer; 1118 var 1119 dirname: String; 1120 diritem: TDirIndexItem; 1121 diridx: Integer; 1122 fileitem: TFileIndexItem; 1123 begin 1124 if afile.path = '' then 1125 dirname := '.' 1126 else 1127 begin 1128 { add the canonical form here already to avoid problems with } 1129 { paths such as './' etc } 1130 dirname := relative_dwarf_path(afile.path); 1131 if dirname = '' then 1132 dirname := '.'; 1133 end; 1134 diritem := TDirIndexItem(dirlist.Find(dirname)); 1135 if diritem = nil then 1136 diritem := TDirIndexItem.Create(dirlist,dirname, dirlist.Count); 1137 diridx := diritem.IndexNr; 1138 1139 fileitem := TFileIndexItem(diritem.files.Find(afile.name)); 1140 if fileitem = nil then 1141 begin 1142 Inc(filesequence); 1143 fileitem := TFileIndexItem.Create(diritem.files,afile.name, diridx, filesequence); 1144 end; 1145 Result := fileitem.IndexNr; 1146 end; 1147 1148 1149 procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const); 1150 begin 1151 if length(values)<>1 then 1152 internalerror(2009040402); 1153 append_attribute(attr,form,values[0]); 1154 end; 1155 1156 1157 procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec); 1158 begin 1159 { attribute } 1160 AddConstToAbbrev(cardinal(attr)); 1161 1162 { form } 1163 AddConstToAbbrev(cardinal(form)); 1164 1165 { info itself } 1166 case form of 1167 DW_FORM_string: 1168 case value.VType of 1169 vtChar: 1170 current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VChar)); 1171 vtString: 1172 current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VString^)); 1173 vtAnsistring: 1174 current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(Ansistring(value.VAnsiString))); 1175 else 1176 internalerror(200601264); 1177 end; 1178 1179 DW_FORM_flag: 1180 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(value.VBoolean))); 1181 1182 DW_FORM_data1: 1183 case value.VType of 1184 vtInteger: 1185 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger)); 1186 vtInt64: 1187 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^)); 1188 vtQWord: 1189 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^)); 1190 else 1191 internalerror(200602143); 1192 end; 1193 1194 DW_FORM_data2: 1195 case value.VType of 1196 vtInteger: 1197 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VInteger)); 1198 vtInt64: 1199 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VInt64^)); 1200 vtQWord: 1201 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VQWord^)); 1202 else 1203 internalerror(200602144); 1204 end; 1205 1206 DW_FORM_data4: 1207 case value.VType of 1208 vtInteger: 1209 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VInteger)); 1210 vtInt64: 1211 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VInt64^)); 1212 vtQWord: 1213 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VQWord^)); 1214 else 1215 internalerror(200602145); 1216 end; 1217 1218 DW_FORM_data8: 1219 case value.VType of 1220 vtInteger: 1221 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VInteger)); 1222 vtInt64: 1223 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VInt64^)); 1224 vtQWord: 1225 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VQWord^)); 1226 else 1227 internalerror(200602146); 1228 end; 1229 1230 DW_FORM_sdata: 1231 case value.VType of 1232 vtInteger: 1233 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInteger)); 1234 vtInt64: 1235 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInt64^)); 1236 vtQWord: 1237 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VQWord^)); 1238 else 1239 internalerror(200601285); 1240 end; 1241 1242 DW_FORM_udata: 1243 case value.VType of 1244 vtInteger: 1245 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInteger)); 1246 vtInt64: 1247 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInt64^)); 1248 vtQWord: 1249 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VQWord^)); 1250 else 1251 internalerror(200601284); 1252 end; 1253 1254 { block gets only the size, the rest is appended manually by the caller } 1255 DW_FORM_block1: 1256 case value.VType of 1257 vtInteger: 1258 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger)); 1259 vtInt64: 1260 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^)); 1261 vtQWord: 1262 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^)); 1263 else 1264 internalerror(200602141); 1265 end; 1266 else 1267 internalerror(200601263); 1268 end; 1269 end; 1270 1271 1272 { writing the data through a few simply procedures allows to create easily extra information 1273 for debugging of debug info } 1274 procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const); 1275 var 1276 i : longint; 1277 begin 1278 { abbrev number } 1279 // Store the ai with the reference to the abbrev number and start a search 1280 // to find the right abbrev-section. (Or create one) 1281 dwarf_info_abbref_tai := tai_const.create_uleb128bit(currabbrevnumber); 1282 current_asmdata.asmlists[al_dwarf_info].concat(dwarf_info_abbref_tai); 1283 StartAbbrevSearch; 1284 1285 { tag } 1286 AddConstToAbbrev(ord(tag)); 1287 1288 { children? } 1289 AddConstToAbbrev(ord(has_children),true); 1290 1291 i:=0; 1292 while i<=high(data) do 1293 begin 1294 if (i+2 > high(data)) then 1295 internalerror(2009040401); 1296 if data[i].VType<>vtInteger then 1297 internalerror(200601261); 1298 if data[i+1].VType<>vtInteger then 1299 internalerror(200601261); 1300 append_attribute(tdwarf_attribute(data[i].VInteger),tdwarf_form(data[i+1].VInteger),data[i+2]); 1301 inc(i,3); 1302 end; 1303 end; 1304 1305 1306 procedure TDebugInfoDwarf.append_block1(attr: tdwarf_attribute; size: aint); 1307 begin 1308 AddConstToAbbrev(ord(attr)); 1309 AddConstToAbbrev(ord(DW_FORM_block1)); 1310 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(size)); 1311 end; 1312 1313 1314 procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol); 1315 begin 1316 AddConstToAbbrev(ord(attr)); 1317 AddConstToAbbrev(ord(DW_FORM_addr)); 1318 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_ptr_unaligned,sym)); 1319 end; 1320 1321 procedure TDebugInfoDwarf.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); 1322 begin 1323 AddConstToAbbrev(ord(DW_FORM_ref_addr)); 1324 {$ifdef i8086} 1325 { DW_FORM_ref_addr is treated as 32-bit by Open Watcom on i8086 } 1326 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym)); 1327 {$else i8086} 1328 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_ptr_unaligned,sym)); 1329 {$endif i8086} 1330 end; 1331 1332 procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol); 1333 begin 1334 AddConstToAbbrev(ord(attr)); 1335 if not(tf_dwarf_only_local_labels in target_info.flags) then 1336 append_labelentry_addr_ref(attr, sym) 1337 else 1338 begin 1339 AddConstToAbbrev(ord(DW_FORM_ref4)); 1340 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype),sym)); 1341 end; 1342 end; 1343 1344 1345 procedure TDebugInfoDwarf.append_labelentry_dataptr_common(attr : tdwarf_attribute); 1346 begin 1347 AddConstToAbbrev(ord(attr)); 1348 if use_64bit_headers then 1349 AddConstToAbbrev(ord(DW_FORM_data8)) 1350 else 1351 AddConstToAbbrev(ord(DW_FORM_data4)); 1352 end; 1353 1354 procedure TDebugInfoDwarf.append_pointerclass(list: TAsmList; 1355 def: tpointerdef); 1356 begin 1357 {$ifdef i8086} 1358 case tcpupointerdef(def).x86pointertyp of 1359 x86pt_near, 1360 { todo: is there a way to specify these somehow? } 1361 x86pt_near_cs,x86pt_near_ds,x86pt_near_ss, 1362 x86pt_near_es,x86pt_near_fs,x86pt_near_gs: 1363 append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_near16]); 1364 x86pt_far: 1365 append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16]); 1366 x86pt_huge: 1367 append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_huge16]); 1368 else 1369 internalerror(2018052401); 1370 end; 1371 {$else i8086} 1372 { Theoretically, we could do this, but it might upset some debuggers, } 1373 { even though it's part of the DWARF standard. } 1374 { append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]); } 1375 {$endif i8086} 1376 end; 1377 1378 procedure TDebugInfoDwarf.append_proc_frame_base(list: TAsmList; 1379 def: tprocdef); 1380 {$ifdef i8086} 1381 var 1382 dreg: longint; 1383 blocksize: longint; 1384 templist: TAsmList; 1385 begin 1386 dreg:=dwarf_reg(NR_BP); 1387 templist:=TAsmList.create; 1388 if dreg<=31 then 1389 begin 1390 templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg)); 1391 blocksize:=1; 1392 end 1393 else 1394 begin 1395 templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); 1396 templist.concat(tai_const.create_uleb128bit(dreg)); 1397 blocksize:=1+Lengthuleb128(dreg); 1398 end; 1399 append_block1(DW_AT_frame_base,blocksize); 1400 current_asmdata.asmlists[al_dwarf_info].concatlist(templist); 1401 templist.free; 1402 end; 1403 {$else i8086} 1404 begin 1405 { problem: base reg isn't known here 1406 DW_AT_frame_base,DW_FORM_block1,1 1407 } 1408 end; 1409 {$endif i8086} 1410 1411 1412 {$ifdef i8086} 1413 procedure TDebugInfoDwarf.append_seg_name(const name:string); 1414 begin 1415 append_block1(DW_AT_segment,3); 1416 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_const2u))); 1417 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_seg_name(name)); 1418 end; 1419 1420 procedure TDebugInfoDwarf.append_seg_reg(const segment_register: tregister); 1421 var 1422 dreg: longint; 1423 blocksize: longint; 1424 templist: TAsmList; 1425 begin 1426 dreg:=dwarf_reg(segment_register); 1427 templist:=TAsmList.create; 1428 if dreg<=31 then 1429 begin 1430 templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg)); 1431 blocksize:=1; 1432 end 1433 else 1434 begin 1435 templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); 1436 templist.concat(tai_const.create_uleb128bit(dreg)); 1437 blocksize:=1+Lengthuleb128(dreg); 1438 end; 1439 append_block1(DW_AT_segment,blocksize); 1440 current_asmdata.asmlists[al_dwarf_info].concatlist(templist); 1441 templist.free; 1442 end; 1443 {$endif i8086} 1444 1445 1446 procedure TDebugInfoDwarf.append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol); 1447 begin 1448 { 1449 used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN 1450 The size of these depend on the header format 1451 Must be relative to another symbol on tf_dwarf_relative_addresses 1452 targets 1453 } 1454 if (tf_dwarf_relative_addresses in target_info.flags) then 1455 { use append_labelentry_dataptr_rel instead } 1456 internalerror(2007020210); 1457 append_labelentry_dataptr_common(attr); 1458 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,sym)) 1459 end; 1460 1461 1462 procedure TDebugInfoDwarf.append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol); 1463 begin 1464 { 1465 used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN 1466 The size of these depend on the header format 1467 Must be relative to another symbol on tf_dwarf_relative_addresses 1468 targets 1469 } 1470 append_labelentry_dataptr_common(attr); 1471 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,sym,endsym)); 1472 end; 1473 1474 1475 procedure TDebugInfoDwarf.finish_entry; 1476 begin 1477 dwarf_info_abbref_tai.value:=FinishAbbrevSearch; 1478 end; 1479 1480 1481 procedure TDebugInfoDwarf.finish_children; 1482 begin 1483 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0)); 1484 end; 1485 1486 procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef); 1487 var 1488 basedef : tdef; 1489 sign : tdwarf_type; 1490 signform : tdwarf_form; 1491 fullbytesize : byte; 1492 begin 1493 case def.ordtype of 1494 s8bit, 1495 s16bit, 1496 s32bit, 1497 u8bit, 1498 u16bit, 1499 u32bit : 1500 begin 1501 { generate proper signed/unsigned info for types like 0..3 } 1502 { these are s8bit, but should be identified as unsigned } 1503 { because otherwise they are interpreted wrongly when used } 1504 { in a bitpacked record } 1505 if (def.low<0) then 1506 begin 1507 sign:=DW_ATE_signed; 1508 signform:=DW_FORM_sdata 1509 end 1510 else 1511 begin 1512 sign:=DW_ATE_unsigned; 1513 signform:=DW_FORM_udata 1514 end; 1515 fullbytesize:=def.size; 1516 case fullbytesize of 1517 1: 1518 if (sign=DW_ATE_signed) then 1519 basedef:=s8inttype 1520 else 1521 basedef:=u8inttype; 1522 2: 1523 if (sign=DW_ATE_signed) then 1524 basedef:=s16inttype 1525 else 1526 basedef:=u16inttype; 1527 4: 1528 if (sign=DW_ATE_signed) then 1529 basedef:=s32inttype 1530 else 1531 basedef:=u32inttype; 1532 else 1533 internalerror(2008032201); 1534 end; 1535 1536 if (def.low=torddef(basedef).low) and 1537 (def.high=torddef(basedef).high) then 1538 { base type such as byte/shortint/word/... } 1539 if assigned(def.typesym) then 1540 append_entry(DW_TAG_base_type,false,[ 1541 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1542 DW_AT_encoding,DW_FORM_data1,sign, 1543 DW_AT_byte_size,DW_FORM_data1,fullbytesize]) 1544 else 1545 append_entry(DW_TAG_base_type,false,[ 1546 DW_AT_encoding,DW_FORM_data1,sign, 1547 DW_AT_byte_size,DW_FORM_data1,fullbytesize]) 1548 else 1549 begin 1550 { subrange type } 1551 { note: don't do this 64 bit int types, they appear } 1552 { to be always clipped to s32bit for some reason } 1553 if assigned(def.typesym) then 1554 append_entry(DW_TAG_subrange_type,false,[ 1555 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1556 DW_AT_lower_bound,signform,int64(def.low), 1557 DW_AT_upper_bound,signform,int64(def.high) 1558 ]) 1559 else 1560 append_entry(DW_TAG_subrange_type,false,[ 1561 DW_AT_lower_bound,signform,int64(def.low), 1562 DW_AT_upper_bound,signform,int64(def.high) 1563 ]); 1564 append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef)); 1565 end; 1566 1567 finish_entry; 1568 end; 1569 uvoid : 1570 begin 1571 { gdb 6.4 doesn't support DW_TAG_unspecified_type so we 1572 replace it with a unsigned type with size 0 (FK) 1573 } 1574 append_entry(DW_TAG_base_type,false,[ 1575 DW_AT_name,DW_FORM_string,'Void'#0, 1576 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 1577 DW_AT_byte_size,DW_FORM_data1,0 1578 ]); 1579 finish_entry; 1580 end; 1581 uchar : 1582 begin 1583 append_entry(DW_TAG_base_type,false,[ 1584 DW_AT_name,DW_FORM_string,'Char'#0, 1585 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char, 1586 DW_AT_byte_size,DW_FORM_data1,1 1587 ]); 1588 finish_entry; 1589 end; 1590 uwidechar : 1591 begin 1592 append_entry(DW_TAG_base_type,false,[ 1593 DW_AT_name,DW_FORM_string,'WideChar'#0, 1594 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char, 1595 DW_AT_byte_size,DW_FORM_data1,2 1596 ]); 1597 finish_entry; 1598 end; 1599 pasbool1 : 1600 begin 1601 append_entry(DW_TAG_base_type,false,[ 1602 DW_AT_name,DW_FORM_string,'Boolean'#0, 1603 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1604 DW_AT_byte_size,DW_FORM_data1,1 1605 ]); 1606 finish_entry; 1607 end; 1608 pasbool8 : 1609 begin 1610 append_entry(DW_TAG_base_type,false,[ 1611 DW_AT_name,DW_FORM_string,'Boolean8'#0, 1612 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1613 DW_AT_byte_size,DW_FORM_data1,1 1614 ]); 1615 finish_entry; 1616 end; 1617 bool8bit : 1618 begin 1619 append_entry(DW_TAG_base_type,false,[ 1620 DW_AT_name,DW_FORM_string,'ByteBool'#0, 1621 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1622 DW_AT_byte_size,DW_FORM_data1,1 1623 ]); 1624 finish_entry; 1625 end; 1626 pasbool16 : 1627 begin 1628 append_entry(DW_TAG_base_type,false,[ 1629 DW_AT_name,DW_FORM_string,'Boolean16'#0, 1630 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1631 DW_AT_byte_size,DW_FORM_data1,2 1632 ]); 1633 finish_entry; 1634 end; 1635 bool16bit : 1636 begin 1637 append_entry(DW_TAG_base_type,false,[ 1638 DW_AT_name,DW_FORM_string,'WordBool'#0, 1639 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1640 DW_AT_byte_size,DW_FORM_data1,2 1641 ]); 1642 finish_entry; 1643 end; 1644 pasbool32 : 1645 begin 1646 append_entry(DW_TAG_base_type,false,[ 1647 DW_AT_name,DW_FORM_string,'Boolean32'#0, 1648 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1649 DW_AT_byte_size,DW_FORM_data1,4 1650 ]); 1651 finish_entry; 1652 end; 1653 bool32bit : 1654 begin 1655 append_entry(DW_TAG_base_type,false,[ 1656 DW_AT_name,DW_FORM_string,'LongBool'#0, 1657 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1658 DW_AT_byte_size,DW_FORM_data1,4 1659 ]); 1660 finish_entry; 1661 end; 1662 pasbool64 : 1663 begin 1664 append_entry(DW_TAG_base_type,false,[ 1665 DW_AT_name,DW_FORM_string,'Boolean64'#0, 1666 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1667 DW_AT_byte_size,DW_FORM_data1,8 1668 ]); 1669 finish_entry; 1670 end; 1671 bool64bit : 1672 begin 1673 append_entry(DW_TAG_base_type,false,[ 1674 DW_AT_name,DW_FORM_string,'QWordBool'#0, 1675 DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, 1676 DW_AT_byte_size,DW_FORM_data1,8 1677 ]); 1678 finish_entry; 1679 end; 1680 u64bit : 1681 begin 1682 append_entry(DW_TAG_base_type,false,[ 1683 DW_AT_name,DW_FORM_string,'QWord'#0, 1684 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 1685 DW_AT_byte_size,DW_FORM_data1,8 1686 ]); 1687 finish_entry; 1688 end; 1689 scurrency : 1690 begin 1691 { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) } 1692 append_entry(DW_TAG_base_type,false,[ 1693 DW_AT_name,DW_FORM_string,'Currency'#0, 1694 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1695 DW_AT_byte_size,DW_FORM_data1,8 1696 ]); 1697 finish_entry; 1698 end; 1699 s64bit : 1700 begin 1701 append_entry(DW_TAG_base_type,false,[ 1702 DW_AT_name,DW_FORM_string,'Int64'#0, 1703 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1704 DW_AT_byte_size,DW_FORM_data1,8 1705 ]); 1706 finish_entry; 1707 end; 1708 u128bit: 1709 begin 1710 append_entry(DW_TAG_base_type,false,[ 1711 DW_AT_name,DW_FORM_string,'Int128'#0, 1712 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 1713 DW_AT_byte_size,DW_FORM_data1,16 1714 ]); 1715 finish_entry; 1716 end; 1717 s128bit: 1718 begin 1719 append_entry(DW_TAG_base_type,false,[ 1720 DW_AT_name,DW_FORM_string,'Int128'#0, 1721 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1722 DW_AT_byte_size,DW_FORM_data1,16 1723 ]); 1724 finish_entry; 1725 end; 1726 else 1727 internalerror(200601287); 1728 end; 1729 end; 1730 1731 procedure TDebugInfoDwarf.appenddef_float(list:TAsmList;def:tfloatdef); 1732 begin 1733 case def.floattype of 1734 s32real, 1735 s64real, 1736 s80real, 1737 sc80real: 1738 if assigned(def.typesym) then 1739 begin 1740 append_entry(DW_TAG_base_type,false,[ 1741 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1742 DW_AT_encoding,DW_FORM_data1,DW_ATE_float, 1743 DW_AT_byte_size,DW_FORM_data1,def.size 1744 ]); 1745 if (def.floattype in [s80real,sc80real]) and 1746 (def.size<>10) then 1747 begin 1748 append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]); 1749 { "The bit offset attribute describes the offset in bits 1750 of the high order bit of a value of the given type 1751 from the high order bit of the storage unit used to 1752 contain that value." } 1753 if target_info.endian=endian_little then 1754 append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]); 1755 end; 1756 end 1757 else 1758 append_entry(DW_TAG_base_type,false,[ 1759 DW_AT_encoding,DW_FORM_data1,DW_ATE_float, 1760 DW_AT_byte_size,DW_FORM_data1,def.size 1761 ]); 1762 s64currency: 1763 { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) } 1764 if assigned(def.typesym) then 1765 append_entry(DW_TAG_base_type,false,[ 1766 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1767 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1768 DW_AT_byte_size,DW_FORM_data1,8 1769 ]) 1770 else 1771 append_entry(DW_TAG_base_type,false,[ 1772 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1773 DW_AT_byte_size,DW_FORM_data1,8 1774 ]); 1775 s64comp: 1776 if assigned(def.typesym) then 1777 append_entry(DW_TAG_base_type,false,[ 1778 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1779 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1780 DW_AT_byte_size,DW_FORM_data1,8 1781 ]) 1782 else 1783 append_entry(DW_TAG_base_type,false,[ 1784 DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, 1785 DW_AT_byte_size,DW_FORM_data1,8 1786 ]); 1787 else 1788 internalerror(200601289); 1789 end; 1790 finish_entry; 1791 end; 1792 1793 1794 procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef); 1795 var 1796 hp : tenumsym; 1797 i : integer; 1798 begin 1799 if assigned(def.typesym) then 1800 append_entry(DW_TAG_enumeration_type,true,[ 1801 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1802 DW_AT_byte_size,DW_FORM_data1,def.size 1803 ]) 1804 else 1805 append_entry(DW_TAG_enumeration_type,true,[ 1806 DW_AT_byte_size,DW_FORM_data1,def.size 1807 ]); 1808 if assigned(def.basedef) then 1809 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef)); 1810 finish_entry; 1811 1812 { write enum symbols } 1813 for i := 0 to def.symtable.SymList.Count - 1 do 1814 begin 1815 hp:=tenumsym(def.symtable.SymList[i]); 1816 if hp.value<def.minval then 1817 continue 1818 else 1819 if hp.value>def.maxval then 1820 break; 1821 append_entry(DW_TAG_enumerator,false,[ 1822 DW_AT_name,DW_FORM_string,symname(hp, false)+#0, 1823 DW_AT_const_value,DW_FORM_data4,hp.value 1824 ]); 1825 finish_entry; 1826 end; 1827 1828 finish_children; 1829 end; 1830 1831 1832 procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef); 1833 var 1834 size : PInt; 1835 elesize : PInt; 1836 elestrideattr : tdwarf_attribute; 1837 labsym: tasmlabel; 1838 begin 1839 if is_dynamic_array(def) then 1840 begin 1841 { It's a pointer to the actual array } 1842 current_asmdata.getaddrlabel(labsym); 1843 append_entry(DW_TAG_pointer_type,false,[]); 1844 append_labelentry_ref(DW_AT_type,labsym); 1845 finish_entry; 1846 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); 1847 end; 1848 1849 if not is_packed_array(def) then 1850 begin 1851 elestrideattr := DW_AT_byte_stride; 1852 elesize := def.elesize; 1853 end 1854 else 1855 begin 1856 elestrideattr := DW_AT_stride_size; 1857 elesize := def.elepackedbitsize; 1858 end; 1859 1860 if is_special_array(def) then 1861 begin 1862 { no known size, no known upper bound } 1863 if assigned(def.typesym) then 1864 append_entry(DW_TAG_array_type,true,[ 1865 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0 1866 ]) 1867 else 1868 append_entry(DW_TAG_array_type,true,[]); 1869 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); 1870 finish_entry; 1871 { a missing upper bound means "unknown"/default } 1872 append_entry(DW_TAG_subrange_type,false,[ 1873 DW_AT_lower_bound,DW_FORM_sdata,def.lowrange, 1874 elestrideattr,DW_FORM_udata,elesize 1875 ]); 1876 end 1877 else 1878 begin 1879 size:=def.size; 1880 if assigned(def.typesym) then 1881 append_entry(DW_TAG_array_type,true,[ 1882 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 1883 DW_AT_byte_size,DW_FORM_udata,size 1884 ]) 1885 else 1886 append_entry(DW_TAG_array_type,true,[ 1887 DW_AT_byte_size,DW_FORM_udata,size 1888 ]); 1889 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); 1890 finish_entry; 1891 { to simplify things, we don't write a multidimensional array here } 1892 append_entry(DW_TAG_subrange_type,false,[ 1893 DW_AT_lower_bound,DW_FORM_sdata,def.lowrange, 1894 DW_AT_upper_bound,DW_FORM_sdata,def.highrange, 1895 elestrideattr,DW_FORM_udata,elesize 1896 ]); 1897 end; 1898 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef)); 1899 finish_entry; 1900 finish_children; 1901 end; 1902 1903 1904 procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef); 1905 begin 1906 if assigned(def.objname) then 1907 appenddef_record_named(list,def,def.objname^) 1908 else 1909 appenddef_record_named(list,def,''); 1910 end; 1911 1912 1913 procedure TDebugInfoDwarf.appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring); 1914 begin 1915 if (name<>'') then 1916 append_entry(DW_TAG_structure_type,true,[ 1917 DW_AT_name,DW_FORM_string,name+#0, 1918 DW_AT_byte_size,DW_FORM_udata,def.size 1919 ]) 1920 else 1921 append_entry(DW_TAG_structure_type,true,[ 1922 DW_AT_byte_size,DW_FORM_udata,def.size 1923 ]); 1924 finish_entry; 1925 def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); 1926 { don't know whether external record declaration is allow but if it so then 1927 do the same as we do for other object types - skip procdef info generation 1928 for external defs (Paul Ishenin) } 1929 if not(oo_is_external in def.objectoptions) then 1930 write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable); 1931 finish_children; 1932 end; 1933 1934 1935 procedure TDebugInfoDwarf.appenddef_pointer(list:TAsmList;def:tpointerdef); 1936 begin 1937 append_entry(DW_TAG_pointer_type,false,[]); 1938 append_pointerclass(list,def); 1939 if not(is_voidpointer(def)) then 1940 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointeddef)); 1941 finish_entry; 1942 end; 1943 1944 1945 procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef); 1946 1947 procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: asizeuint); 1948 var 1949 { maxlen can be > high(int64) } 1950 slen : asizeuint; 1951 arr : tasmlabel; 1952 begin 1953 { fix length of openshortstring } 1954 slen:=aword(def.len); 1955 if (slen=0) or 1956 (slen>maxlen) then 1957 slen:=maxlen; 1958 1959 { create a structure with two elements } 1960 if not(tf_dwarf_only_local_labels in target_info.flags) then 1961 current_asmdata.getglobaldatalabel(arr) 1962 else 1963 current_asmdata.getaddrlabel(arr); 1964 append_entry(DW_TAG_structure_type,true,[ 1965 DW_AT_name,DW_FORM_string,name+#0, 1966 DW_AT_byte_size,DW_FORM_udata,qword(lendef.size)+slen 1967 ]); 1968 finish_entry; 1969 1970 { length entry } 1971 append_entry(DW_TAG_member,false,[ 1972 DW_AT_name,DW_FORM_string,'length'#0, 1973 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) 1974 ]); 1975 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 1976 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); 1977 append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef)); 1978 finish_entry; 1979 1980 { string data entry } 1981 append_entry(DW_TAG_member,false,[ 1982 DW_AT_name,DW_FORM_string,'st'#0, 1983 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1) 1984 ]); 1985 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 1986 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(lendef.size)); 1987 append_labelentry_ref(DW_AT_type,arr); 1988 finish_entry; 1989 1990 finish_children; 1991 1992 { now the data array } 1993 if arr.bind=AB_GLOBAL then 1994 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(arr,0)) 1995 else 1996 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0)); 1997 append_entry(DW_TAG_array_type,true,[ 1998 DW_AT_byte_size,DW_FORM_udata,def.size, 1999 DW_AT_byte_stride,DW_FORM_udata,1 2000 ]); 2001 append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype)); 2002 finish_entry; 2003 append_entry(DW_TAG_subrange_type,false,[ 2004 DW_AT_lower_bound,DW_FORM_udata,1, 2005 DW_AT_upper_bound,DW_FORM_udata,qword(slen) 2006 ]); 2007 append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef)); 2008 finish_entry; 2009 finish_children; 2010 end; 2011 2012 begin 2013 case def.stringtype of 2014 st_shortstring: 2015 begin 2016 addnormalstringdef('ShortString',u8inttype,255); 2017 end; 2018 st_longstring: 2019 begin 2020 { a) we don't actually support variables of this type currently 2021 b) this type is only used as the type for constant strings 2022 > 255 characters 2023 c) in such a case, gdb will allocate and initialise enough 2024 memory to hold the maximum size for such a string 2025 -> don't use high(qword)/high(cardinal) as maximum, since that 2026 will cause exhausting the VM space, but some "reasonably high" 2027 number that should be enough for most constant strings 2028 } 2029 {$ifdef cpu64bitaddr} 2030 addnormalstringdef('LongString',u64inttype,qword(1024*1024)); 2031 {$endif cpu64bitaddr} 2032 {$ifdef cpu32bitaddr} 2033 addnormalstringdef('LongString',u32inttype,cardinal(1024*1024)); 2034 {$endif cpu32bitaddr} 2035 {$ifdef cpu16bitaddr} 2036 addnormalstringdef('LongString',u16inttype,cardinal(1024)); 2037 {$endif cpu16bitaddr} 2038 end; 2039 st_ansistring: 2040 begin 2041 { looks like a pchar } 2042 append_entry(DW_TAG_pointer_type,false,[]); 2043 append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype)); 2044 finish_entry; 2045 end; 2046 st_unicodestring, 2047 st_widestring: 2048 begin 2049 { looks like a pwidechar } 2050 append_entry(DW_TAG_pointer_type,false,[]); 2051 append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype)); 2052 finish_entry; 2053 end; 2054 end; 2055 end; 2056 2057 procedure TDebugInfoDwarf.appenddef_procvar(list:TAsmList;def:tprocvardef); 2058 2059 procedure doappend; 2060 var 2061 i : longint; 2062 begin 2063 if assigned(def.typesym) then 2064 append_entry(DW_TAG_subroutine_type,true,[ 2065 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 2066 DW_AT_prototyped,DW_FORM_flag,true 2067 ]) 2068 else 2069 append_entry(DW_TAG_subroutine_type,true,[ 2070 DW_AT_prototyped,DW_FORM_flag,true 2071 ]); 2072 if not(is_void(tprocvardef(def).returndef)) then 2073 append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef)); 2074 finish_entry; 2075 2076 { write parameters } 2077 for i:=0 to def.paras.count-1 do 2078 begin 2079 append_entry(DW_TAG_formal_parameter,false,[ 2080 DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]), false)+#0 2081 ]); 2082 append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef)); 2083 finish_entry; 2084 end; 2085 2086 finish_children; 2087 end; 2088 2089 var 2090 proc : tasmlabel; 2091 2092 begin 2093 if not def.is_addressonly then 2094 begin 2095 { create a structure with two elements } 2096 if not(tf_dwarf_only_local_labels in target_info.flags) then 2097 current_asmdata.getglobaldatalabel(proc) 2098 else 2099 current_asmdata.getaddrlabel(proc); 2100 append_entry(DW_TAG_structure_type,true,[ 2101 DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint) 2102 ]); 2103 finish_entry; 2104 2105 { proc entry } 2106 append_entry(DW_TAG_member,false,[ 2107 DW_AT_name,DW_FORM_string,'Proc'#0, 2108 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) 2109 ]); 2110 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 2111 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); 2112 append_labelentry_ref(DW_AT_type,proc); 2113 finish_entry; 2114 2115 { self entry } 2116 append_entry(DW_TAG_member,false,[ 2117 DW_AT_name,DW_FORM_string,'Self'#0, 2118 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(pint)) 2119 ]); 2120 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 2121 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sizeof(pint))); 2122 append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject)); 2123 finish_entry; 2124 2125 finish_children; 2126 2127 if proc.bind=AB_GLOBAL then 2128 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(proc,0)) 2129 else 2130 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0)); 2131 doappend; 2132 end 2133 else 2134 doappend; 2135 end; 2136 2137 2138 procedure TDebugInfoDwarf.beforeappenddef(list:TAsmList;def:tdef); 2139 var 2140 labsym : tasmsymbol; 2141 begin 2142 current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename))); 2143 2144 labsym:=def_dwarf_lab(def); 2145 case labsym.bind of 2146 AB_GLOBAL: 2147 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0)); 2148 AB_LOCAL: 2149 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); 2150 else 2151 internalerror(2013082001); 2152 end; 2153 2154 { On Darwin, dwarf info is not linked in the final binary, 2155 but kept in the individual object files. This allows for 2156 faster linking, but means that you have to keep the object 2157 files for debugging and also that gdb only loads in the 2158 debug info of a particular object file once you step into 2159 or over a procedure in it. 2160 2161 To solve this, there is a tool called dsymutil which can 2162 extract all the dwarf info from a program's object files. 2163 This utility however performs "smart linking" on the dwarf 2164 info and throws away all unreferenced dwarf entries. Since 2165 variables' types always point to the dwarfinfo for a tdef 2166 and never to that for a typesym, this means all debug 2167 entries generated for typesyms are thrown away. 2168 2169 The problem with that is that we translate typesyms into 2170 DW_TAG_typedef, and gdb's dwarf-2 reader only makes types 2171 globally visibly if they are defined using a DW_TAG_typedef. 2172 So as a result, before running dsymutil types only become 2173 available once you stepped into/over a function in the object 2174 file where they are declared, and after running dsymutil they 2175 are all gone (printing variables still works because the 2176 tdef dwarf info is still available, but you cannot typecast 2177 anything outside the declaring units because the type names 2178 are not known there). 2179 2180 The solution: if a tdef has an associated typesym, let the 2181 debug label for the tdef point to a DW_TAG_typedef instead 2182 of directly to the tdef itself. And don't write anything 2183 special for the typesym itself. 2184 2185 Update: we now also do this for other platforms, because 2186 otherwise if you compile unit A without debug info and 2187 use one of its types in unit B, then no typedef will be 2188 generated and hence gdb will not be able to give a definition 2189 of the type. 2190 } 2191 2192 if is_objc_class_or_protocol(def) then 2193 begin 2194 { for Objective-C classes, the typedef must refer to the 2195 struct itself, not to the pointer of the struct; Objective-C 2196 classes are not implicit pointers in Objective-C itself, only 2197 in FPC. So make the def label point to a pointer to the 2198 typedef, which in turn refers to the actual struct (for Delphi- 2199 style classes, the def points to the typedef, which refers to 2200 a pointer to the actual struct) } 2201 2202 { implicit pointer } 2203 current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym))); 2204 append_entry(DW_TAG_pointer_type,false,[]); 2205 append_labelentry_ref(DW_AT_type,labsym); 2206 finish_entry; 2207 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); 2208 end; 2209 2210 if assigned(def.typesym) and 2211 not(df_generic in def.defoptions) then 2212 begin 2213 current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym))); 2214 append_entry(DW_TAG_typedef,false,[ 2215 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0 2216 ]); 2217 append_labelentry_ref(DW_AT_type,labsym); 2218 finish_entry; 2219 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); 2220 end 2221 end; 2222 2223 2224 procedure TDebugInfoDwarf.afterappenddef(list:TAsmList;def:tdef); 2225 var 2226 labsym : tasmsymbol; 2227 begin 2228 { create a derived reference type for pass-by-reference parameters } 2229 { (gdb doesn't support DW_AT_variable_parameter yet) } 2230 labsym:=def_dwarf_ref_lab(def); 2231 case labsym.bind of 2232 AB_GLOBAL: 2233 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0)); 2234 AB_LOCAL: 2235 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); 2236 else 2237 internalerror(2013082002); 2238 end; 2239 append_entry(DW_TAG_reference_type,false,[]); 2240 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); 2241 finish_entry; 2242 end; 2243 2244 2245 procedure TDebugInfoDwarf.appendprocdef(list:TAsmList; def:tprocdef); 2246 dwarf_calling_conventionnull2247 function dwarf_calling_convention(def: tprocdef): Tdwarf_calling_convention; 2248 begin 2249 case def.proccalloption of 2250 pocall_register: 2251 result:=DW_CC_GNU_borland_fastcall_i386; 2252 pocall_cdecl, 2253 pocall_stdcall, 2254 pocall_cppdecl, 2255 pocall_mwpascal: 2256 result:=DW_CC_normal; 2257 else 2258 result:=DW_CC_nocall; 2259 end 2260 end; 2261 2262 var 2263 procendlabel : tasmlabel; 2264 procentry,s : string; 2265 cc : Tdwarf_calling_convention; 2266 st : tsymtable; 2267 vmtoffset : pint; 2268 in_currentunit : boolean; 2269 begin 2270 { only write debug info for procedures defined in the current module, 2271 except in case of methods (gcc-compatible) 2272 } 2273 in_currentunit:=def.in_currentunit; 2274 2275 if not in_currentunit and 2276 not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then 2277 exit; 2278 2279 { happens for init procdef of units without init section } 2280 if in_currentunit and 2281 not assigned(def.procstarttai) then 2282 exit; 2283 2284 { Procdefs are not handled by the regular def writing code, so 2285 dbg_state is not set/checked for them. Do it here. } 2286 if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then 2287 exit; 2288 defnumberlist.Add(def); 2289 2290 { Write methods and only in the scope of their parent objectdefs. } 2291 if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then 2292 begin 2293 { this code can also work for nested procdefs, but is not yet 2294 activated for those because there is no clear advantage yet to 2295 limiting the scope of nested procedures to that of their parent, 2296 and it makes it impossible to set breakpoints in them by 2297 referring to their name. } 2298 st:=def.owner; 2299 while assigned(st.defowner) and 2300 (tdef(st.defowner).typ = procdef) do 2301 st:=tprocdef(st.defowner).owner; 2302 if assigned(st) and 2303 (tdef(st.defowner).dbg_state<>dbg_state_writing) then 2304 exit; 2305 end; 2306 2307 def.dbg_state:=dbg_state_writing; 2308 2309 current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true)))); 2310 if not is_objc_class_or_protocol(def.struct) then 2311 append_entry(DW_TAG_subprogram,true, 2312 [DW_AT_name,DW_FORM_string,symname(def.procsym, false)+#0]) 2313 else 2314 append_entry(DW_TAG_subprogram,true, 2315 [DW_AT_name,DW_FORM_string,def.mangledname+#0]); 2316 2317 if (ds_dwarf_cpp in current_settings.debugswitches) and (def.owner.symtabletype in [objectsymtable,recordsymtable]) then 2318 begin 2319 { If C++ emulation is enabled, add DW_AT_linkage_name attribute for methods. 2320 LLDB uses it to display fully qualified method names. 2321 Add a simple C++ mangled name without params to achieve at least "Class::Method()" 2322 instead of just "Method" in LLDB. } 2323 s:=tabstractrecorddef(def.owner.defowner).objrealname^; 2324 procentry:=Format('_ZN%d%s', [Length(s), s]); 2325 s:=symname(def.procsym, false); 2326 procentry:=Format('%s%d%sEv'#0, [procentry, Length(s), s]); 2327 append_attribute(DW_AT_linkage_name,DW_FORM_string, [procentry]); 2328 end; 2329 2330 append_proc_frame_base(list,def); 2331 2332 { Append optional flags. } 2333 2334 { All Pascal procedures are prototyped } 2335 append_attribute(DW_AT_prototyped,DW_FORM_flag,[true]); 2336 { Calling convention. } 2337 cc:=dwarf_calling_convention(def); 2338 if (cc<>DW_CC_normal) then 2339 append_attribute(DW_AT_calling_convention,DW_FORM_data1,[ord(cc)]); 2340 {$ifdef i8086} 2341 { Call model (near or far). Open Watcom compatible. } 2342 if tcpuprocdef(def).is_far then 2343 append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16]) 2344 else 2345 append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]); 2346 {$endif i8086} 2347 { Externally visible. } 2348 if (po_global in def.procoptions) and 2349 (def.parast.symtablelevel<=normal_function_level) then 2350 append_attribute(DW_AT_external,DW_FORM_flag,[true]); 2351 { Abstract or virtual/overriding method. } 2352 if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and 2353 not is_objc_class_or_protocol(def.struct) and 2354 not is_objectpascal_helper(def.struct) then 2355 begin 2356 if not(po_abstractmethod in def.procoptions) then 2357 append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)]) 2358 else 2359 append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_pure_virtual)]); 2360 { Element number in the vmt (needs to skip stuff coming before the 2361 actual method addresses in the vmt, so we use vmtmethodoffset() 2362 and then divide by sizeof(pint)). } 2363 vmtoffset:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber); 2364 append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[3+LengthUleb128(vmtoffset)]); 2365 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 2366 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_constu))); 2367 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtoffset)); 2368 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus))); 2369 end; 2370 2371 { accessibility: public/private/protected } 2372 if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then 2373 append_visibility(def.visibility); 2374 2375 { Return type. } 2376 if not(is_void(tprocdef(def).returndef)) then 2377 append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef)); 2378 2379 { we can only write the start/end if this procedure is implemented in 2380 this module 2381 } 2382 if in_currentunit then 2383 begin 2384 { mark end of procedure } 2385 current_asmdata.getlabel(procendlabel,alt_dbgtype); 2386 current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai); 2387 2388 if use_dotted_functions then 2389 procentry := '.' + def.mangledname 2390 else 2391 procentry := def.mangledname; 2392 2393 {$ifdef i8086} 2394 append_seg_name(procentry); 2395 {$endif i8086} 2396 append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION)); append_labelentrynull2397 append_labelentry(DW_AT_high_pc,procendlabel); 2398 2399 if not(target_info.system in systems_darwin) then 2400 begin 2401 current_asmdata.asmlists[al_dwarf_aranges].Concat( 2402 tai_const.create_type_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION))); 2403 {$ifdef i8086} 2404 { bits 16..31 of the offset } 2405 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0)); 2406 { segment } 2407 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_seg_name(procentry)); 2408 {$endif i8086} 2409 current_asmdata.asmlists[al_dwarf_aranges].Concat( procendlabelnull2410 tai_const.Create_rel_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION),procendlabel)); 2411 {$ifdef i8086} 2412 { bits 16..31 of length } 2413 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0)); 2414 {$endif i8086} 2415 end; 2416 end; 2417 2418 { Don't write the funcretsym explicitly, it's also in the 2419 localsymtable and/or parasymtable. 2420 } 2421 finish_entry; 2422 2423 if assigned(def.parast) then 2424 begin 2425 { First insert self, because gdb uses the fact whether or not the 2426 first parameter of a method is artificial to distinguish static 2427 from regular methods. } 2428 2429 { fortunately, self is the always the first parameter in the 2430 paralist, since it has the lowest paranr. Note that this is not 2431 true for Objective-C, but those methods are detected in 2432 another way (by reading the ObjC run time information) } 2433 write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras); 2434 end; 2435 { local type defs and vars should not be written 2436 inside the main proc } 2437 if in_currentunit and 2438 assigned(def.localst) and 2439 (def.localst.symtabletype=localsymtable) then 2440 write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst); 2441 2442 { last write the types from this procdef } 2443 if assigned(def.parast) then 2444 write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast); 2445 { only try to write the localst if the routine is implemented here } 2446 if in_currentunit and 2447 assigned(def.localst) and 2448 (def.localst.symtabletype=localsymtable) then 2449 begin 2450 write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst); 2451 { Write nested procedures -- disabled, see scope check at the 2452 beginning; currently, these are still written in the global 2453 scope. } 2454 // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst); 2455 end; 2456 2457 finish_children; 2458 end; 2459 2460 TDebugInfoDwarf.get_symlist_sym_offsetnull2461 function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean; 2462 var 2463 elesize : pint; 2464 currdef : tdef; 2465 indirection: boolean; 2466 begin 2467 result:=false; 2468 if not assigned(symlist) then 2469 exit; 2470 sym:=nil; 2471 offset:=0; 2472 currdef:=nil; 2473 indirection:=false; 2474 repeat 2475 case symlist^.sltype of 2476 sl_load: 2477 begin 2478 if assigned(sym) then 2479 internalerror(2009031203); 2480 if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then 2481 { can't handle... } 2482 exit; 2483 sym:=tabstractvarsym(symlist^.sym); 2484 currdef:=tabstractvarsym(sym).vardef; 2485 if ((sym.typ=paravarsym) and 2486 paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then 2487 indirection:=true; 2488 end; 2489 sl_subscript: 2490 begin 2491 if not assigned(currdef) then 2492 internalerror(2009031301); 2493 if (symlist^.sym.typ<>fieldvarsym) then 2494 internalerror(2009031202); 2495 { can't handle offsets with indirections yet } 2496 if indirection then 2497 exit; 2498 if is_packed_record_or_object(currdef) then 2499 begin 2500 { can't calculate the address of a non-byte aligned field } 2501 if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then 2502 exit; 2503 inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8) 2504 end 2505 else 2506 inc(offset,tfieldvarsym(symlist^.sym).fieldoffset); 2507 currdef:=tfieldvarsym(symlist^.sym).vardef; 2508 end; 2509 sl_absolutetype, 2510 sl_typeconv: 2511 begin 2512 currdef:=symlist^.def; 2513 { ignore, these don't change the address } 2514 end; 2515 sl_vec: 2516 begin 2517 if not assigned(currdef) or 2518 (currdef.typ<>arraydef) then 2519 internalerror(2009031201); 2520 { can't handle offsets with indirections yet } 2521 if indirection then 2522 exit; 2523 if not is_packed_array(currdef) then 2524 elesize:=tarraydef(currdef).elesize 2525 else 2526 begin 2527 elesize:=tarraydef(currdef).elepackedbitsize; 2528 { can't calculate the address of a non-byte aligned element } 2529 if (elesize mod 8)<>0 then 2530 exit; 2531 elesize:=elesize div 8; 2532 end; 2533 inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize); 2534 currdef:=tarraydef(currdef).elementdef; 2535 end; 2536 else 2537 internalerror(2009031401); 2538 end; 2539 symlist:=symlist^.next; 2540 until not assigned(symlist); 2541 if not assigned(sym) then 2542 internalerror(2009031205); 2543 result:=true; 2544 end; 2545 2546 2547 procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); 2548 begin 2549 appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]); 2550 end; 2551 2552 2553 procedure TDebugInfoDwarf.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags); 2554 var 2555 templist : TAsmList; 2556 blocksize,size_of_int : longint; 2557 tag : tdwarf_tag; 2558 has_high_reg : boolean; 2559 dreg,dreghigh : shortint; 2560 {$ifdef i8086} 2561 has_segment_sym_name : boolean=false; 2562 segment_sym_name : TSymStr=''; 2563 segment_reg: TRegister=NR_NO; 2564 {$endif i8086} 2565 begin 2566 blocksize:=0; 2567 dreghigh:=0; 2568 { external symbols can't be resolved at link time, so we 2569 can't generate stabs for them 2570 2571 not sure if this applies to dwarf as well (FK) 2572 } 2573 if vo_is_external in sym.varoptions then 2574 exit; 2575 2576 { There is no space allocated for not referenced locals } 2577 if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then 2578 exit; 2579 2580 templist:=TAsmList.create; 2581 2582 case sym.localloc.loc of 2583 LOC_REGISTER, 2584 LOC_CREGISTER, 2585 LOC_MMREGISTER, 2586 LOC_CMMREGISTER, 2587 LOC_FPUREGISTER, 2588 LOC_CFPUREGISTER : 2589 begin 2590 { dwarf_reg_no_error might return -1 2591 in case the register variable has been optimized out } 2592 dreg:=dwarf_reg_no_error(sym.localloc.register); 2593 has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO); 2594 if has_high_reg then 2595 dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi); 2596 if dreghigh=-1 then 2597 has_high_reg:=false; 2598 if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and 2599 (sym.typ=paravarsym) and 2600 paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and 2601 not(vo_has_local_copy in sym.varoptions) and 2602 not is_open_string(sym.vardef) and (dreg>=0) then 2603 begin 2604 templist.concat(tai_const.create_8bit(ord(DW_OP_bregx))); 2605 templist.concat(tai_const.create_uleb128bit(dreg)); 2606 templist.concat(tai_const.create_sleb128bit(0)); 2607 blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(0); 2608 end 2609 else 2610 begin 2611 if has_high_reg then 2612 begin 2613 templist.concat(tai_comment.create(strpnew('high:low reg pair variable'))); 2614 size_of_int:=sizeof(aint); 2615 templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); 2616 templist.concat(tai_const.create_uleb128bit(dreg)); 2617 blocksize:=1+Lengthuleb128(dreg); 2618 templist.concat(tai_const.create_8bit(ord(DW_OP_piece))); 2619 templist.concat(tai_const.create_uleb128bit(size_of_int)); 2620 blocksize:=blocksize+1+Lengthuleb128(size_of_int); 2621 templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); 2622 templist.concat(tai_const.create_uleb128bit(dreghigh)); 2623 blocksize:=blocksize+1+Lengthuleb128(dreghigh); 2624 templist.concat(tai_const.create_8bit(ord(DW_OP_piece))); 2625 templist.concat(tai_const.create_uleb128bit(size_of_int)); 2626 blocksize:=blocksize+1+Lengthuleb128(size_of_int); 2627 end 2628 else if (dreg>=0) then 2629 begin 2630 templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); 2631 templist.concat(tai_const.create_uleb128bit(dreg)); 2632 blocksize:=1+Lengthuleb128(dreg); 2633 end; 2634 end; 2635 end; 2636 else 2637 begin 2638 case sym.typ of 2639 staticvarsym: 2640 begin 2641 if (vo_is_thread_var in sym.varoptions) then 2642 begin 2643 { TODO: !!! FIXME: dwarf for thread vars !!!} 2644 { This is only a minimal change to at least be able to get a value 2645 in only one thread is present PM 2014-11-21, like for stabs format } 2646 templist.concat(tai_const.create_8bit(ord(DW_OP_addr))); 2647 templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname, 2648 offset+sizeof(pint))); 2649 blocksize:=1+sizeof(puint); 2650 end 2651 else 2652 begin 2653 templist.concat(tai_const.create_8bit(ord(DW_OP_addr))); 2654 templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset)); 2655 blocksize:=1+sizeof(puint); 2656 {$ifdef i8086} 2657 segment_sym_name:=sym.mangledname; 2658 has_segment_sym_name:=true; 2659 {$endif i8086} 2660 end; 2661 end; 2662 paravarsym, 2663 localvarsym: 2664 begin 2665 { Happens when writing debug info for paras of procdefs not 2666 implemented in the current module. Can't add a general check 2667 for LOC_INVALID above, because staticvarsyms may also have it. 2668 } 2669 if sym.localloc.loc<> LOC_INVALID then 2670 begin 2671 if is_fbreg(sym.localloc.reference.base) then 2672 begin 2673 templist.concat(tai_const.create_8bit(ord(DW_OP_fbreg))); 2674 templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset)); 2675 blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset); 2676 end 2677 else 2678 begin 2679 dreg:=dwarf_reg(sym.localloc.reference.base); 2680 if dreg<=31 then 2681 begin 2682 templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg)); 2683 templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset)); 2684 blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset); 2685 end 2686 else 2687 begin 2688 templist.concat(tai_const.create_8bit(ord(DW_OP_bregx))); 2689 templist.concat(tai_const.create_uleb128bit(dreg)); 2690 templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset)); 2691 blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(sym.localloc.reference.offset+offset); 2692 end; 2693 end; 2694 {$ifdef i8086} 2695 segment_reg:=sym.localloc.reference.segment; 2696 {$endif i8086} 2697 {$ifndef gdb_supports_DW_AT_variable_parameter} 2698 { Parameters which are passed by reference. (var and the like) 2699 Hide the reference-pointer and dereference the pointer 2700 in the DW_AT_location block. 2701 } 2702 if (sym.typ=paravarsym) and 2703 paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and 2704 not(vo_has_local_copy in sym.varoptions) and 2705 not is_open_string(sym.vardef) then 2706 begin 2707 templist.concat(tai_const.create_8bit(ord(DW_OP_deref))); 2708 inc(blocksize); 2709 end 2710 {$endif not gdb_supports_DW_AT_variable_parameter} 2711 end; 2712 end 2713 else 2714 internalerror(200601288); 2715 end; 2716 end; 2717 end; 2718 2719 { function results must not be added to the parameter list, 2720 as they are not part of the signature of the function 2721 (gdb automatically adds them according to the ABI specifications 2722 when calling the function) 2723 } 2724 if (sym.typ=paravarsym) and 2725 not(dvf_force_local_var in flags) and 2726 not(vo_is_funcret in sym.varoptions) then 2727 tag:=DW_TAG_formal_parameter 2728 else 2729 tag:=DW_TAG_variable; 2730 2731 { must be parasym of externally implemented procdef, but 2732 the parasymtable can con also contain e.g. absolutevarsyms 2733 -> check symtabletype} 2734 if (sym.owner.symtabletype=parasymtable) and 2735 (sym.localloc.loc=LOC_INVALID) then 2736 begin 2737 if (sym.owner.symtabletype<>parasymtable) then 2738 internalerror(2009101001); 2739 append_entry(tag,false,[ 2740 DW_AT_name,DW_FORM_string,name+#0 2741 { 2742 DW_AT_decl_file,DW_FORM_data1,0, 2743 DW_AT_decl_line,DW_FORM_data1, 2744 } 2745 ]) 2746 end 2747 else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER, 2748 LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and 2749 ((sym.owner.symtabletype = globalsymtable) or 2750 (sp_static in sym.symoptions) or 2751 (vo_is_public in sym.varoptions)) then 2752 append_entry(tag,false,[ 2753 DW_AT_name,DW_FORM_string,name+#0, 2754 { 2755 DW_AT_decl_file,DW_FORM_data1,0, 2756 DW_AT_decl_line,DW_FORM_data1, 2757 } 2758 DW_AT_external,DW_FORM_flag,true, 2759 { data continues below } 2760 DW_AT_location,DW_FORM_block1,blocksize 2761 ]) 2762 {$ifdef gdb_supports_DW_AT_variable_parameter} 2763 else if (sym.typ=paravarsym) and 2764 paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and 2765 not(vo_has_local_copy in sym.varoptions) and 2766 not is_open_string(sym.vardef) then 2767 append_entry(tag,false,[ 2768 DW_AT_name,DW_FORM_string,name+#0, 2769 DW_AT_variable_parameter,DW_FORM_flag,true, 2770 { 2771 DW_AT_decl_file,DW_FORM_data1,0, 2772 DW_AT_decl_line,DW_FORM_data1, 2773 } 2774 { data continues below } 2775 DW_AT_location,DW_FORM_block1,blocksize 2776 ]) 2777 {$endif gdb_supports_DW_AT_variable_parameter} 2778 else 2779 append_entry(tag,false,[ 2780 DW_AT_name,DW_FORM_string,name+#0, 2781 { 2782 DW_AT_decl_file,DW_FORM_data1,0, 2783 DW_AT_decl_line,DW_FORM_data1, 2784 } 2785 { data continues below } 2786 DW_AT_location,DW_FORM_block1,blocksize 2787 ]); 2788 { append block data } 2789 current_asmdata.asmlists[al_dwarf_info].concatlist(templist); 2790 { Mark self as artificial for methods, because gdb uses the fact 2791 whether or not the first parameter of a method is artificial to 2792 distinguish regular from static methods (since there are no 2793 no vo_is_self parameters for static methods, we don't have to check 2794 that). } 2795 if (vo_is_self in sym.varoptions) then 2796 append_attribute(DW_AT_artificial,DW_FORM_flag,[true]); 2797 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); 2798 {$ifdef i8086} 2799 if has_segment_sym_name then 2800 append_seg_name(segment_sym_name) 2801 else if segment_reg<>NR_NO then 2802 append_seg_reg(segment_reg); 2803 {$endif i8086} 2804 2805 templist.free; 2806 2807 finish_entry; 2808 end; 2809 2810 2811 procedure TDebugInfoDwarf.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym); 2812 begin 2813 appendsym_var(list,sym); 2814 end; 2815 2816 2817 procedure TDebugInfoDwarf.appendsym_localvar(list:TAsmList;sym:tlocalvarsym); 2818 begin 2819 appendsym_var(list,sym); 2820 end; 2821 2822 2823 procedure TDebugInfoDwarf.appendsym_paravar(list:TAsmList;sym:tparavarsym); 2824 begin 2825 appendsym_var(list,sym); 2826 end; 2827 2828 2829 procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym); 2830 begin 2831 appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0); 2832 end; 2833 2834 2835 procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint); 2836 var 2837 bitoffset, 2838 fieldoffset, 2839 fieldnatsize: asizeint; 2840 begin 2841 if (sp_static in sym.symoptions) or 2842 (sym.visibility=vis_hidden) then 2843 exit; 2844 2845 if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or 2846 { only ordinals are bitpacked } 2847 not is_ordinal(sym.vardef) then 2848 begin 2849 { other kinds of fields can however also appear in a bitpacked } 2850 { record, and then their offset is also specified in bits rather } 2851 { than in bytes } 2852 if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then 2853 fieldoffset:=sym.fieldoffset 2854 else 2855 fieldoffset:=sym.fieldoffset div 8; 2856 inc(fieldoffset,offset); 2857 append_entry(DW_TAG_member,false,[ 2858 DW_AT_name,DW_FORM_string,name+#0, 2859 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset) 2860 ]); 2861 end 2862 else 2863 begin 2864 if (sym.vardef.packedbitsize > 255) then 2865 internalerror(2007061201); 2866 2867 { we don't bitpack according to the ABI, but as close as } 2868 { possible, i.e., equivalent to gcc's } 2869 { __attribute__((__packed__)), which is also what gpc } 2870 { does. } 2871 fieldnatsize:=max(sizeof(pint),sym.vardef.size); 2872 fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize; 2873 inc(fieldoffset,offset); 2874 bitoffset:=sym.fieldoffset mod (fieldnatsize*8); 2875 if (target_info.endian=endian_little) then 2876 bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize; 2877 append_entry(DW_TAG_member,false,[ 2878 DW_AT_name,DW_FORM_string,symname(sym, false)+#0, 2879 { gcc also generates both a bit and byte size attribute } 2880 { we don't support ordinals >= 256 bits } 2881 DW_AT_byte_size,DW_FORM_data1,fieldnatsize, 2882 { nor >= 256 bits (not yet, anyway, see IE above) } 2883 DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize, 2884 { data1 and data2 are unsigned, bitoffset can also be negative } 2885 DW_AT_bit_offset,DW_FORM_data4,bitoffset, 2886 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset) 2887 ]); 2888 end; 2889 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 2890 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset)); 2891 if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then 2892 append_visibility(sym.visibility); 2893 2894 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); 2895 finish_entry; 2896 end; 2897 2898 procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym); 2899 begin 2900 appendsym_const_member(list,sym,false); 2901 end; 2902 2903 procedure TDebugInfoDwarf.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean); 2904 var 2905 i, 2906 size: aint; 2907 usedef: tdef; 2908 begin 2909 { These are default values of parameters. These should be encoded 2910 via DW_AT_default_value, not as a separate sym. Moreover, their 2911 type is not available when writing the debug info for external 2912 procedures. 2913 } 2914 if (sym.owner.symtabletype=parasymtable) then 2915 exit; 2916 2917 if ismember then 2918 append_entry(DW_TAG_member,false,[ 2919 DW_AT_name,DW_FORM_string,symname(sym, false)+#0, 2920 { The DW_AT_declaration tag is invalid according to the DWARF specifications. 2921 But gcc adds this to static const members and gdb checks 2922 for this flag. So we have to set it also. 2923 } 2924 DW_AT_declaration,DW_FORM_flag,true, 2925 DW_AT_external,DW_FORM_flag,true 2926 ]) 2927 else 2928 append_entry(DW_TAG_variable,false,[ 2929 DW_AT_name,DW_FORM_string,symname(sym, false)+#0 2930 ]); 2931 { for string constants, constdef isn't set because they have no real type } 2932 case sym.consttyp of 2933 conststring: 2934 begin 2935 { if DW_FORM_string is used below one day, this usedef should 2936 probably become nil } 2937 { note: < 255 instead of <= 255 because we have to store the 2938 entire length of the string as well, and 256 does not fit in 2939 a byte } 2940 if (sym.value.len<255) then 2941 usedef:=cshortstringtype 2942 else 2943 usedef:=clongstringtype; 2944 end; 2945 constresourcestring, 2946 constwstring: 2947 usedef:=nil; 2948 else 2949 usedef:=sym.constdef; 2950 end; 2951 if assigned(usedef) then 2952 append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef)); 2953 AddConstToAbbrev(ord(DW_AT_const_value)); 2954 case sym.consttyp of 2955 conststring: 2956 begin 2957 { DW_FORM_string isn't supported yet by the Pascal value printer 2958 -> create a string using raw bytes } 2959 if (sym.value.len<255) then 2960 begin 2961 AddConstToAbbrev(ord(DW_FORM_block1)); 2962 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len+1)); 2963 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len)); 2964 end 2965 else 2966 begin 2967 AddConstToAbbrev(ord(DW_FORM_block)); 2968 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizesinttype.size)); 2969 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_sizeint_unaligned(sym.value.len)); 2970 end; 2971 i:=0; 2972 size:=sym.value.len; 2973 while(i<size) do 2974 begin 2975 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^))); 2976 inc(i); 2977 end; 2978 end; 2979 constguid, 2980 constset: 2981 begin 2982 AddConstToAbbrev(ord(DW_FORM_block1)); 2983 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(usedef.size)); 2984 i:=0; 2985 size:=sym.constdef.size; 2986 while (i<size) do 2987 begin 2988 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^))); 2989 inc(i); 2990 end; 2991 end; 2992 constwstring, 2993 constresourcestring: 2994 begin 2995 { write dummy for now } 2996 AddConstToAbbrev(ord(DW_FORM_string)); 2997 current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create('')); 2998 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0)); 2999 end; 3000 constord: 3001 begin 3002 if (sym.value.valueord<0) then 3003 begin 3004 AddConstToAbbrev(ord(DW_FORM_sdata)); 3005 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue)); 3006 end 3007 else 3008 begin 3009 AddConstToAbbrev(ord(DW_FORM_udata)); 3010 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.valueord.uvalue)); 3011 end; 3012 end; 3013 constnil: 3014 begin 3015 {$ifdef cpu64bitaddr} 3016 AddConstToAbbrev(ord(DW_FORM_data8)); 3017 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(0)); 3018 {$else cpu64bitaddr} 3019 AddConstToAbbrev(ord(DW_FORM_data4)); 3020 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(0)); 3021 {$endif cpu64bitaddr} 3022 end; 3023 constpointer: 3024 begin 3025 {$ifdef cpu64bitaddr} 3026 AddConstToAbbrev(ord(DW_FORM_data8)); 3027 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(int64(sym.value.valueordptr))); 3028 {$else cpu64bitaddr} 3029 AddConstToAbbrev(ord(DW_FORM_data4)); 3030 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint(sym.value.valueordptr))); 3031 {$endif cpu64bitaddr} 3032 end; 3033 constreal: 3034 begin 3035 AddConstToAbbrev(ord(DW_FORM_block1)); 3036 case tfloatdef(sym.constdef).floattype of 3037 s32real: 3038 begin 3039 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4)); 3040 current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^)); 3041 end; 3042 s64real: 3043 begin 3044 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8)); 3045 current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^)); 3046 end; 3047 s64comp, 3048 s64currency: 3049 begin 3050 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8)); 3051 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(trunc(pbestreal(sym.value.valueptr)^))); 3052 end; 3053 s80real, 3054 sc80real: 3055 begin 3056 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size)); 3057 current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size)); 3058 end; 3059 else 3060 internalerror(200601291); 3061 end; 3062 end; 3063 else 3064 internalerror(200601292); 3065 end; 3066 finish_entry; 3067 end; 3068 3069 3070 procedure TDebugInfoDwarf.appendsym_label(list:TAsmList;sym: tlabelsym); 3071 begin 3072 { ignore label syms for now, the problem is that a label sym 3073 can have more than one label associated e.g. in case of 3074 an inline procedure expansion } 3075 end; 3076 3077 3078 procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym); 3079 var 3080 symlist: ppropaccesslistitem; 3081 tosym: tabstractvarsym; 3082 offset: pint; 3083 begin 3084 if assigned(sym.propaccesslist[palt_read]) and 3085 not assigned(sym.propaccesslist[palt_read].procdef) then 3086 symlist:=sym.propaccesslist[palt_read].firstsym 3087 else 3088 { can't handle } 3089 exit; 3090 3091 if not get_symlist_sym_offset(symlist,tosym,offset) then 3092 exit; 3093 3094 if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then 3095 begin 3096 if (tosym.typ=fieldvarsym) then 3097 internalerror(2009031404); 3098 appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[]) 3099 end 3100 else 3101 appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset) 3102 end; 3103 3104 TDebugInfoDwarf.symdebugnamenull3105 function TDebugInfoDwarf.symdebugname(sym: tsym): String; 3106 begin 3107 result := sym.name; 3108 end; 3109 3110 3111 procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym); 3112 begin 3113 { just queue the def if needed, beforeappenddef will 3114 emit the typedef if necessary } 3115 def_dwarf_lab(sym.typedef); 3116 end; 3117 3118 3119 procedure TDebugInfoDwarf.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym); 3120 var 3121 templist : TAsmList; 3122 blocksize : longint; 3123 symlist : ppropaccesslistitem; 3124 tosym: tabstractvarsym; 3125 offset: pint; 3126 flags: tdwarfvarsymflags; 3127 begin 3128 templist:=TAsmList.create; 3129 case tabsolutevarsym(sym).abstyp of 3130 toaddr : 3131 begin 3132 { MWE: replaced ifdef i368 } 3133 (* 3134 if target_cpu = cpu_i386 then 3135 begin 3136 { in theory, we could write a DW_AT_segment entry here for sym.absseg, 3137 however I doubt that gdb supports this (FK) } 3138 end; 3139 *) 3140 templist.concat(tai_const.create_8bit(3)); 3141 templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset)); 3142 blocksize:=1+sizeof(puint); 3143 end; 3144 toasm : 3145 begin 3146 templist.concat(tai_const.create_8bit(3)); 3147 templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0)); 3148 blocksize:=1+sizeof(puint); 3149 end; 3150 tovar: 3151 begin 3152 symlist:=tabsolutevarsym(sym).ref.firstsym; 3153 if get_symlist_sym_offset(symlist,tosym,offset) then 3154 begin 3155 if (tosym.typ=fieldvarsym) then 3156 internalerror(2009031402); 3157 flags:=[]; 3158 if (sym.owner.symtabletype=localsymtable) then 3159 include(flags,dvf_force_local_var); 3160 appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags); 3161 end; 3162 templist.free; 3163 exit; 3164 end; 3165 else 3166 internalerror(2013120111); 3167 end; 3168 3169 append_entry(DW_TAG_variable,false,[ 3170 DW_AT_name,DW_FORM_string,symname(sym, false)+#0, 3171 { 3172 DW_AT_decl_file,DW_FORM_data1,0, 3173 DW_AT_decl_line,DW_FORM_data1, 3174 } 3175 DW_AT_external,DW_FORM_flag,true, 3176 { data continues below } 3177 DW_AT_location,DW_FORM_block1,blocksize 3178 ]); 3179 { append block data } 3180 current_asmdata.asmlists[al_dwarf_info].concatlist(templist); 3181 append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef)); 3182 3183 templist.free; 3184 3185 finish_entry; 3186 end; 3187 3188 3189 procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym); 3190 begin 3191 current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true)))); 3192 end; 3193 3194 3195 procedure TDebugInfoDwarf.insertmoduleinfo; 3196 var 3197 templist: TAsmList; 3198 linelist: TAsmList; 3199 lbl : tasmlabel; 3200 n,m : Integer; 3201 ditem : TDirIndexItem; 3202 fitem : TFileIndexItem; 3203 flist : TFPList; 3204 dbgname : String; 3205 begin 3206 { insert DEBUGSTART and DEBUGEND labels } 3207 dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,''); 3208 { Darwin's linker does not like two global labels both pointing to the 3209 end of a section, which can happen in case of units without code -> 3210 make them local; we don't need the debugtable stuff there either, 3211 so it doesn't matter that they are not global. 3212 } 3213 if (target_info.system in systems_darwin) then 3214 dbgname:='L'+dbgname; 3215 new_section(current_asmdata.asmlists[al_start],sec_code,dbgname,0,secorder_begin); 3216 if not(target_info.system in systems_darwin) then 3217 current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype)) 3218 else 3219 current_asmdata.asmlists[al_start].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype)); 3220 3221 dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,''); 3222 { See above. } 3223 if (target_info.system in systems_darwin) then 3224 dbgname:='L'+dbgname; 3225 new_section(current_asmdata.asmlists[al_end],sec_code,dbgname,0,secorder_end); 3226 if not(target_info.system in systems_darwin) then 3227 current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype)) 3228 else 3229 current_asmdata.asmlists[al_end].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype)); 3230 3231 { insert .Ldebug_abbrev0 label } 3232 templist:=TAsmList.create; 3233 new_section(templist,sec_debug_abbrev,'',0); 3234 templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrevsection0',AT_METADATA,0,voidpointertype)); 3235 { add any extra stuff which needs to be in the abbrev section, but before } 3236 { the actual abbreviations, in between the symbol above and below, i.e. here } 3237 templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrev0',AT_METADATA,0,voidpointertype)); 3238 current_asmdata.asmlists[al_start].insertlist(templist); 3239 templist.free; 3240 3241 { insert .Ldebug_line0 label } 3242 templist:=TAsmList.create; 3243 new_section(templist,sec_debug_line,'',0); 3244 templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_linesection0',AT_METADATA,0,voidpointertype)); 3245 { add any extra stuff which needs to be in the line section, but before } 3246 { the actual line info, in between the symbol above and below, i.e. here } 3247 templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_line0',AT_METADATA,0,voidpointertype)); 3248 current_asmdata.asmlists[al_start].insertlist(templist); 3249 templist.free; 3250 3251 { finalize line info if the unit doesn't contain any function/ } 3252 { procedure/init/final code } 3253 finish_lineinfo; 3254 3255 { debug line header } 3256 linelist := current_asmdata.asmlists[al_dwarf_line]; 3257 new_section(linelist,sec_debug_line,'',0); 3258 linelist.concat(tai_comment.Create(strpnew('=== header start ==='))); 3259 3260 { size } 3261 current_asmdata.getlabel(lbl,alt_dbgfile); 3262 if use_64bit_headers then 3263 linelist.concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF))); 3264 linelist.concat(tai_const.create_rel_sym(offsetreltype, 3265 lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_line0',AB_LOCAL,AT_METADATA,voidpointertype))); 3266 linelist.concat(tai_label.create(lbl)); 3267 3268 { version } 3269 linelist.concat(tai_const.create_16bit_unaligned(dwarf_version)); 3270 3271 { header length } 3272 current_asmdata.getlabel(lbl,alt_dbgfile); 3273 linelist.concat(tai_const.create_rel_sym(offsetreltype, 3274 lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'ehdebug_line0',AB_LOCAL,AT_METADATA,voidpointertype))); 3275 linelist.concat(tai_label.create(lbl)); 3276 3277 { minimum_instruction_length } 3278 linelist.concat(tai_const.create_8bit(1)); 3279 3280 { default_is_stmt } 3281 linelist.concat(tai_const.create_8bit(1)); 3282 3283 { line_base } 3284 linelist.concat(tai_const.create_8bit(LINE_BASE)); 3285 3286 { line_range } 3287 { only line increase, no adress } 3288 linelist.concat(tai_const.create_8bit(255)); 3289 3290 { opcode_base } 3291 linelist.concat(tai_const.create_8bit(OPCODE_BASE)); 3292 3293 { standard_opcode_lengths } 3294 { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) } 3295 { DW_LNS_copy } 3296 linelist.concat(tai_const.create_8bit(0)); 3297 { DW_LNS_advance_pc } 3298 linelist.concat(tai_const.create_8bit(1)); 3299 { DW_LNS_advance_line } 3300 linelist.concat(tai_const.create_8bit(1)); 3301 { DW_LNS_set_file } 3302 linelist.concat(tai_const.create_8bit(1)); 3303 { DW_LNS_set_column } 3304 linelist.concat(tai_const.create_8bit(1)); 3305 { DW_LNS_negate_stmt } 3306 linelist.concat(tai_const.create_8bit(0)); 3307 { DW_LNS_set_basic_block } 3308 linelist.concat(tai_const.create_8bit(0)); 3309 { DW_LNS_const_add_pc } 3310 linelist.concat(tai_const.create_8bit(0)); 3311 { DW_LNS_fixed_advance_pc } 3312 linelist.concat(tai_const.create_8bit(1)); 3313 { DW_LNS_set_prologue_end } 3314 linelist.concat(tai_const.create_8bit(0)); 3315 { DW_LNS_set_epilogue_begin } 3316 linelist.concat(tai_const.create_8bit(0)); 3317 { DW_LNS_set_isa } 3318 linelist.concat(tai_const.create_8bit(1)); 3319 3320 { Create single list of filenames sorted in IndexNr } 3321 flist:=TFPList.Create; 3322 for n := 0 to dirlist.Count - 1 do 3323 begin 3324 ditem := TDirIndexItem(dirlist[n]); 3325 for m := 0 to ditem.Files.Count - 1 do 3326 flist.Add(ditem.Files[m]); 3327 end; 3328 flist.Sort(@FileListSortCompare); 3329 3330 { include_directories } 3331 linelist.concat(tai_comment.Create(strpnew('include_directories'))); 3332 for n := 0 to dirlist.Count - 1 do 3333 begin 3334 ditem := TDirIndexItem(dirlist[n]); 3335 if ditem.Name = '.' then 3336 Continue; 3337 { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist } 3338 3339 linelist.concat(tai_string.create(ditem.Name+#0)); 3340 end; 3341 linelist.concat(tai_const.create_8bit(0)); 3342 3343 { file_names } 3344 linelist.concat(tai_comment.Create(strpnew('file_names'))); 3345 for n := 0 to flist.Count - 1 do 3346 begin 3347 fitem := TFileIndexItem(flist[n]); 3348 { file name } 3349 linelist.concat(tai_string.create(fitem.Name+#0)); 3350 { directory index } 3351 linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex)); 3352 { last modification } 3353 linelist.concat(tai_const.create_uleb128bit(0)); 3354 { file length } 3355 linelist.concat(tai_const.create_uleb128bit(0)); 3356 end; 3357 linelist.concat(tai_const.create_8bit(0)); 3358 3359 { end of debug line header } 3360 linelist.concat(tai_symbol.createname(target_asm.labelprefix+'ehdebug_line0',AT_METADATA,0,voidpointertype)); 3361 linelist.concat(tai_comment.Create(strpnew('=== header end ==='))); 3362 3363 { add line program } 3364 linelist.concatList(asmline); 3365 3366 { end of debug line table } 3367 linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_METADATA,0,voidpointertype)); 3368 3369 flist.free; 3370 end; 3371 3372 3373 procedure TDebugInfoDwarf.inserttypeinfo; 3374 3375 3376 var 3377 storefilepos : tfileposinfo; 3378 lenstartlabel,arangestartlabel: tasmlabel; 3379 i : longint; 3380 def: tdef; 3381 dbgname: string; 3382 vardatatype: ttypesym; 3383 bind: tasmsymbind; 3384 lang: tdwarf_source_language; 3385 begin 3386 current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo; 3387 storefilepos:=current_filepos; 3388 current_filepos:=current_module.mainfilepos; 3389 3390 if assigned(dwarflabels) then 3391 internalerror(2015100301); 3392 { one item per def, plus some extra space in case of nested types, 3393 externally used types etc (it will grow further if necessary) } 3394 i:=current_module.localsymtable.DefList.count*4; 3395 if assigned(current_module.globalsymtable) then 3396 inc(i,current_module.globalsymtable.DefList.count*2); 3397 dwarflabels:=TDwarfLabHashSet.Create(i,true,false); 3398 3399 currabbrevnumber:=0; 3400 3401 defnumberlist:=TFPObjectList.create(false); 3402 deftowritelist:=TFPObjectList.create(false); 3403 3404 { not exported (FK) 3405 FILEREC 3406 TEXTREC 3407 } 3408 vardatatype:=try_search_system_type('TVARDATA'); 3409 if assigned(vardatatype) then 3410 vardatadef:=trecorddef(vardatatype.typedef); 3411 3412 { write start labels } 3413 new_section(current_asmdata.asmlists[al_dwarf_info],sec_debug_info,'',0); 3414 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'debug_info0',AT_METADATA,0,voidpointertype)); 3415 3416 { start abbrev section } 3417 new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0); 3418 3419 if not(target_info.system in systems_darwin) then 3420 begin 3421 { start aranges section } 3422 new_section(current_asmdata.asmlists[al_dwarf_aranges],sec_debug_aranges,'',0); 3423 3424 current_asmdata.getlabel(arangestartlabel,alt_dbgfile); 3425 3426 if use_64bit_headers then 3427 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF))); 3428 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype, 3429 arangestartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'earanges0',AB_LOCAL,AT_METADATA,voidpointertype))); 3430 3431 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_label.create(arangestartlabel)); 3432 3433 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_16bit_unaligned(2)); 3434 3435 if not(tf_dwarf_relative_addresses in target_info.flags) then 3436 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_type_sym(offsetabstype, 3437 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype))) 3438 else 3439 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype, 3440 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_infosection0',AB_LOCAL,AT_METADATA,voidpointertype), 3441 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype))); 3442 3443 {$ifdef i8086} 3444 { address_size } 3445 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(4)); 3446 { segment_size } 3447 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(2)); 3448 { no alignment/padding bytes on i8086 for Open Watcom compatibility } 3449 {$else i8086} 3450 { address_size } 3451 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(sizeof(pint))); 3452 { segment_size } 3453 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(0)); 3454 { alignment } 3455 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(0)); 3456 {$endif i8086} 3457 3458 { start ranges section } 3459 new_section(current_asmdata.asmlists[al_dwarf_ranges],sec_debug_ranges,'',0); 3460 end; 3461 3462 { debug info header } 3463 current_asmdata.getlabel(lenstartlabel,alt_dbgfile); 3464 { size } 3465 if use_64bit_headers then 3466 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF))); 3467 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype, 3468 lenstartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_info0',AB_LOCAL,AT_METADATA,voidpointertype))); 3469 3470 current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel)); 3471 { version } 3472 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(dwarf_version)); 3473 { abbrev table (=relative from section start)} 3474 if not(tf_dwarf_relative_addresses in target_info.flags) then 3475 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype, 3476 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype))) 3477 else 3478 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype, 3479 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0',AB_LOCAL,AT_METADATA,voidpointertype), 3480 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype))); 3481 3482 { address size } 3483 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint))); 3484 3485 if (ds_dwarf_cpp in current_settings.debugswitches) then 3486 lang:=DW_LANG_C_plus_plus 3487 else 3488 lang:=DW_LANG_Pascal83; 3489 { first manadatory compilation unit TAG } 3490 append_entry(DW_TAG_compile_unit,true,[ 3491 DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path+current_module.sourcefiles.get_file(1).name)+#0, 3492 DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0, 3493 DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0, 3494 DW_AT_language,DW_FORM_data1,lang, 3495 DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]); 3496 3497 {$ifdef i8086} 3498 case current_settings.x86memorymodel of 3499 mm_tiny, 3500 mm_small: 3501 append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_small]); 3502 mm_medium: 3503 append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_medium]); 3504 mm_compact: 3505 append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_compact]); 3506 mm_large: 3507 append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_large]); 3508 mm_huge: 3509 append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_huge]); 3510 else 3511 internalerror(2018052402); 3512 end; 3513 {$endif i8086} 3514 3515 { reference to line info section } 3516 if not(tf_dwarf_relative_addresses in target_info.flags) then 3517 append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype)) 3518 else 3519 append_labelentry_dataptr_rel(DW_AT_stmt_list, 3520 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_linesection0',AB_LOCAL,AT_METADATA,voidpointertype), 3521 current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype)); 3522 3523 if (m_objectivec1 in current_settings.modeswitches) then 3524 append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]); 3525 3526 dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,''); 3527 if (target_info.system in systems_darwin) then 3528 begin 3529 bind:=AB_LOCAL; 3530 dbgname:='L'+dbgname; 3531 end 3532 else 3533 bind:=AB_GLOBAL; 3534 append_labelentry(DW_AT_low_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype)); 3535 dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,''); 3536 if (target_info.system in systems_darwin) then 3537 dbgname:='L'+dbgname; 3538 append_labelentry(DW_AT_high_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype)); 3539 3540 finish_entry; 3541 3542 { write all global/local variables. This will flag all required tdefs } 3543 if assigned(current_module.globalsymtable) then 3544 write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); 3545 if assigned(current_module.localsymtable) then 3546 write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); 3547 3548 { write all procedures and methods. This will flag all required tdefs } 3549 if assigned(current_module.globalsymtable) then 3550 write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); 3551 if assigned(current_module.localsymtable) then 3552 write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); 3553 3554 { reset unit type info flag } 3555 reset_unit_type_info; 3556 3557 { write used types from the used units } 3558 write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module); 3559 3560 { last write the types from this unit } 3561 if assigned(current_module.globalsymtable) then 3562 write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); 3563 if assigned(current_module.localsymtable) then 3564 write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); 3565 3566 { write defs not written yet } 3567 write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]); 3568 3569 { close compilation unit entry } 3570 finish_children; 3571 3572 { end of debug info table } 3573 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_METADATA,0,voidpointertype)); 3574 3575 { end of abbrev table } 3576 current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); 3577 3578 if not(target_info.system in systems_darwin) then 3579 begin 3580 { end of aranges table } 3581 {$ifdef i8086} 3582 { 32-bit offset } 3583 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0)); 3584 { 16-bit segment } 3585 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0)); 3586 { 32-bit length } 3587 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0)); 3588 {$else i8086} 3589 { offset } 3590 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0)); 3591 { length } 3592 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0)); 3593 {$endif i8086} 3594 current_asmdata.asmlists[al_dwarf_aranges].concat(tai_symbol.createname(target_asm.labelprefix+'earanges0',AT_METADATA,0,voidpointertype)); 3595 end; 3596 3597 { reset all def debug states } 3598 for i:=0 to defnumberlist.count-1 do 3599 begin 3600 def := tdef(defnumberlist[i]); 3601 if assigned(def) then 3602 def.dbg_state:=dbg_state_unused; 3603 end; 3604 dwarflabels.free; 3605 dwarflabels:=nil; 3606 3607 defnumberlist.free; 3608 defnumberlist:=nil; 3609 deftowritelist.free; 3610 deftowritelist:=nil; 3611 3612 current_filepos:=storefilepos; 3613 end; 3614 3615 3616 procedure TDebugInfoDwarf.referencesections(list:TAsmList); 3617 var 3618 hp : tmodule; 3619 begin 3620 { Reference all DEBUGINFO sections from the main .fpc section } 3621 { to prevent eliminating them by smartlinking } 3622 if (target_info.system in ([system_powerpc_macosclassic]+systems_darwin)) then 3623 exit; 3624 new_section(list,sec_fpc,'links',0); 3625 3626 { include reference to all debuginfo sections of used units } 3627 hp:=tmodule(loaded_units.first); 3628 while assigned(hp) do 3629 begin 3630 If ((hp.flags and uf_has_dwarf_debuginfo)=uf_has_dwarf_debuginfo) and not assigned(hp.package) then 3631 begin 3632 list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0)); 3633 list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0)); 3634 end; 3635 hp:=tmodule(hp.next); 3636 end; 3637 end; 3638 3639 TDebugInfoDwarf.symnamenull3640 function TDebugInfoDwarf.symname(sym: tsym; manglename: boolean): String; 3641 begin 3642 if (sym.typ=paravarsym) and 3643 (vo_is_self in tparavarsym(sym).varoptions) then 3644 { We use 'this' for regular methods because that's what gdb triggers 3645 on to automatically search fields. Don't do this for class methods, 3646 because search class fields is not supported, and gdb 7.0+ fails 3647 in this case because "this" is not a record in that case (it's a 3648 pointer to a vmt) } 3649 if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and 3650 not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then 3651 result:='this' 3652 else 3653 result:='self' 3654 else if (sym.typ=typesym) and 3655 is_objc_class_or_protocol(ttypesym(sym).typedef) then 3656 result:=tobjectdef(ttypesym(sym).typedef).objextname^ 3657 else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and 3658 (sym.typ=procsym) and 3659 (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then 3660 begin 3661 result:=tprocsym(sym).owner.name^+'__'; 3662 if manglename then 3663 result := result + sym.name 3664 else 3665 result := result + symdebugname(sym); 3666 end 3667 else 3668 begin 3669 if manglename then 3670 result := sym.name 3671 else 3672 result := symdebugname(sym); 3673 end; 3674 end; 3675 3676 3677 procedure TDebugInfoDwarf.append_visibility(vis: tvisibility); 3678 begin 3679 case vis of 3680 vis_private, 3681 vis_strictprivate: 3682 append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]); 3683 vis_protected, 3684 vis_strictprotected: 3685 append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]); 3686 vis_public: 3687 { default }; 3688 end; 3689 end; 3690 3691 3692 procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList); 3693 var 3694 currfileinfo, 3695 lastfileinfo : tfileposinfo; 3696 currfuncname : pshortstring; 3697 currstatement: boolean; 3698 currsectype : TAsmSectiontype; 3699 hp, hpend : tai; 3700 infile : tinputfile; 3701 prevcolumn, 3702 diffline, 3703 prevline, 3704 prevfileidx, 3705 currfileidx, 3706 nolineinfolevel : Integer; 3707 prevlabel, 3708 currlabel : tasmlabel; 3709 begin 3710 {$ifdef OMFOBJSUPPORT} 3711 if ds_dwarf_omf_linnum in current_settings.debugswitches then 3712 dbgcodeview.InsertLineInfo_OMF_LINNUM_MsLink(list); 3713 {$endif OMFOBJSUPPORT} 3714 { this function will always terminate the lineinfo block } 3715 generated_lineinfo := true; 3716 { if this unit only contains code without debug info (implicit init 3717 or final etc), make sure the file table contains at least one entry 3718 (the main source of the unit), because normally this table gets 3719 populated via calls to get_file_index and that won't happen in this 3720 case } 3721 get_file_index(current_module.sourcefiles.get_file(1)); 3722 FillChar(lastfileinfo,sizeof(lastfileinfo),0); 3723 currfuncname:=nil; 3724 currsectype:=sec_code; 3725 hp:=Tai(list.first); 3726 currstatement:=true; 3727 prevcolumn := 0; 3728 prevline := 1; 3729 prevfileidx := 1; 3730 prevlabel := nil; 3731 nolineinfolevel:=0; 3732 while assigned(hp) do 3733 begin 3734 case hp.typ of 3735 ait_section : 3736 currsectype:=tai_section(hp).sectype; 3737 ait_function_name : 3738 begin 3739 currfuncname:=tai_function_name(hp).funcname; 3740 asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^))); 3741 end; 3742 ait_force_line : 3743 begin 3744 lastfileinfo.line:=-1; 3745 end; 3746 ait_marker : 3747 begin 3748 case tai_marker(hp).kind of 3749 mark_NoLineInfoStart: 3750 inc(nolineinfolevel); 3751 mark_NoLineInfoEnd: 3752 dec(nolineinfolevel); 3753 end; 3754 end; 3755 end; 3756 3757 if (currsectype=sec_code) and 3758 (hp.typ=ait_instruction) then 3759 begin 3760 currfileinfo:=tailineinfo(hp).fileinfo; 3761 { file changed ? (must be before line info) } 3762 if (currfileinfo.fileindex<>0) and 3763 ((lastfileinfo.fileindex<>currfileinfo.fileindex) or 3764 (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then 3765 begin 3766 infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex); 3767 if assigned(infile) then 3768 begin 3769 currfileidx := get_file_index(infile); 3770 if prevfileidx <> currfileidx then 3771 begin 3772 list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path)), hp); 3773 list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name)), hp); 3774 list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp); 3775 3776 { set file } 3777 asmline.concat(tai_comment.Create(strpnew('path: '+infile.path))); 3778 asmline.concat(tai_comment.Create(strpnew('file: '+infile.name))); 3779 asmline.concat(tai_const.create_8bit(DW_LNS_set_file)); 3780 asmline.concat(tai_const.create_uleb128bit(currfileidx)); 3781 3782 prevfileidx := currfileidx; 3783 end; 3784 { force new line info } 3785 lastfileinfo.line:=-1; 3786 end; 3787 end; 3788 3789 { Set the line-nr to 0 if the code does not corresponds to a particular line } 3790 if nolineinfolevel>0 then 3791 currfileinfo.line := 0; 3792 3793 { line changed ? } 3794 if (lastfileinfo.line<>currfileinfo.line) and ((currfileinfo.line<>0) or (nolineinfolevel>0)) then 3795 begin 3796 { set address } 3797 current_asmdata.getlabel(currlabel, alt_dbgline); 3798 list.insertbefore(tai_label.create(currlabel), hp); 3799 3800 asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']'))); 3801 3802 if (prevlabel = nil) or 3803 { darwin's assembler cannot create an uleb128 of the difference } 3804 { between to symbols } 3805 { same goes for Solaris native assembler } 3806 (target_info.system in systems_darwin) or 3807 (target_asm.id=as_solaris_as) then 3808 begin 3809 asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); 3810 asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); 3811 asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); 3812 asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel)); 3813 {$ifdef i8086} 3814 { on i8086 we also emit an Open Watcom-specific 'set segment' op } 3815 asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); 3816 asmline.concat(tai_const.create_uleb128bit(3)); 3817 asmline.concat(tai_const.create_8bit(DW_LNE_set_segment)); 3818 asmline.concat(tai_const.Create_seg_name(currlabel.Name)); 3819 {$endif i8086} 3820 end 3821 else 3822 begin 3823 asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc)); 3824 asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel)); 3825 end; 3826 prevlabel := currlabel; 3827 3828 { set column } 3829 if prevcolumn <> currfileinfo.column then 3830 begin 3831 asmline.concat(tai_const.create_8bit(DW_LNS_set_column)); 3832 asmline.concat(tai_const.create_uleb128bit(currfileinfo.column)); 3833 prevcolumn := currfileinfo.column; 3834 end; 3835 3836 { set statement } 3837 if (currfileinfo.line=0) and currstatement then 3838 begin 3839 currstatement := false; 3840 asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt)); 3841 end; 3842 3843 if not currstatement and (currfileinfo.line>0) then 3844 begin 3845 currstatement := true; 3846 asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt)); 3847 end; 3848 3849 { set line } 3850 diffline := currfileinfo.line - prevline; 3851 if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then 3852 begin 3853 { use special opcode, this also adds a row } 3854 asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE)); 3855 end 3856 else 3857 begin 3858 if diffline <> 0 then 3859 begin 3860 asmline.concat(tai_const.create_8bit(DW_LNS_advance_line)); 3861 asmline.concat(tai_const.create_sleb128bit(diffline)); 3862 end; 3863 { no row added yet, do it manually } 3864 asmline.concat(tai_const.create_8bit(DW_LNS_copy)); 3865 end; 3866 prevline := currfileinfo.line; 3867 end; 3868 3869 lastfileinfo:=currfileinfo; 3870 end; 3871 3872 hpend:=hp; 3873 hp:=tai(hp.next); 3874 end; 3875 3876 if assigned(hpend) then 3877 begin 3878 { set address for end (see appendix 3 of dwarf 2 specs) } 3879 current_asmdata.getlabel(currlabel, alt_dbgline); 3880 list.insertafter(tai_label.create(currlabel), hpend); 3881 asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); 3882 asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); 3883 asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); 3884 asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel)); 3885 end; 3886 3887 { end sequence } 3888 asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op)); 3889 asmline.concat(tai_const.Create_8bit(1)); 3890 asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence)); 3891 asmline.concat(tai_comment.Create(strpnew('###################'))); 3892 end; 3893 3894 3895 procedure TDebugInfoDwarf.finish_lineinfo; 3896 var 3897 infile: tinputfile; 3898 begin 3899 { only needed if no line info at all has been generated } 3900 if generated_lineinfo then 3901 begin 3902 { reset for next module compilation } 3903 generated_lineinfo:=false; 3904 exit; 3905 end; 3906 { at least the Darwin linker is annoyed if you do not } 3907 { finish the lineinfo section, or if it doesn't } 3908 { contain at least one file name and set_address } 3909 infile:=current_module.sourcefiles.get_file(1); 3910 if not assigned(infile) then 3911 internalerror(2006020211); 3912 asmline.concat(tai_const.create_8bit(DW_LNS_set_file)); 3913 asmline.concat(tai_const.create_uleb128bit(get_file_index(infile))); 3914 3915 asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); 3916 asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); 3917 asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); 3918 asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,nil)); 3919 asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); 3920 asmline.concat(tai_const.Create_8bit(1)); 3921 asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence)); 3922 asmline.concat(tai_comment.Create(strpnew('###################'))); 3923 end; 3924 3925 {**************************************************************************** 3926 TDebugInfoDwarf2 3927 ****************************************************************************} 3928 3929 procedure TDebugInfoDwarf2.appenddef_file(list:TAsmList;def: tfiledef); 3930 begin 3931 { gdb 6.4 doesn't support files so far so we use some fake recorddef 3932 file recs. are less than 1k so using data2 is enough } 3933 if assigned(def.typesym) then 3934 append_entry(DW_TAG_structure_type,false,[ 3935 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 3936 DW_AT_byte_size,DW_FORM_udata,def.size 3937 ]) 3938 else 3939 append_entry(DW_TAG_structure_type,false,[ 3940 DW_AT_byte_size,DW_FORM_udata,def.size 3941 ]); 3942 finish_entry; 3943 end; 3944 3945 procedure TDebugInfoDwarf2.appenddef_formal(list:TAsmList;def: tformaldef); 3946 begin 3947 { gdb 6.4 doesn't support DW_TAG_unspecified_type so we 3948 replace it with a unsigned type with size 0 (FK) 3949 } 3950 append_entry(DW_TAG_base_type,false,[ 3951 DW_AT_name,DW_FORM_string,'FormalDef'#0, 3952 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 3953 DW_AT_byte_size,DW_FORM_data1,0 3954 ]); 3955 finish_entry; 3956 end; 3957 3958 procedure TDebugInfoDwarf2.append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString); 3959 begin 3960 if createlabel then 3961 begin 3962 if not(tf_dwarf_only_local_labels in target_info.flags) then 3963 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(def_dwarf_class_struct_lab(def),0)) 3964 else 3965 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0)); 3966 end; 3967 if assigned(objectname) then 3968 append_entry(DW_TAG_class_type,true,[ 3969 DW_AT_name,DW_FORM_string,objectname^+#0, 3970 DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize 3971 ]) 3972 else 3973 append_entry(DW_TAG_class_type,true,[ 3974 DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize 3975 ]); 3976 { Apple-specific tag that identifies it as an Objective-C class } 3977 if (def.objecttype=odt_objcclass) then 3978 append_attribute(DW_AT_APPLE_runtime_class,DW_FORM_data1,[DW_LANG_ObjC]); 3979 3980 finish_entry; 3981 if assigned(def.childof) then 3982 begin 3983 append_entry(DW_TAG_inheritance,false,[ 3984 DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public, 3985 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) 3986 ]); 3987 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 3988 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); 3989 if (def.childof.dbg_state=dbg_state_unused) then 3990 def.childof.dbg_state:=dbg_state_used; 3991 if is_implicit_pointer_object_type(def) then 3992 append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def.childof)) 3993 else 3994 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof)); 3995 finish_entry; 3996 end; 3997 if (oo_has_vmt in def.objectoptions) and 3998 (not assigned(def.childof) or 3999 not(oo_has_vmt in def.childof.objectoptions)) then 4000 begin 4001 { vmt field } 4002 append_entry(DW_TAG_member,false,[ 4003 DW_AT_artificial,DW_FORM_flag,true, 4004 DW_AT_name,DW_FORM_string,'_vptr$'+def.objname^+#0, 4005 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(def.vmt_offset) 4006 ]); 4007 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 4008 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(def.vmt_offset)); 4009 { should be changed into a pointer to a function returning an } 4010 { int and with TAG_unspecified_parameters } 4011 if (voidpointertype.dbg_state=dbg_state_unused) then 4012 voidpointertype.dbg_state:=dbg_state_used; 4013 append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype)); 4014 finish_entry; 4015 end; 4016 4017 def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); 4018 { Write the methods in the scope of the class/object, except for Objective-C. } 4019 if is_objc_class_or_protocol(def) then 4020 finish_children; 4021 { don't write procdefs of externally defined classes, gcc doesn't 4022 either (info is probably gotten from ObjC runtime) } 4023 if not(oo_is_external in def.objectoptions) then 4024 write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable); 4025 if not is_objc_class_or_protocol(def) then 4026 finish_children; 4027 end; 4028 4029 4030 procedure TDebugInfoDwarf2.appenddef_object(list:TAsmList;def: tobjectdef); 4031 4032 begin 4033 case def.objecttype of 4034 odt_cppclass, 4035 odt_object: 4036 append_object_struct(def,false,def.objname); 4037 odt_interfacecom, 4038 odt_interfacecorba, 4039 odt_dispinterface, 4040 odt_helper, 4041 odt_class: 4042 begin 4043 { implicit pointer } 4044 append_entry(DW_TAG_pointer_type,false,[]); 4045 append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def)); 4046 finish_entry; 4047 4048 append_object_struct(def,true,def.objname); 4049 end; 4050 odt_objcclass: 4051 { Objective-C class: same as regular class, except for 4052 a) Apple-specific tag that identifies it as an Objective-C class 4053 b) use extname^ instead of objname 4054 } 4055 append_object_struct(def,true,def.objextname); 4056 odt_objcprotocol: 4057 begin 4058 append_entry(DW_TAG_pointer_type,false,[]); 4059 append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype)); 4060 finish_entry; 4061 end; 4062 else 4063 internalerror(200602041); 4064 end; 4065 end; 4066 4067 procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean); 4068 var 4069 lab: tasmlabel; 4070 begin 4071 if force_tag_set or 4072 (ds_dwarf_sets in current_settings.debugswitches) then 4073 begin 4074 { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types } 4075 4076 if assigned(def.typesym) then 4077 append_entry(DW_TAG_set_type,false,[ 4078 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 4079 DW_AT_byte_size,DW_FORM_data2,def.size 4080 ]) 4081 else 4082 append_entry(DW_TAG_set_type,false,[ 4083 DW_AT_byte_size,DW_FORM_data2,def.size 4084 ]); 4085 if assigned(def.elementdef) then 4086 begin 4087 if not(tf_dwarf_only_local_labels in target_info.flags) then 4088 current_asmdata.getglobaldatalabel(lab) 4089 else 4090 current_asmdata.getaddrlabel(lab); 4091 append_labelentry_ref(DW_AT_type,lab); 4092 finish_entry; 4093 if lab.bind=AB_GLOBAL then 4094 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(lab,0)) 4095 else 4096 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0)); 4097 { Sets of e.g. [1..5] are actually stored as a set of [0..7], 4098 so write the exact boundaries of the set here. Let's hope no 4099 debugger ever rejects this because this "subrange" type can 4100 actually have a larger range than the original one. } 4101 append_entry(DW_TAG_subrange_type,false,[ 4102 DW_AT_lower_bound,DW_FORM_sdata,def.setbase, 4103 DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue 4104 ]); 4105 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)) 4106 end 4107 end 4108 else 4109 begin 4110 { gdb versions which don't support sets refuse to load the debug } 4111 { info of modules that contain set tags } 4112 if assigned(def.typesym) then 4113 append_entry(DW_TAG_base_type,false,[ 4114 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 4115 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 4116 DW_AT_byte_size,DW_FORM_data2,def.size 4117 ]) 4118 else 4119 append_entry(DW_TAG_base_type,false,[ 4120 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 4121 DW_AT_byte_size,DW_FORM_data2,def.size 4122 ]); 4123 end; 4124 finish_entry; 4125 end; 4126 4127 procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef); 4128 begin 4129 appenddef_set_intern(list,def,false); 4130 end; 4131 4132 procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef); 4133 begin 4134 { gdb 6.4 doesn't support DW_TAG_unspecified_type so we 4135 replace it with a unsigned type with size 0 (FK) 4136 } 4137 append_entry(DW_TAG_base_type,false,[ 4138 DW_AT_name,DW_FORM_string,'FormalDef'#0, 4139 DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, 4140 DW_AT_byte_size,DW_FORM_data1,0 4141 ]); 4142 finish_entry; 4143 end; 4144 4145 procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef); 4146 begin 4147 { variants aren't known to dwarf2 but writting tvardata should be enough } 4148 if assigned(vardatadef) then 4149 appenddef_record_named(list,trecorddef(vardatadef),'Variant'); 4150 end; 4151 TDebugInfoDwarf2.dwarf_versionnull4152 function TDebugInfoDwarf2.dwarf_version: Word; 4153 begin 4154 Result:=2; 4155 end; 4156 4157 {**************************************************************************** 4158 TDebugInfoDwarf3 4159 ****************************************************************************} 4160 4161 procedure TDebugInfoDwarf3.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); 4162 begin 4163 AddConstToAbbrev(ord(DW_FORM_ref_addr)); 4164 { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the 4165 target platform, but on the used Dwarf-format (32 bit or 64 bit) for the current compilation section. } 4166 if use_64bit_headers then 4167 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_64bit_unaligned,sym)) 4168 else 4169 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym)); 4170 end; 4171 4172 procedure tdebuginfodwarf3.appenddef_array(list: tasmlist; def: tarraydef); 4173 begin 4174 if not is_dynamic_array(def) then 4175 begin 4176 inherited appenddef_array(list,def); 4177 exit; 4178 end; 4179 4180 if assigned(def.typesym) then 4181 append_entry(DW_TAG_array_type,true,[ 4182 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 4183 DW_AT_data_location,DW_FORM_block1,2 4184 ]) 4185 else 4186 append_entry(DW_TAG_array_type,true,[ 4187 DW_AT_data_location,DW_FORM_block1,2 4188 ]); 4189 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4190 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4191 4192 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); 4193 finish_entry; 4194 { to simplify things, we don't write a multidimensional array here } 4195 append_entry(DW_TAG_subrange_type,false,[ 4196 DW_AT_byte_stride,DW_FORM_udata,def.elesize, 4197 DW_AT_lower_bound,DW_FORM_udata,0, 4198 DW_AT_upper_bound,DW_FORM_block1,14 4199 ]); 4200 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4201 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4202 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); 4203 { pointer = nil? } 4204 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); 4205 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(5)); 4206 { yes -> length = 0 } 4207 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_const1s))); 4208 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(-1))); 4209 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); 4210 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3)); 4211 { no -> load length } 4212 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size)); 4213 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); 4214 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4215 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef)); 4216 finish_entry; 4217 4218 finish_children; 4219 end; 4220 4221 4222 procedure tdebuginfodwarf3.appenddef_string(list: tasmlist; def: tstringdef); 4223 4224 procedure addstringdef(const name: shortstring; chardef: tdef; deref: boolean; lensize: aint); 4225 var 4226 upperopcodes: longint; 4227 begin 4228 { deref=true -> ansi/unicde/widestring; deref = false -> short/longstring } 4229 if assigned(def.typesym) then 4230 append_entry(DW_TAG_array_type,true,[ 4231 DW_AT_name,DW_FORM_string,name+#0, 4232 DW_AT_data_location,DW_FORM_block1,2+ord(not(deref)) 4233 ]) 4234 else 4235 append_entry(DW_TAG_array_type,true,[ 4236 DW_AT_data_location,DW_FORM_block1,2+ord(not(deref)) 4237 ]); 4238 4239 { in all cases we start with the address of the string } 4240 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4241 if deref then 4242 begin 4243 { ansi/unicode/widestring -> dereference the address of the string, and then 4244 we point to address of the string 4245 } 4246 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4247 end 4248 else 4249 begin 4250 { shortstring characters begin at string[1], so add one to the string's address } 4251 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+lensize)); 4252 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus))) 4253 end; 4254 4255 { reference to the element type of the string } 4256 append_labelentry_ref(DW_AT_type,def_dwarf_lab(chardef)); 4257 finish_entry; 4258 4259 { now the information about the length of the string } 4260 if deref then 4261 begin 4262 if not (is_widestring(def) and (tf_winlikewidestring in target_info.flags)) then 4263 upperopcodes:=13 4264 else 4265 upperopcodes:=16; 4266 { lower bound is always 1, upper bound (length) needs to be calculated } 4267 append_entry(DW_TAG_subrange_type,false,[ 4268 DW_AT_lower_bound,DW_FORM_udata,1, 4269 DW_AT_upper_bound,DW_FORM_block1,upperopcodes 4270 ]); 4271 4272 { high(string) is stored sizeof(sizeint) bytes before the string data } 4273 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4274 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4275 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); 4276 { pointer = nil? } 4277 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); 4278 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(4)); 4279 { yes -> length = 0 } 4280 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0))); 4281 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); 4282 if upperopcodes=16 then 4283 { skip the extra deref_size argument and the division by two of the length } 4284 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(6)) 4285 else 4286 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3)); 4287 { no -> load length } 4288 if upperopcodes=16 then 4289 { for Windows WideString the size is always a DWORD } 4290 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit4))) 4291 else 4292 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size)); 4293 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); 4294 if upperopcodes=16 then 4295 begin 4296 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size))); 4297 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4)); 4298 end 4299 else 4300 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4301 4302 { for widestrings, the length is specified in bytes, so divide by two } 4303 if (upperopcodes=16) then 4304 begin 4305 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1))); 4306 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr))); 4307 end; 4308 end 4309 else 4310 begin 4311 append_entry(DW_TAG_subrange_type,false,[ 4312 DW_AT_lower_bound,DW_FORM_udata,1, 4313 DW_AT_upper_bound,DW_FORM_block1,3 4314 ]); 4315 { for shortstrings, the length is the first byte of the string } 4316 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4317 { load 1 byte } 4318 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size))); 4319 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(lensize)); 4320 end; 4321 finish_entry; 4322 4323 finish_children; 4324 end; 4325 4326 begin 4327 if (ds_dwarf_cpp in current_settings.debugswitches) then 4328 begin 4329 // At least LLDB 6.0.0 does not like this implementation of string types. 4330 // Call the inherited DWARF 2 implementation, which works fine. 4331 inherited; 4332 exit; 4333 end; 4334 case def.stringtype of 4335 st_shortstring: 4336 begin 4337 addstringdef('ShortString',cansichartype,false,1); 4338 end; 4339 st_longstring: 4340 begin 4341 {$ifdef cpu64bitaddr} 4342 addstringdef('LongString',cansichartype,false,8); 4343 {$else cpu64bitaddr} 4344 addstringdef('LongString',cansichartype,false,4); 4345 {$endif cpu64bitaddr} 4346 end; 4347 st_ansistring: 4348 begin 4349 addstringdef('AnsiString',cansichartype,true,-1); 4350 end; 4351 st_unicodestring: 4352 begin 4353 addstringdef('UnicodeString',cwidechartype,true,-1); 4354 end; 4355 st_widestring: 4356 begin 4357 addstringdef('WideString',cwidechartype,true,-1) 4358 end; 4359 end; 4360 end; 4361 4362 procedure TDebugInfoDwarf3.appenddef_file(list:TAsmList;def: tfiledef); 4363 begin 4364 if assigned(def.typesym) then 4365 append_entry(DW_TAG_file_type,false,[ 4366 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0, 4367 DW_AT_byte_size,DW_FORM_data2,def.size 4368 ]) 4369 else 4370 append_entry(DW_TAG_file_type,false,[ 4371 DW_AT_byte_size,DW_FORM_data2,def.size 4372 ]); 4373 if tfiledef(def).filetyp=ft_typed then 4374 append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef)); 4375 finish_entry; 4376 end; 4377 4378 procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef); 4379 begin 4380 if (ds_dwarf_cpp in current_settings.debugswitches) then 4381 begin 4382 // Do not use DW_TAG_unspecified_type for C++ simulation. 4383 // At least LLDB 3.9.0 crashes in such case. 4384 // Call the inherited DWARF 2 implementation, which works fine. 4385 inherited; 4386 exit; 4387 end; 4388 4389 append_entry(DW_TAG_unspecified_type,false,[]); 4390 finish_entry; 4391 end; 4392 4393 procedure TDebugInfoDwarf3.appenddef_object(list:TAsmList;def: tobjectdef); 4394 4395 procedure dostruct(tag: tdwarf_tag); 4396 begin 4397 if assigned(def.objname) then 4398 append_entry(tag,true,[ 4399 DW_AT_name,DW_FORM_string,def.objrealname^+#0 4400 ]) 4401 else 4402 append_entry(DW_TAG_structure_type,true,[]); 4403 append_attribute(DW_AT_byte_size,DW_FORM_udata,[tobjectsymtable(def.symtable).datasize]); 4404 { an old style object and a cpp class are accessed directly, so we do not need DW_AT_allocated and DW_AT_data_location tags, 4405 see issue #36017 } 4406 if not(is_object(def) or is_cppclass(def)) then 4407 begin 4408 { The pointer to the class-structure is hidden. The debug-information 4409 does not contain an implicit pointer, but the data-adress is dereferenced here. 4410 In case of a nil-pointer, report the class as being unallocated. 4411 } 4412 append_block1(DW_AT_allocated,2); 4413 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4414 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4415 append_block1(DW_AT_data_location,2); 4416 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); 4417 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); 4418 end; 4419 finish_entry; 4420 end; 4421 4422 procedure doimplicitpointer; 4423 var 4424 obj : tasmlabel; 4425 begin 4426 if not(tf_dwarf_only_local_labels in target_info.flags) then 4427 current_asmdata.getglobaldatalabel(obj) 4428 else 4429 current_asmdata.getaddrlabel(obj); 4430 { implicit pointer } 4431 append_entry(DW_TAG_pointer_type,false,[]); 4432 append_labelentry_ref(DW_AT_type,obj); 4433 finish_entry; 4434 4435 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0)); 4436 end; 4437 4438 procedure doparent(isinterface: boolean); 4439 begin 4440 if not assigned(def.childof) then 4441 exit; 4442 4443 if isinterface then 4444 begin 4445 append_entry(DW_TAG_inheritance,false,[]); 4446 end 4447 else 4448 begin 4449 append_entry(DW_TAG_inheritance,false,[ 4450 DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public, 4451 DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) 4452 ]); 4453 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); 4454 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); 4455 end; 4456 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof)); 4457 finish_entry; 4458 end; 4459 4460 var 4461 n: integer; 4462 4463 begin 4464 case def.objecttype of 4465 odt_cppclass, 4466 odt_object: 4467 begin 4468 dostruct(DW_TAG_structure_type); 4469 doparent(false); 4470 end; 4471 odt_interfacecom, 4472 odt_interfacecorba, 4473 odt_dispinterface: 4474 begin 4475 dostruct(DW_TAG_interface_type); 4476 doparent(true); 4477 end; 4478 odt_helper, 4479 odt_class: 4480 begin 4481 //dostruct(DW_TAG_class_type); 4482 //doparent(false); 4483 append_entry(DW_TAG_pointer_type,false,[]); 4484 append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def)); 4485 finish_entry; 4486 4487 append_object_struct(def,true,def.objrealname); 4488 Exit; 4489 end; 4490 else 4491 internalerror(200609171); 4492 end; 4493 4494 { add implemented interfaces } 4495 if assigned(def.ImplementedInterfaces) then 4496 for n := 0 to def.ImplementedInterfaces.count-1 do 4497 begin 4498 append_entry(DW_TAG_inheritance,false,[]); 4499 append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef)); 4500 finish_entry; 4501 end; 4502 4503 { add members } 4504 def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); 4505 finish_children; 4506 end; 4507 4508 procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef); 4509 begin 4510 appenddef_set_intern(list,def,true); 4511 end; 4512 4513 procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef); 4514 begin 4515 { ??? can a undefined def have a typename ? } 4516 if assigned(def.typesym) then 4517 append_entry(DW_TAG_unspecified_type,false,[ 4518 DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0 4519 ]) 4520 else 4521 append_entry(DW_TAG_unspecified_type,false,[ 4522 ]); 4523 finish_entry; 4524 end; 4525 4526 procedure TDebugInfoDwarf3.appenddef_variant(list:TAsmList;def: tvariantdef); 4527 const 4528 VARIANTS: array[1..27] of record Value: Word; Name: String end = ( 4529 (value:0; name:''), 4530 (value:1; name:''), 4531 (value:2; name:'VSMALLINT'), 4532 (value:3; name:'VINTEGER'), 4533 (value:4; name:'VSINGLE'), 4534 (value:5; name:'VDOUBLE'), 4535 (value:6; name:'VCURRENCY'), 4536 (value:7; name:'VDATE'), 4537 (value:8; name:'VOLESTR'), 4538 (value:9; name:'VDISPATCH'), 4539 (value:10; name:'VERROR'), 4540 (value:11; name:'VBOOLEAN'), 4541 (value:12; name:''), 4542 (value:13; name:'VUNKNOWN'), 4543 (value:14; name:''), 4544 (value:16; name:'VSHORTINT'), 4545 (value:17; name:'VBYTE'), 4546 (value:18; name:'VWORD'), 4547 (value:19; name:'VLONGWORD'), 4548 (value:20; name:'VINT64'), 4549 (value:21; name:'VQWORD'), 4550 (value:36; name:'VRECORD'), 4551 (value:$48; name:''), 4552 (value:$100; name:'VSTRING'), 4553 (value:$101; name:'VANY'), 4554 (value:$2000; name:'VARRAY'), 4555 (value:$4000; name:'VPOINTER') 4556 ); 4557 var 4558 fs: tfieldvarsym; 4559 lbl: tasmlabel; 4560 idx: integer; 4561 begin 4562 { it could be done with DW_TAG_variant for the union part (if that info was available) 4563 now we do it manually for variants (MWE) } 4564 4565 { struct } 4566 append_entry(DW_TAG_structure_type,true,[ 4567 DW_AT_name,DW_FORM_string,'Variant'#0, 4568 DW_AT_byte_size,DW_FORM_udata,vardatadef.size 4569 ]); 4570 finish_entry; 4571 4572 append_entry(DW_TAG_variant_part,true,[ 4573 ]); 4574 current_asmdata.getaddrlabel(lbl); 4575 append_labelentry_ref(DW_AT_discr,lbl); 4576 finish_entry; 4577 4578 { discriminant } 4579 fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE')); 4580 if (fs = nil) or (fs.typ <> fieldvarsym) then 4581 internalerror(200609271); 4582 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0)); 4583 appendsym_fieldvar(list,fs); 4584 4585 { variants } 4586 for idx := Low(VARIANTS) to High(VARIANTS) do 4587 begin 4588 append_entry(DW_TAG_variant,true,[ 4589 DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value 4590 ]); 4591 finish_entry; 4592 4593 if VARIANTS[idx].name <> '' then 4594 begin 4595 fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name)); 4596 if (fs = nil) or (fs.typ <> fieldvarsym) then 4597 internalerror(20060927200+idx); 4598 appendsym_fieldvar(list,fs); 4599 end; 4600 4601 finish_children; { variant } 4602 end; 4603 4604 4605 finish_children; { variant part } 4606 4607 finish_children; { struct } 4608 end; 4609 TDebugInfoDwarf3.dwarf_versionnull4610 function TDebugInfoDwarf3.dwarf_version: Word; 4611 begin 4612 Result:=3; 4613 end; 4614 TDebugInfoDwarf3.symdebugnamenull4615 function TDebugInfoDwarf3.symdebugname(sym: tsym): String; 4616 begin 4617 Result:=sym.realname; 4618 end; 4619 4620 4621 { TDebugInfoDwarf4 } 4622 TDebugInfoDwarf4.dwarf_versionnull4623 function TDebugInfoDwarf4.dwarf_version: Word; 4624 begin 4625 Result:=4; 4626 end; 4627 4628 4629 {**************************************************************************** 4630 ****************************************************************************} 4631 const 4632 dbg_dwarf2_info : tdbginfo = 4633 ( 4634 id : dbg_dwarf2; 4635 idtxt : 'DWARF2'; 4636 ); 4637 4638 dbg_dwarf3_info : tdbginfo = 4639 ( 4640 id : dbg_dwarf3; 4641 idtxt : 'DWARF3'; 4642 ); 4643 4644 dbg_dwarf4_info : tdbginfo = 4645 ( 4646 id : dbg_dwarf4; 4647 idtxt : 'DWARF4'; 4648 ); 4649 4650 4651 initialization 4652 RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2); 4653 RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3); 4654 RegisterDebugInfo(dbg_dwarf4_info,TDebugInfoDwarf4); 4655 4656 end. 4657