dbgdwarf.pas 104 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807
  1. {
  2. Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl
  3. This units contains support for DWARF debug info generation
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {
  18. This units contains support for DWARF debug info generation.
  19. Currently a lot of code looks like being mergable with dbgstabs. This might
  20. change however when improved dwarf info is generated, so the stuff shouldn't be
  21. merged yet. (FK)
  22. The easiest way to debug dwarf debug info generation is the usage of
  23. readelf --debug-dump <executable>
  24. This works only with elf targets though.
  25. }
  26. unit dbgdwarf;
  27. {$i fpcdefs.inc}
  28. interface
  29. uses
  30. cclasses,
  31. aasmbase,aasmtai,aasmdata,
  32. symbase,symtype,symdef,symsym,
  33. finput,
  34. DbgBase;
  35. type
  36. { Tag names and codes. }
  37. tdwarf_tag = (DW_TAG_padding := $00,DW_TAG_array_type := $01,
  38. DW_TAG_class_type := $02,DW_TAG_entry_point := $03,
  39. DW_TAG_enumeration_type := $04,DW_TAG_formal_parameter := $05,
  40. DW_TAG_imported_declaration := $08,DW_TAG_label := $0a,
  41. DW_TAG_lexical_block := $0b,DW_TAG_member := $0d,
  42. DW_TAG_pointer_type := $0f,DW_TAG_reference_type := $10,
  43. DW_TAG_compile_unit := $11,DW_TAG_string_type := $12,
  44. DW_TAG_structure_type := $13,DW_TAG_subroutine_type := $15,
  45. DW_TAG_typedef := $16,DW_TAG_union_type := $17,
  46. DW_TAG_unspecified_parameters := $18,
  47. DW_TAG_variant := $19,DW_TAG_common_block := $1a,
  48. DW_TAG_common_inclusion := $1b,DW_TAG_inheritance := $1c,
  49. DW_TAG_inlined_subroutine := $1d,DW_TAG_module := $1e,
  50. DW_TAG_ptr_to_member_type := $1f,DW_TAG_set_type := $20,
  51. DW_TAG_subrange_type := $21,DW_TAG_with_stmt := $22,
  52. DW_TAG_access_declaration := $23,DW_TAG_base_type := $24,
  53. DW_TAG_catch_block := $25,DW_TAG_const_type := $26,
  54. DW_TAG_constant := $27,DW_TAG_enumerator := $28,
  55. DW_TAG_file_type := $29,DW_TAG_friend := $2a,
  56. DW_TAG_namelist := $2b,DW_TAG_namelist_item := $2c,
  57. DW_TAG_packed_type := $2d,DW_TAG_subprogram := $2e,
  58. DW_TAG_template_type_param := $2f,DW_TAG_template_value_param := $30,
  59. DW_TAG_thrown_type := $31,DW_TAG_try_block := $32,
  60. DW_TAG_variant_part := $33,DW_TAG_variable := $34,
  61. DW_TAG_volatile_type := $35,
  62. { DWARF 3. }
  63. DW_TAG_dwarf_procedure := $36,
  64. DW_TAG_restrict_type := $37,DW_TAG_interface_type := $38,
  65. DW_TAG_namespace := $39,DW_TAG_imported_module := $3a,
  66. DW_TAG_unspecified_type := $3b,DW_TAG_partial_unit := $3c,
  67. DW_TAG_imported_unit := $3d,
  68. { SGI/MIPS Extensions. }
  69. DW_TAG_MIPS_loop := $4081,
  70. { HP extensions. See: ftp://ftp.hp.com/pub/lang/tools/WDB/wdb-4.0.tar.gz . }
  71. DW_TAG_HP_array_descriptor := $4090,
  72. { GNU extensions. }
  73. { For FORTRAN 77 and Fortran 90. }
  74. DW_TAG_format_label := $4101,
  75. { For C++. }
  76. DW_TAG_function_template := $4102,DW_TAG_class_template := $4103,
  77. DW_TAG_GNU_BINCL := $4104,DW_TAG_GNU_EINCL := $4105,
  78. { Extensions for UPC. See: http://upc.gwu.edu/~upc. }
  79. DW_TAG_upc_shared_type := $8765,DW_TAG_upc_strict_type := $8766,
  80. DW_TAG_upc_relaxed_type := $8767,
  81. { PGI (STMicroelectronics) extensions. No documentation available. }
  82. DW_TAG_PGI_kanji_type := $A000,
  83. DW_TAG_PGI_interface_block := $A020);
  84. { Attribute names and codes. }
  85. tdwarf_attribute = (DW_AT_sibling := $01,DW_AT_location := $02,
  86. DW_AT_name := $03,DW_AT_ordering := $09,
  87. DW_AT_subscr_data := $0a,DW_AT_byte_size := $0b,
  88. DW_AT_bit_offset := $0c,DW_AT_bit_size := $0d,
  89. DW_AT_element_list := $0f,DW_AT_stmt_list := $10,
  90. DW_AT_low_pc := $11,DW_AT_high_pc := $12,
  91. DW_AT_language := $13,DW_AT_member := $14,
  92. DW_AT_discr := $15,DW_AT_discr_value := $16,
  93. DW_AT_visibility := $17,DW_AT_import := $18,
  94. DW_AT_string_length := $19,DW_AT_common_reference := $1a,
  95. DW_AT_comp_dir := $1b,DW_AT_const_value := $1c,
  96. DW_AT_containing_type := $1d,DW_AT_default_value := $1e,
  97. DW_AT_inline := $20,DW_AT_is_optional := $21,
  98. DW_AT_lower_bound := $22,DW_AT_producer := $25,
  99. DW_AT_prototyped := $27,DW_AT_return_addr := $2a,
  100. DW_AT_start_scope := $2c,DW_AT_stride_size := $2e,
  101. DW_AT_upper_bound := $2f,DW_AT_abstract_origin := $31,
  102. DW_AT_accessibility := $32,DW_AT_address_class := $33,
  103. DW_AT_artificial := $34,DW_AT_base_types := $35,
  104. DW_AT_calling_convention := $36,DW_AT_count := $37,
  105. DW_AT_data_member_location := $38,DW_AT_decl_column := $39,
  106. DW_AT_decl_file := $3a,DW_AT_decl_line := $3b,
  107. DW_AT_declaration := $3c,DW_AT_discr_list := $3d,
  108. DW_AT_encoding := $3e,DW_AT_external := $3f,
  109. DW_AT_frame_base := $40,DW_AT_friend := $41,
  110. DW_AT_identifier_case := $42,DW_AT_macro_info := $43,
  111. DW_AT_namelist_items := $44,DW_AT_priority := $45,
  112. DW_AT_segment := $46,DW_AT_specification := $47,
  113. DW_AT_static_link := $48,DW_AT_type := $49,
  114. DW_AT_use_location := $4a,DW_AT_variable_parameter := $4b,
  115. DW_AT_virtuality := $4c,DW_AT_vtable_elem_location := $4d,
  116. { DWARF 3 values. }
  117. DW_AT_allocated := $4e,DW_AT_associated := $4f,
  118. DW_AT_data_location := $50,DW_AT_stride := $51,
  119. DW_AT_entry_pc := $52,DW_AT_use_UTF8 := $53,
  120. DW_AT_extension := $54,DW_AT_ranges := $55,
  121. DW_AT_trampoline := $56,DW_AT_call_column := $57,
  122. DW_AT_call_file := $58,DW_AT_call_line := $59,
  123. { SGI/MIPS extensions. }
  124. DW_AT_MIPS_fde := $2001,DW_AT_MIPS_loop_begin := $2002,
  125. DW_AT_MIPS_tail_loop_begin := $2003,DW_AT_MIPS_epilog_begin := $2004,
  126. DW_AT_MIPS_loop_unroll_factor := $2005,
  127. DW_AT_MIPS_software_pipeline_depth := $2006,
  128. DW_AT_MIPS_linkage_name := $2007,DW_AT_MIPS_stride := $2008,
  129. DW_AT_MIPS_abstract_name := $2009,DW_AT_MIPS_clone_origin := $200a,
  130. DW_AT_MIPS_has_inlines := $200b,
  131. { HP extensions. }
  132. DW_AT_HP_block_index := $2000,
  133. DW_AT_HP_unmodifiable := $2001,DW_AT_HP_actuals_stmt_list := $2010,
  134. DW_AT_HP_proc_per_section := $2011,DW_AT_HP_raw_data_ptr := $2012,
  135. DW_AT_HP_pass_by_reference := $2013,DW_AT_HP_opt_level := $2014,
  136. DW_AT_HP_prof_version_id := $2015,DW_AT_HP_opt_flags := $2016,
  137. DW_AT_HP_cold_region_low_pc := $2017,DW_AT_HP_cold_region_high_pc := $2018,
  138. DW_AT_HP_all_variables_modifiable := $2019,
  139. DW_AT_HP_linkage_name := $201a,DW_AT_HP_prof_flags := $201b,
  140. { GNU extensions. }
  141. DW_AT_sf_names := $2101,DW_AT_src_info := $2102,
  142. DW_AT_mac_info := $2103,DW_AT_src_coords := $2104,
  143. DW_AT_body_begin := $2105,DW_AT_body_end := $2106,
  144. DW_AT_GNU_vector := $2107,
  145. { VMS extensions. }
  146. DW_AT_VMS_rtnbeg_pd_address := $2201,
  147. { UPC extension. }
  148. DW_AT_upc_threads_scaled := $3210,
  149. { PGI (STMicroelectronics) extensions. }
  150. DW_AT_PGI_lbase := $3a00,
  151. DW_AT_PGI_soffset := $3a01,DW_AT_PGI_lstride := $3a02
  152. );
  153. { Form names and codes. }
  154. Tdwarf_form = (DW_FORM_addr := $01,DW_FORM_block2 := $03,
  155. DW_FORM_block4 := $04,DW_FORM_data2 := $05,
  156. DW_FORM_data4 := $06,DW_FORM_data8 := $07,
  157. DW_FORM_string := $08,DW_FORM_block := $09,
  158. DW_FORM_block1 := $0a,DW_FORM_data1 := $0b,
  159. DW_FORM_flag := $0c,DW_FORM_sdata := $0d,
  160. DW_FORM_strp := $0e,DW_FORM_udata := $0f,
  161. DW_FORM_ref_addr := $10,DW_FORM_ref1 := $11,
  162. DW_FORM_ref2 := $12,DW_FORM_ref4 := $13,
  163. DW_FORM_ref8 := $14,DW_FORM_ref_udata := $15,
  164. DW_FORM_indirect := $16);
  165. TDwarfFile = record
  166. Index: integer;
  167. Name: PChar;
  168. end;
  169. { TDebugInfoDwarf }
  170. TDebugInfoDwarf = class(TDebugInfo)
  171. private
  172. currabbrevnumber : longint;
  173. { collect all defs in one list so we can reset them easily }
  174. { not used (MWE)
  175. nextdefnumber : longint;
  176. }
  177. defnumberlist,
  178. deftowritelist : TFPObjectList;
  179. writing_def_dwarf : boolean;
  180. { use this defs to create info for variants and file handles }
  181. { unused (MWE)
  182. filerecdef,
  183. textrecdef : tdef;
  184. }
  185. dirlist: Tdictionary;
  186. filesequence: Integer;
  187. loclist: tdynamicarray;
  188. asmline: TAsmList;
  189. function def_dwarf_lab(def:tdef) : tasmsymbol;
  190. function get_file_index(afile: tinputfile): Integer;
  191. procedure write_symtable_syms(st:tsymtable);
  192. protected
  193. isdwarf64: Boolean;
  194. vardatadef: trecorddef;
  195. procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  196. procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  197. procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  198. procedure append_labelentry_data(attr : tdwarf_attribute;sym : tasmsymbol);
  199. procedure appenddef(def:tdef);
  200. procedure appenddef_ord(def:torddef); virtual;
  201. procedure appenddef_float(def:tfloatdef); virtual;
  202. procedure appenddef_file(def:tfiledef); virtual;
  203. procedure appenddef_enum(def:tenumdef); virtual;
  204. procedure appenddef_array(def:tarraydef); virtual;
  205. procedure appenddef_record(def:trecorddef); virtual;
  206. procedure appenddef_object(def:tobjectdef); virtual; abstract;
  207. procedure appenddef_pointer(def:tpointerdef); virtual;
  208. procedure appenddef_string(def:tstringdef); virtual;
  209. procedure appenddef_procvar(def:tprocvardef); virtual;
  210. procedure appenddef_variant(def:tvariantdef); virtual; abstract;
  211. procedure appenddef_set(def:tsetdef); virtual; abstract;
  212. procedure appenddef_formal(def:tformaldef); virtual;
  213. procedure appenddef_unineddef(def:tundefineddef); virtual; abstract;
  214. procedure appendsym(sym:tsym);
  215. procedure appendsym_var(sym:tabstractnormalvarsym); virtual;
  216. procedure appendsym_fieldvar(sym:tfieldvarsym); virtual;
  217. procedure appendsym_unit(sym:tunitsym); virtual;
  218. procedure appendsym_const(sym:tconstsym); virtual;
  219. procedure appendsym_type(sym:ttypesym); virtual;
  220. procedure appendsym_typedconst(sym:ttypedconstsym); virtual;
  221. procedure appendsym_label(sym:tlabelsym); virtual;
  222. procedure appendsym_absolute(sym:tabsolutevarsym); virtual;
  223. procedure appendsym_property(sym:tpropertysym); virtual;
  224. procedure appendsym_proc(sym:tprocsym); virtual;
  225. procedure appendprocdef(pd:tprocdef); virtual;
  226. procedure enum_membersyms_callback(p:Tnamedindexitem;arg:pointer);
  227. procedure finish_children;
  228. procedure finish_entry;
  229. public
  230. constructor Create;override;
  231. destructor Destroy;override;
  232. procedure insertdef(unused:TAsmList;def:tdef);override;
  233. procedure insertmoduleinfo;override;
  234. procedure inserttypeinfo;override;
  235. procedure referencesections(list:TAsmList);override;
  236. procedure insertlineinfo(list:TAsmList);override;
  237. function dwarf_version: Word; virtual; abstract;
  238. procedure write_symtable_defs(unused:TAsmList;st:tsymtable);override;
  239. end;
  240. { TDebugInfoDwarf2 }
  241. TDebugInfoDwarf2 = class(TDebugInfoDwarf)
  242. private
  243. protected
  244. procedure appenddef_file(def:tfiledef); override;
  245. procedure appenddef_formal(def:tformaldef); override;
  246. procedure appenddef_object(def:tobjectdef); override;
  247. procedure appenddef_set(def:tsetdef); override;
  248. procedure appenddef_unineddef(def:tundefineddef); override;
  249. procedure appenddef_variant(def:tvariantdef); override;
  250. public
  251. function dwarf_version: Word; override;
  252. end;
  253. { TDebugInfoDwarf3 }
  254. TDebugInfoDwarf3 = class(TDebugInfoDwarf)
  255. private
  256. protected
  257. procedure appenddef_file(def:tfiledef); override;
  258. procedure appenddef_formal(def:tformaldef); override;
  259. procedure appenddef_object(def:tobjectdef); override;
  260. procedure appenddef_set(def:tsetdef); override;
  261. procedure appenddef_unineddef(def:tundefineddef); override;
  262. procedure appenddef_variant(def:tvariantdef); override;
  263. public
  264. function dwarf_version: Word; override;
  265. end;
  266. implementation
  267. uses
  268. version,
  269. cutils,
  270. globtype,
  271. globals,
  272. verbose,
  273. systems,
  274. cpubase,
  275. cgbase,
  276. fmodule,
  277. defutil,
  278. symconst,symtable
  279. ;
  280. const
  281. LINE_BASE = 1;
  282. OPCODE_BASE = 13;
  283. const
  284. DW_TAG_lo_user = $4080;
  285. DW_TAG_hi_user = $ffff;
  286. { Flag that tells whether entry has a child or not. }
  287. DW_children_no = 0;
  288. DW_children_yes = 1;
  289. const
  290. { Implementation-defined range start. }
  291. DW_AT_lo_user = $2000;
  292. { Implementation-defined range end. }
  293. DW_AT_hi_user = $3ff0;
  294. type
  295. { Source language names and codes. }
  296. tdwarf_source_language = (DW_LANG_C89 := $0001,DW_LANG_C := $0002,DW_LANG_Ada83 := $0003,
  297. DW_LANG_C_plus_plus := $0004,DW_LANG_Cobol74 := $0005,
  298. DW_LANG_Cobol85 := $0006,DW_LANG_Fortran77 := $0007,
  299. DW_LANG_Fortran90 := $0008,DW_LANG_Pascal83 := $0009,
  300. DW_LANG_Modula2 := $000a,DW_LANG_Java := $000b,
  301. { DWARF 3. }
  302. DW_LANG_C99 := $000c,DW_LANG_Ada95 := $000d,
  303. DW_LANG_Fortran95 := $000e,
  304. { MIPS. }
  305. DW_LANG_Mips_Assembler := $8001,
  306. { UPC. }
  307. DW_LANG_Upc := $8765
  308. );
  309. const
  310. { Implementation-defined range start. }
  311. DW_LANG_lo_user = $8000;
  312. { Implementation-defined range start. }
  313. DW_LANG_hi_user = $ffff;
  314. type
  315. { Names and codes for macro information. }
  316. tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2,
  317. DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4,
  318. DW_MACINFO_vendor_ext := 255);
  319. type
  320. { Type encodings. }
  321. Tdwarf_type = (DW_ATE_void := $0,DW_ATE_address := $1,
  322. DW_ATE_boolean := $2,DW_ATE_complex_float := $3,
  323. DW_ATE_float := $4,DW_ATE_signed := $5,
  324. DW_ATE_signed_char := $6,DW_ATE_unsigned := $7,
  325. DW_ATE_unsigned_char := $8,DW_ATE_imaginary_float := $9,
  326. { HP extensions. }
  327. DW_ATE_HP_float80 := $80,DW_ATE_HP_complex_float80 := $81,
  328. DW_ATE_HP_float128 := $82,DW_ATE_HP_complex_float128 := $83,
  329. DW_ATE_HP_floathpintel := $84,DW_ATE_HP_imaginary_float80 := $85,
  330. DW_ATE_HP_imaginary_float128 := $86
  331. );
  332. const
  333. DW_ATE_lo_user = $80;
  334. DW_ATE_hi_user = $ff;
  335. type
  336. Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1
  337. );
  338. { Access attribute. }
  339. Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2,
  340. DW_ACCESS_private := 3);
  341. { Visibility. }
  342. Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2,
  343. DW_VIS_qualified := 3);
  344. { Virtuality. }
  345. Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1,
  346. DW_VIRTUALITY_pure_virtual := 2);
  347. { Case sensitivity. }
  348. Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1,
  349. DW_ID_down_case := 2,DW_ID_case_insensitive := 3
  350. );
  351. { Calling convention. }
  352. Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2,
  353. DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40
  354. );
  355. { Location atom names and codes. }
  356. Tdwarf_location_atom = (DW_OP_addr := $03,DW_OP_deref := $06,DW_OP_const1u := $08,
  357. DW_OP_const1s := $09,DW_OP_const2u := $0a,
  358. DW_OP_const2s := $0b,DW_OP_const4u := $0c,
  359. DW_OP_const4s := $0d,DW_OP_const8u := $0e,
  360. DW_OP_const8s := $0f,DW_OP_constu := $10,
  361. DW_OP_consts := $11,DW_OP_dup := $12,DW_OP_drop := $13,
  362. DW_OP_over := $14,DW_OP_pick := $15,DW_OP_swap := $16,
  363. DW_OP_rot := $17,DW_OP_xderef := $18,DW_OP_abs := $19,
  364. DW_OP_and := $1a,DW_OP_div := $1b,DW_OP_minus := $1c,
  365. DW_OP_mod := $1d,DW_OP_mul := $1e,DW_OP_neg := $1f,
  366. DW_OP_not := $20,DW_OP_or := $21,DW_OP_plus := $22,
  367. DW_OP_plus_uconst := $23,DW_OP_shl := $24,
  368. DW_OP_shr := $25,DW_OP_shra := $26,DW_OP_xor := $27,
  369. DW_OP_bra := $28,DW_OP_eq := $29,DW_OP_ge := $2a,
  370. DW_OP_gt := $2b,DW_OP_le := $2c,DW_OP_lt := $2d,
  371. DW_OP_ne := $2e,DW_OP_skip := $2f,DW_OP_lit0 := $30,
  372. DW_OP_lit1 := $31,DW_OP_lit2 := $32,DW_OP_lit3 := $33,
  373. DW_OP_lit4 := $34,DW_OP_lit5 := $35,DW_OP_lit6 := $36,
  374. DW_OP_lit7 := $37,DW_OP_lit8 := $38,DW_OP_lit9 := $39,
  375. DW_OP_lit10 := $3a,DW_OP_lit11 := $3b,
  376. DW_OP_lit12 := $3c,DW_OP_lit13 := $3d,
  377. DW_OP_lit14 := $3e,DW_OP_lit15 := $3f,
  378. DW_OP_lit16 := $40,DW_OP_lit17 := $41,
  379. DW_OP_lit18 := $42,DW_OP_lit19 := $43,
  380. DW_OP_lit20 := $44,DW_OP_lit21 := $45,
  381. DW_OP_lit22 := $46,DW_OP_lit23 := $47,
  382. DW_OP_lit24 := $48,DW_OP_lit25 := $49,
  383. DW_OP_lit26 := $4a,DW_OP_lit27 := $4b,
  384. DW_OP_lit28 := $4c,DW_OP_lit29 := $4d,
  385. DW_OP_lit30 := $4e,DW_OP_lit31 := $4f,
  386. DW_OP_reg0 := $50,DW_OP_reg1 := $51,DW_OP_reg2 := $52,
  387. DW_OP_reg3 := $53,DW_OP_reg4 := $54,DW_OP_reg5 := $55,
  388. DW_OP_reg6 := $56,DW_OP_reg7 := $57,DW_OP_reg8 := $58,
  389. DW_OP_reg9 := $59,DW_OP_reg10 := $5a,DW_OP_reg11 := $5b,
  390. DW_OP_reg12 := $5c,DW_OP_reg13 := $5d,
  391. DW_OP_reg14 := $5e,DW_OP_reg15 := $5f,
  392. DW_OP_reg16 := $60,DW_OP_reg17 := $61,
  393. DW_OP_reg18 := $62,DW_OP_reg19 := $63,
  394. DW_OP_reg20 := $64,DW_OP_reg21 := $65,
  395. DW_OP_reg22 := $66,DW_OP_reg23 := $67,
  396. DW_OP_reg24 := $68,DW_OP_reg25 := $69,
  397. DW_OP_reg26 := $6a,DW_OP_reg27 := $6b,
  398. DW_OP_reg28 := $6c,DW_OP_reg29 := $6d,
  399. DW_OP_reg30 := $6e,DW_OP_reg31 := $6f,
  400. DW_OP_breg0 := $70,DW_OP_breg1 := $71,
  401. DW_OP_breg2 := $72,DW_OP_breg3 := $73,
  402. DW_OP_breg4 := $74,DW_OP_breg5 := $75,
  403. DW_OP_breg6 := $76,DW_OP_breg7 := $77,
  404. DW_OP_breg8 := $78,DW_OP_breg9 := $79,
  405. DW_OP_breg10 := $7a,DW_OP_breg11 := $7b,
  406. DW_OP_breg12 := $7c,DW_OP_breg13 := $7d,
  407. DW_OP_breg14 := $7e,DW_OP_breg15 := $7f,
  408. DW_OP_breg16 := $80,DW_OP_breg17 := $81,
  409. DW_OP_breg18 := $82,DW_OP_breg19 := $83,
  410. DW_OP_breg20 := $84,DW_OP_breg21 := $85,
  411. DW_OP_breg22 := $86,DW_OP_breg23 := $87,
  412. DW_OP_breg24 := $88,DW_OP_breg25 := $89,
  413. DW_OP_breg26 := $8a,DW_OP_breg27 := $8b,
  414. DW_OP_breg28 := $8c,DW_OP_breg29 := $8d,
  415. DW_OP_breg30 := $8e,DW_OP_breg31 := $8f,
  416. DW_OP_regx := $90,DW_OP_fbreg := $91,DW_OP_bregx := $92,
  417. DW_OP_piece := $93,DW_OP_deref_size := $94,
  418. DW_OP_xderef_size := $95,DW_OP_nop := $96,
  419. { DWARF 3 extensions. }
  420. DW_OP_push_object_address := $97,DW_OP_call2 := $98,
  421. DW_OP_call4 := $99,DW_OP_call_ref := $9a,
  422. { GNU extensions. }
  423. DW_OP_GNU_push_tls_address := $e0,
  424. { HP extensions. }
  425. DW_OP_HP_unknown := $e0,
  426. DW_OP_HP_is_value := $e1,DW_OP_HP_fltconst4 := $e2,
  427. DW_OP_HP_fltconst8 := $e3,DW_OP_HP_mod_range := $e4,
  428. DW_OP_HP_unmod_range := $e5,DW_OP_HP_tls := $e6
  429. );
  430. const
  431. { Implementation-defined range start. }
  432. DW_OP_lo_user = $e0;
  433. { Implementation-defined range end. }
  434. DW_OP_hi_user = $ff;
  435. const
  436. DW_LNS_extended_op = $00;
  437. { next copied from cfidwarf, need to go to something shared }
  438. DW_LNS_copy = $01;
  439. DW_LNS_advance_pc = $02;
  440. DW_LNS_advance_line = $03;
  441. DW_LNS_set_file = $04;
  442. DW_LNS_set_column = $05;
  443. DW_LNS_negate_stmt = $06;
  444. DW_LNS_set_basic_block = $07;
  445. DW_LNS_const_add_pc = $08;
  446. DW_LNS_fixed_advance_pc = $09;
  447. DW_LNS_set_prologue_end = $0a;
  448. DW_LNS_set_epilogue_begin = $0b;
  449. DW_LNS_set_isa = $0c;
  450. DW_LNE_end_sequence = $01;
  451. DW_LNE_set_address = $02;
  452. DW_LNE_define_file = $03;
  453. DW_LNE_lo_user = $80;
  454. DW_LNE_hi_user = $ff;
  455. type
  456. { TDirIndexItem }
  457. TDirIndexItem = class(TNamedIndexItem)
  458. private
  459. FFiles: TDictionary;
  460. public
  461. constructor Create(const AName: String; AIndex: Integer);
  462. destructor Destroy;override;
  463. property Files: TDictionary read FFiles;
  464. end;
  465. { TFileIndexItem }
  466. TFileIndexItem = class(TNamedIndexItem)
  467. private
  468. FDirIndex: Integer;
  469. public
  470. constructor Create(const AName: String; ADirIndex, AIndex: Integer);
  471. property DirIndex: Integer read FDirIndex;
  472. end;
  473. {****************************************************************************
  474. procs
  475. ****************************************************************************}
  476. procedure AddNamedIndexToList(p:TNamedIndexItem; arg:pointer);
  477. begin
  478. TFPList(Arg).Add(p);
  479. end;
  480. function DirListSortCompare(AItem1, AItem2: Pointer): Integer;
  481. begin
  482. Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr;
  483. end;
  484. function FileListSortCompare(AItem1, AItem2: Pointer): Integer;
  485. begin
  486. Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr;
  487. end;
  488. {****************************************************************************
  489. TDirIndexItem
  490. ****************************************************************************}
  491. constructor TDirIndexItem.Create(const AName: String; AIndex: Integer);
  492. begin
  493. inherited CreateName(AName);
  494. FFiles := TDictionary.Create;
  495. IndexNr := AIndex;
  496. end;
  497. destructor TDirIndexItem.Destroy;
  498. begin
  499. FFiles.Free;
  500. FFiles := nil;
  501. inherited Destroy;
  502. end;
  503. {****************************************************************************
  504. TFileIndexItem
  505. ****************************************************************************}
  506. constructor TFileIndexItem.Create(const AName: String; ADirIndex, AIndex: Integer);
  507. begin
  508. inherited CreateName(Aname);
  509. FDirIndex := ADirIndex;
  510. IndexNr := AIndex;
  511. end;
  512. {****************************************************************************
  513. TDebugInfoDwarf
  514. ****************************************************************************}
  515. function TDebugInfoDwarf.def_dwarf_lab(def:tdef) : tasmsymbol;
  516. begin
  517. { Keep track of used dwarf entries, this info is only usefull for dwarf entries
  518. referenced by the symbols. Definitions will always include all
  519. required stabs }
  520. if def.dbg_state=dbg_state_unused then
  521. def.dbg_state:=dbg_state_used;
  522. { Need a new label? }
  523. if not assigned(def.dwarf_lab) then
  524. begin
  525. if (df_has_dwarf_dbg_info in def.defoptions) then
  526. begin
  527. if not assigned(def.typesym) then
  528. internalerror(200610011);
  529. def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,def.typesym.name));
  530. def.dbg_state:=dbg_state_written;
  531. end
  532. else
  533. begin
  534. { Create an exported DBG symbol if we are generating a def defined in the
  535. globalsymtable of the current unit }
  536. if assigned(def.typesym) and
  537. (def.owner.symtabletype=globalsymtable) and
  538. (def.owner.iscurrentunit) then
  539. begin
  540. def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,def.typesym.name),AB_GLOBAL,AT_DATA);
  541. include(def.defoptions,df_has_dwarf_dbg_info);
  542. end
  543. else
  544. current_asmdata.getdatalabel(TAsmLabel(def.dwarf_lab));
  545. if def.dbg_state=dbg_state_used then
  546. deftowritelist.Add(def);
  547. end;
  548. defnumberlist.Add(def);
  549. end;
  550. result:=def.dwarf_lab;
  551. end;
  552. constructor TDebugInfoDwarf.Create;
  553. begin
  554. inherited Create;
  555. isdwarf64 := target_cpu in [cpu_iA64,cpu_x86_64,cpu_powerpc64];
  556. dirlist := tdictionary.Create;
  557. { add current dir as first item (index=0) }
  558. dirlist.insert(TDirIndexItem.Create('.', 0));
  559. asmline := TAsmList.create;
  560. loclist := tdynamicarray.Create(4096);
  561. end;
  562. destructor TDebugInfoDwarf.Destroy;
  563. begin
  564. dirlist.Free;
  565. dirlist := nil;
  566. loclist.Free;
  567. loclist := nil;
  568. inherited Destroy;
  569. end;
  570. procedure TDebugInfoDwarf.enum_membersyms_callback(p: Tnamedindexitem; arg: pointer);
  571. begin
  572. case tsym(p).typ of
  573. fieldvarsym:
  574. appendsym_fieldvar(tfieldvarsym(p));
  575. propertysym:
  576. appendsym_property(tpropertysym(p));
  577. procsym:
  578. appendsym_proc(tprocsym(p));
  579. end;
  580. end;
  581. function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer;
  582. var
  583. dirname: String;
  584. diritem: TDirIndexItem;
  585. diridx: Integer;
  586. fileitem: TFileIndexItem;
  587. begin
  588. if afile.path^ = '' then
  589. dirname := '.'
  590. else
  591. dirname := afile.path^;
  592. diritem := TDirIndexItem(dirlist.search(dirname));
  593. if diritem = nil then
  594. begin
  595. diritem := TDirIndexItem.Create(dirname, dirlist.Count);
  596. diritem := TDirIndexItem(dirlist.insert(diritem));
  597. end;
  598. diridx := diritem.IndexNr;
  599. fileitem := TFileIndexItem(diritem.files.search(afile.name^));
  600. if fileitem = nil then
  601. begin
  602. Inc(filesequence);
  603. fileitem := TFileIndexItem.Create(afile.name^, diridx, filesequence);
  604. fileitem := TFileIndexItem(diritem.files.insert(fileitem));
  605. end;
  606. Result := fileitem.IndexNr;
  607. end;
  608. { writing the data through a few simply procedures allows to create easily extra information
  609. for debugging of debug info }
  610. procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  611. var
  612. i : longint;
  613. begin
  614. { todo: store defined abbrevs, so you have to define tehm only once (for this unit) (MWE) }
  615. inc(currabbrevnumber);
  616. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber))));
  617. { abbrev number }
  618. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(currabbrevnumber));
  619. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber));
  620. { tag }
  621. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(tag)));
  622. { children? }
  623. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(ord(has_children)));
  624. i:=0;
  625. while i<=high(data) do
  626. begin
  627. { attribute }
  628. if data[i].VType=vtInteger then
  629. begin
  630. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(data[i].VInteger));
  631. end
  632. else
  633. internalerror(200601261);
  634. inc(i);
  635. { form }
  636. if data[i].VType=vtInteger then
  637. begin
  638. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(data[i].VInteger));
  639. end
  640. else
  641. internalerror(200601262);
  642. inc(i);
  643. { info itself }
  644. case tdwarf_form(data[i-1].VInteger) of
  645. DW_FORM_string:
  646. case data[i].VType of
  647. vtChar:
  648. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(data[i].VChar));
  649. vtString:
  650. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(data[i].VString^));
  651. vtAnsistring:
  652. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(Ansistring(data[i].VAnsiString)));
  653. else
  654. internalerror(200601264);
  655. end;
  656. DW_FORM_flag:
  657. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(data[i].VBoolean)));
  658. DW_FORM_data1:
  659. case data[i].VType of
  660. vtInteger:
  661. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VInteger));
  662. vtInt64:
  663. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VInt64^));
  664. vtQWord:
  665. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VQWord^));
  666. else
  667. internalerror(200602143);
  668. end;
  669. DW_FORM_data2:
  670. case data[i].VType of
  671. vtInteger:
  672. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(data[i].VInteger));
  673. vtInt64:
  674. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(data[i].VInt64^));
  675. vtQWord:
  676. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(data[i].VQWord^));
  677. else
  678. internalerror(200602144);
  679. end;
  680. DW_FORM_data4:
  681. case data[i].VType of
  682. vtInteger:
  683. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(data[i].VInteger));
  684. vtInt64:
  685. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(data[i].VInt64^));
  686. vtQWord:
  687. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(data[i].VQWord^));
  688. else
  689. internalerror(200602145);
  690. end;
  691. DW_FORM_data8:
  692. case data[i].VType of
  693. vtInteger:
  694. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(data[i].VInteger));
  695. vtInt64:
  696. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(data[i].VInt64^));
  697. vtQWord:
  698. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(data[i].VQWord^));
  699. else
  700. internalerror(200602146);
  701. end;
  702. DW_FORM_sdata:
  703. case data[i].VType of
  704. vtInteger:
  705. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(data[i].VInteger));
  706. vtInt64:
  707. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(data[i].VInt64^));
  708. vtQWord:
  709. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(data[i].VQWord^));
  710. else
  711. internalerror(200601285);
  712. end;
  713. DW_FORM_udata:
  714. case data[i].VType of
  715. vtInteger:
  716. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(data[i].VInteger));
  717. vtInt64:
  718. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(data[i].VInt64^));
  719. vtQWord:
  720. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(data[i].VQWord^));
  721. else
  722. internalerror(200601284);
  723. end;
  724. { block gets only the size, the rest is appended manually by the caller }
  725. DW_FORM_block1:
  726. case data[i].VType of
  727. vtInteger:
  728. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VInteger));
  729. vtInt64:
  730. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VInt64^));
  731. vtQWord:
  732. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(data[i].VQWord^));
  733. else
  734. internalerror(200602141);
  735. end;
  736. else
  737. internalerror(200601263);
  738. end;
  739. inc(i);
  740. end;
  741. end;
  742. procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  743. begin
  744. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  745. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_addr)));
  746. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym));
  747. end;
  748. procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  749. begin
  750. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  751. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_ref_addr)));
  752. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym));
  753. end;
  754. procedure TDebugInfoDwarf.append_labelentry_data(attr : tdwarf_attribute;sym : tasmsymbol);
  755. begin
  756. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  757. if isdwarf64 then
  758. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)))
  759. else
  760. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  761. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym));
  762. end;
  763. procedure TDebugInfoDwarf.finish_entry;
  764. begin
  765. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  766. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  767. end;
  768. procedure TDebugInfoDwarf.finish_children;
  769. begin
  770. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  771. end;
  772. procedure TDebugInfoDwarf.appenddef_ord(def:torddef);
  773. begin
  774. case def.typ of
  775. s8bit,
  776. s16bit,
  777. s32bit :
  778. begin
  779. { we should generate a subrange type here }
  780. if assigned(def.typesym) then
  781. append_entry(DW_TAG_base_type,false,[
  782. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  783. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  784. DW_AT_byte_size,DW_FORM_data1,def.size
  785. ])
  786. else
  787. append_entry(DW_TAG_base_type,false,[
  788. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  789. DW_AT_byte_size,DW_FORM_data1,def.size
  790. ]);
  791. finish_entry;
  792. end;
  793. u8bit,
  794. u16bit,
  795. u32bit :
  796. begin
  797. { we should generate a subrange type here }
  798. if assigned(def.typesym) then
  799. append_entry(DW_TAG_base_type,false,[
  800. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  801. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  802. DW_AT_byte_size,DW_FORM_data1,def.size
  803. ])
  804. else
  805. append_entry(DW_TAG_base_type,false,[
  806. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  807. DW_AT_byte_size,DW_FORM_data1,def.size
  808. ]);
  809. finish_entry;
  810. end;
  811. uvoid :
  812. begin
  813. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  814. replace it with a unsigned type with size 0 (FK)
  815. }
  816. append_entry(DW_TAG_base_type,false,[
  817. DW_AT_name,DW_FORM_string,'Void'#0,
  818. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  819. DW_AT_byte_size,DW_FORM_data1,0
  820. ]);
  821. finish_entry;
  822. end;
  823. uchar :
  824. begin
  825. append_entry(DW_TAG_base_type,false,[
  826. DW_AT_name,DW_FORM_string,'Char'#0,
  827. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  828. DW_AT_byte_size,DW_FORM_data1,1
  829. ]);
  830. finish_entry;
  831. end;
  832. uwidechar :
  833. begin
  834. append_entry(DW_TAG_base_type,false,[
  835. DW_AT_name,DW_FORM_string,'WideChar'#0,
  836. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  837. DW_AT_byte_size,DW_FORM_data1,2
  838. ]);
  839. finish_entry;
  840. end;
  841. bool8bit :
  842. begin
  843. append_entry(DW_TAG_base_type,false,[
  844. DW_AT_name,DW_FORM_string,'Boolean'#0,
  845. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  846. DW_AT_byte_size,DW_FORM_data1,1
  847. ]);
  848. finish_entry;
  849. end;
  850. bool16bit :
  851. begin
  852. append_entry(DW_TAG_base_type,false,[
  853. DW_AT_name,DW_FORM_string,'WordBool'#0,
  854. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  855. DW_AT_byte_size,DW_FORM_data1,2
  856. ]);
  857. finish_entry;
  858. end;
  859. bool32bit :
  860. begin
  861. append_entry(DW_TAG_base_type,false,[
  862. DW_AT_name,DW_FORM_string,'LongBool'#0,
  863. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  864. DW_AT_byte_size,DW_FORM_data1,4
  865. ]);
  866. finish_entry;
  867. end;
  868. bool64bit :
  869. begin
  870. append_entry(DW_TAG_base_type,false,[
  871. DW_AT_name,DW_FORM_string,'QWordBool'#0,
  872. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  873. DW_AT_byte_size,DW_FORM_data1,8
  874. ]);
  875. finish_entry;
  876. end;
  877. u64bit :
  878. begin
  879. append_entry(DW_TAG_base_type,false,[
  880. DW_AT_name,DW_FORM_string,'QWord'#0,
  881. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  882. DW_AT_byte_size,DW_FORM_data1,8
  883. ]);
  884. finish_entry;
  885. end;
  886. scurrency :
  887. begin
  888. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  889. append_entry(DW_TAG_base_type,false,[
  890. DW_AT_name,DW_FORM_string,'Currency'#0,
  891. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  892. DW_AT_byte_size,DW_FORM_data1,8
  893. ]);
  894. finish_entry;
  895. end;
  896. s64bit :
  897. begin
  898. append_entry(DW_TAG_base_type,false,[
  899. DW_AT_name,DW_FORM_string,'Int64'#0,
  900. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  901. DW_AT_byte_size,DW_FORM_data1,8
  902. ]);
  903. finish_entry;
  904. end;
  905. else
  906. internalerror(200601287);
  907. end;
  908. end;
  909. procedure TDebugInfoDwarf.appenddef_float(def:tfloatdef);
  910. begin
  911. case def.typ of
  912. s32real,
  913. s64real,
  914. s80real:
  915. if assigned(def.typesym) then
  916. append_entry(DW_TAG_base_type,false,[
  917. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  918. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  919. DW_AT_byte_size,DW_FORM_data1,def.size
  920. ])
  921. else
  922. append_entry(DW_TAG_base_type,false,[
  923. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  924. DW_AT_byte_size,DW_FORM_data1,def.size
  925. ]);
  926. s64currency:
  927. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  928. if assigned(def.typesym) then
  929. append_entry(DW_TAG_base_type,false,[
  930. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  931. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  932. DW_AT_byte_size,DW_FORM_data1,8
  933. ])
  934. else
  935. append_entry(DW_TAG_base_type,false,[
  936. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  937. DW_AT_byte_size,DW_FORM_data1,8
  938. ]);
  939. s64comp:
  940. if assigned(def.typesym) then
  941. append_entry(DW_TAG_base_type,false,[
  942. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  943. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  944. DW_AT_byte_size,DW_FORM_data1,8
  945. ])
  946. else
  947. append_entry(DW_TAG_base_type,false,[
  948. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  949. DW_AT_byte_size,DW_FORM_data1,8
  950. ]);
  951. else
  952. internalerror(200601289);
  953. end;
  954. finish_entry;
  955. end;
  956. procedure TDebugInfoDwarf.appenddef_formal(def: tformaldef);
  957. begin
  958. { implemented in derived classes }
  959. end;
  960. procedure TDebugInfoDwarf.appenddef_enum(def:tenumdef);
  961. var
  962. hp : tenumsym;
  963. begin
  964. if assigned(def.typesym) then
  965. append_entry(DW_TAG_enumeration_type,true,[
  966. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  967. DW_AT_byte_size,DW_FORM_data1,def.size
  968. ])
  969. else
  970. append_entry(DW_TAG_enumeration_type,true,[
  971. DW_AT_byte_size,DW_FORM_data1,def.size
  972. ]);
  973. if assigned(def.basedef) then
  974. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef));
  975. finish_entry;
  976. { write enum symbols }
  977. hp:=tenumsym(def.firstenum);
  978. while assigned(hp) do
  979. begin
  980. append_entry(DW_TAG_enumerator,false,[
  981. DW_AT_name,DW_FORM_string,hp.name+#0,
  982. DW_AT_const_value,DW_FORM_data4,hp.value
  983. ]);
  984. finish_entry;
  985. hp:=tenumsym(hp).nextenum;
  986. end;
  987. finish_children;
  988. end;
  989. procedure TDebugInfoDwarf.appenddef_file(def: tfiledef);
  990. begin
  991. { implemented in derived classes }
  992. end;
  993. procedure TDebugInfoDwarf.appenddef_array(def:tarraydef);
  994. var
  995. size : aint;
  996. elesize : aint;
  997. begin
  998. if is_special_array(def) then
  999. size:=def.elesize
  1000. else
  1001. size:=def.size;
  1002. if not is_packed_array(def) then
  1003. elesize := def.elesize*8
  1004. else
  1005. elesize := def.elepackedbitsize;
  1006. if assigned(def.typesym) then
  1007. append_entry(DW_TAG_array_type,true,[
  1008. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  1009. DW_AT_byte_size,DW_FORM_udata,size,
  1010. DW_AT_stride_size,DW_FORM_udata,elesize
  1011. ])
  1012. else
  1013. append_entry(DW_TAG_array_type,true,[
  1014. DW_AT_byte_size,DW_FORM_udata,size,
  1015. DW_AT_stride_size,DW_FORM_udata,elesize
  1016. ]);
  1017. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementtype.def));
  1018. if is_dynamic_array(def) then
  1019. begin
  1020. { !!! FIXME !!! }
  1021. { gdb's dwarf implementation sucks, so we can't use DW_OP_push_object here (FK)
  1022. { insert location attribute manually }
  1023. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(DW_AT_data_location));
  1024. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(DW_FORM_block1));
  1025. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(1));
  1026. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(DW_OP_push_object));
  1027. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(DW_OP_deref));
  1028. }
  1029. finish_entry;
  1030. { to simplify things, we don't write a multidimensional array here }
  1031. append_entry(DW_TAG_subrange_type,false,[
  1032. DW_AT_lower_bound,DW_FORM_udata,0,
  1033. DW_AT_upper_bound,DW_FORM_udata,0
  1034. ]);
  1035. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangetype.def));
  1036. finish_entry;
  1037. end
  1038. else
  1039. begin
  1040. finish_entry;
  1041. { to simplify things, we don't write a multidimensional array here }
  1042. append_entry(DW_TAG_subrange_type,false,[
  1043. DW_AT_lower_bound,DW_FORM_sdata,def.lowrange,
  1044. DW_AT_upper_bound,DW_FORM_sdata,def.highrange
  1045. ]);
  1046. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangetype.def));
  1047. finish_entry;
  1048. end;
  1049. finish_children;
  1050. end;
  1051. procedure TDebugInfoDwarf.appenddef_record(def:trecorddef);
  1052. begin
  1053. if assigned(def.typesym) then
  1054. append_entry(DW_TAG_structure_type,true,[
  1055. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  1056. DW_AT_byte_size,DW_FORM_udata,def.size
  1057. ])
  1058. else
  1059. append_entry(DW_TAG_structure_type,true,[
  1060. DW_AT_byte_size,DW_FORM_udata,def.size
  1061. ]);
  1062. finish_entry;
  1063. def.symtable.foreach(@enum_membersyms_callback,nil);
  1064. finish_children;
  1065. end;
  1066. procedure TDebugInfoDwarf.appenddef_pointer(def:tpointerdef);
  1067. begin
  1068. append_entry(DW_TAG_pointer_type,false,[]);
  1069. if not(is_voidpointer(def)) then
  1070. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointertype.def));
  1071. finish_entry;
  1072. end;
  1073. procedure TDebugInfoDwarf.appenddef_string(def:tstringdef);
  1074. var
  1075. slen : aint;
  1076. arr : tasmlabel;
  1077. begin
  1078. case def.string_typ of
  1079. st_shortstring:
  1080. begin
  1081. { fix length of openshortstring }
  1082. slen:=def.len;
  1083. if slen=0 then
  1084. slen:=255;
  1085. { create a structure with two elements }
  1086. current_asmdata.getdatalabel(arr);
  1087. append_entry(DW_TAG_structure_type,true,[
  1088. DW_AT_name,DW_FORM_string,'ShortString'#0,
  1089. DW_AT_byte_size,DW_FORM_data1,2*sizeof(aint)
  1090. ]);
  1091. finish_entry;
  1092. { length entry }
  1093. append_entry(DW_TAG_member,false,[
  1094. DW_AT_name,DW_FORM_string,'Length'#0,
  1095. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1096. ]);
  1097. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1098. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  1099. append_labelentry_ref(DW_AT_type,def_dwarf_lab(u8inttype.def));
  1100. finish_entry;
  1101. { string data entry }
  1102. append_entry(DW_TAG_member,false,[
  1103. DW_AT_name,DW_FORM_string,'Data'#0,
  1104. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1)
  1105. ]);
  1106. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1107. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(1));
  1108. append_labelentry_ref(DW_AT_type,arr);
  1109. finish_entry;
  1110. finish_children;
  1111. { now the data array }
  1112. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
  1113. append_entry(DW_TAG_array_type,true,[
  1114. DW_AT_byte_size,DW_FORM_udata,def.size,
  1115. DW_AT_stride_size,DW_FORM_udata,1*8
  1116. ]);
  1117. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype.def));
  1118. finish_entry;
  1119. append_entry(DW_TAG_subrange_type,false,[
  1120. DW_AT_lower_bound,DW_FORM_udata,0,
  1121. DW_AT_upper_bound,DW_FORM_udata,slen
  1122. ]);
  1123. append_labelentry_ref(DW_AT_type,def_dwarf_lab(u8inttype.def));
  1124. finish_entry;
  1125. finish_children;
  1126. end;
  1127. st_longstring:
  1128. begin
  1129. {
  1130. charst:=def_stab_number(cchartype.def);
  1131. bytest:=def_stab_number(u8inttype.def);
  1132. longst:=def_stab_number(u32inttype.def);
  1133. result:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
  1134. [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
  1135. }
  1136. end;
  1137. st_ansistring:
  1138. begin
  1139. { looks like a pchar }
  1140. append_entry(DW_TAG_pointer_type,false,[]);
  1141. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype.def));
  1142. finish_entry;
  1143. end;
  1144. st_widestring:
  1145. begin
  1146. { looks like a pwidechar }
  1147. append_entry(DW_TAG_pointer_type,false,[]);
  1148. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype.def));
  1149. finish_entry;
  1150. end;
  1151. end;
  1152. end;
  1153. procedure TDebugInfoDwarf.appenddef_procvar(def:tprocvardef);
  1154. procedure doappend;
  1155. var
  1156. i : longint;
  1157. begin
  1158. if assigned(def.typesym) then
  1159. append_entry(DW_TAG_subroutine_type,true,[
  1160. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  1161. DW_AT_prototyped,DW_FORM_flag,true
  1162. ])
  1163. else
  1164. append_entry(DW_TAG_subroutine_type,true,[
  1165. DW_AT_prototyped,DW_FORM_flag,true
  1166. ]);
  1167. if not(is_void(tprocvardef(def).rettype.def)) then
  1168. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).rettype.def));
  1169. finish_entry;
  1170. { write parameters }
  1171. for i:=0 to def.paras.count-1 do
  1172. begin
  1173. append_entry(DW_TAG_formal_parameter,false,[
  1174. DW_AT_name,DW_FORM_string,tparavarsym(def.paras[i]).name+#0
  1175. ]);
  1176. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vartype.def));
  1177. finish_entry;
  1178. end;
  1179. finish_children;
  1180. end;
  1181. var
  1182. proc : tasmlabel;
  1183. begin
  1184. if def.is_methodpointer then
  1185. begin
  1186. { create a structure with two elements }
  1187. current_asmdata.getdatalabel(proc);
  1188. append_entry(DW_TAG_structure_type,true,[
  1189. DW_AT_byte_size,DW_FORM_data1,2*sizeof(aint)
  1190. ]);
  1191. finish_entry;
  1192. { proc entry }
  1193. append_entry(DW_TAG_member,false,[
  1194. DW_AT_name,DW_FORM_string,'Proc'#0,
  1195. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1196. ]);
  1197. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1198. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  1199. append_labelentry_ref(DW_AT_type,proc);
  1200. finish_entry;
  1201. { self entry }
  1202. append_entry(DW_TAG_member,false,[
  1203. DW_AT_name,DW_FORM_string,'Self'#0,
  1204. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(aint))
  1205. ]);
  1206. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1207. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sizeof(aint)));
  1208. append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject));
  1209. finish_entry;
  1210. finish_children;
  1211. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
  1212. doappend;
  1213. end
  1214. else
  1215. doappend;
  1216. end;
  1217. procedure TDebugInfoDwarf.appenddef(def:tdef);
  1218. var
  1219. labsym : tasmsymbol;
  1220. begin
  1221. if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
  1222. exit;
  1223. { never write generic template defs }
  1224. if df_generic in def.defoptions then
  1225. begin
  1226. def.dbg_state:=dbg_state_written;
  1227. exit;
  1228. end;
  1229. { to avoid infinite loops }
  1230. def.dbg_state := dbg_state_writing;
  1231. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
  1232. labsym:=def_dwarf_lab(def);
  1233. if df_has_dwarf_dbg_info in def.defoptions then
  1234. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
  1235. else
  1236. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1237. case def.deftype of
  1238. stringdef :
  1239. appenddef_string(tstringdef(def));
  1240. enumdef :
  1241. appenddef_enum(tenumdef(def));
  1242. orddef :
  1243. appenddef_ord(torddef(def));
  1244. pointerdef :
  1245. appenddef_pointer(tpointerdef(def));
  1246. floatdef :
  1247. appenddef_float(tfloatdef(def));
  1248. filedef :
  1249. appenddef_file(tfiledef(def));
  1250. recorddef :
  1251. appenddef_record(trecorddef(def));
  1252. variantdef :
  1253. appenddef_variant(tvariantdef(def));
  1254. classrefdef :
  1255. appenddef_pointer(tpointerdef(pvmttype.def));
  1256. setdef :
  1257. appenddef_set(tsetdef(def));
  1258. formaldef :
  1259. appenddef_formal(tformaldef(def));
  1260. arraydef :
  1261. appenddef_array(tarraydef(def));
  1262. procvardef :
  1263. appenddef_procvar(tprocvardef(def));
  1264. objectdef :
  1265. appenddef_object(tobjectdef(def));
  1266. undefineddef :
  1267. appenddef_unineddef(tundefineddef(def));
  1268. else
  1269. internalerror(200601281);
  1270. end;
  1271. def.dbg_state := dbg_state_written;
  1272. end;
  1273. procedure TDebugInfoDwarf.insertdef(unused:TAsmList; def:tdef);
  1274. begin
  1275. appenddef(def);
  1276. end;
  1277. procedure TDebugInfoDwarf.write_symtable_defs(unused:TAsmList;st:tsymtable);
  1278. procedure dowritedwarf(st:tsymtable);
  1279. var
  1280. p : tdef;
  1281. begin
  1282. p:=tdef(st.defindex.first);
  1283. while assigned(p) do
  1284. begin
  1285. if (p.dbg_state=dbg_state_used) then
  1286. appenddef(p);
  1287. p:=tdef(p.indexnext);
  1288. end;
  1289. end;
  1290. var
  1291. old_writing_def_dwarf : boolean;
  1292. begin
  1293. case st.symtabletype of
  1294. staticsymtable :
  1295. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Defs - Begin Staticsymtable')));
  1296. globalsymtable :
  1297. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
  1298. end;
  1299. old_writing_def_dwarf:=writing_def_dwarf;
  1300. writing_def_dwarf:=true;
  1301. dowritedwarf(st);
  1302. writing_def_dwarf:=old_writing_def_dwarf;
  1303. case st.symtabletype of
  1304. staticsymtable :
  1305. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Defs - End Staticsymtable')));
  1306. globalsymtable :
  1307. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Defs - End unit '+st.name^+' has index '+tostr(st.moduleid))));
  1308. end;
  1309. end;
  1310. procedure TDebugInfoDwarf.appendprocdef(pd:tprocdef);
  1311. var
  1312. procendlabel : tasmlabel;
  1313. mangled_length : longint;
  1314. p : pchar;
  1315. hs : string;
  1316. begin
  1317. if assigned(pd.procstarttai) then
  1318. begin
  1319. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+pd.fullprocname(true))));
  1320. append_entry(DW_TAG_subprogram,true,
  1321. [DW_AT_name,DW_FORM_string,pd.procsym.name+#0
  1322. { data continues below }
  1323. { problem: base reg isn't known here
  1324. DW_AT_frame_base,DW_FORM_block1,1
  1325. }
  1326. ]);
  1327. { append block data }
  1328. { current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(dwarf_reg(pd.))); }
  1329. if not(is_void(tprocdef(pd).rettype.def)) then
  1330. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(pd).rettype.def));
  1331. { mark end of procedure }
  1332. current_asmdata.getlabel(procendlabel,alt_dbgtype);
  1333. current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),pd.procendtai);
  1334. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(pd.mangledname));
  1335. append_labelentry(DW_AT_high_pc,procendlabel);
  1336. {
  1337. if assigned(pd.funcretsym) and
  1338. (tabstractnormalvarsym(pd.funcretsym).refs>0) then
  1339. begin
  1340. if tabstractnormalvarsym(pd.funcretsym).localloc.loc=LOC_REFERENCE then
  1341. begin
  1342. {$warning Need to add gdb support for ret in param register calling}
  1343. if paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
  1344. hs:='X*'
  1345. else
  1346. hs:='X';
  1347. templist.concat(Tai_stab.create(stab_stabs,strpnew(
  1348. '"'+pd.procsym.name+':'+hs+def_stab_number(pd.rettype.def)+'",'+
  1349. tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
  1350. if (m_result in aktmodeswitches) then
  1351. templist.concat(Tai_stab.create(stab_stabs,strpnew(
  1352. '"RESULT:'+hs+def_stab_number(pd.rettype.def)+'",'+
  1353. tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
  1354. end;
  1355. end;
  1356. }
  1357. finish_entry;
  1358. {
  1359. { para types }
  1360. write_def_stabstr(templist,pd);
  1361. }
  1362. if assigned(pd.parast) then
  1363. write_symtable_syms(pd.parast);
  1364. { local type defs and vars should not be written
  1365. inside the main proc stab }
  1366. if assigned(pd.localst) and
  1367. (pd.localst.symtabletype=localsymtable) then
  1368. write_symtable_syms(pd.localst);
  1369. { last write the types from this procdef }
  1370. if assigned(pd.parast) then
  1371. write_symtable_defs(nil,pd.parast);
  1372. if assigned(pd.localst) and
  1373. (pd.localst.symtabletype=localsymtable) then
  1374. write_symtable_defs(nil,pd.localst);
  1375. finish_children;
  1376. end;
  1377. end;
  1378. procedure TDebugInfoDwarf.appendsym_var(sym:tabstractnormalvarsym);
  1379. var
  1380. templist : TAsmList;
  1381. blocksize : longint;
  1382. tag : tdwarf_tag;
  1383. dreg : byte;
  1384. begin
  1385. { external symbols can't be resolved at link time, so we
  1386. can't generate stabs for them
  1387. not sure if this applies to dwarf as well (FK)
  1388. }
  1389. if vo_is_external in sym.varoptions then
  1390. exit;
  1391. { There is no space allocated for not referenced locals }
  1392. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  1393. exit;
  1394. templist:=TAsmList.create;
  1395. case sym.localloc.loc of
  1396. LOC_REGISTER,
  1397. LOC_CREGISTER,
  1398. LOC_MMREGISTER,
  1399. LOC_CMMREGISTER,
  1400. LOC_FPUREGISTER,
  1401. LOC_CFPUREGISTER :
  1402. begin
  1403. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1404. dreg:=dwarf_reg(sym.localloc.register);
  1405. templist.concat(tai_const.create_uleb128bit(dreg));
  1406. blocksize:=1+Lengthuleb128(dreg);
  1407. end;
  1408. else
  1409. begin
  1410. case sym.typ of
  1411. globalvarsym:
  1412. begin
  1413. if (vo_is_thread_var in sym.varoptions) then
  1414. begin
  1415. {$warning !!! FIXME: dwarf for thread vars !!!}
  1416. blocksize:=0;
  1417. end
  1418. else
  1419. begin
  1420. templist.concat(tai_const.create_8bit(3));
  1421. templist.concat(tai_const.createname(sym.mangledname,0));
  1422. blocksize:=1+sizeof(aword);
  1423. end;
  1424. end;
  1425. paravarsym,
  1426. localvarsym:
  1427. begin
  1428. dreg:=dwarf_reg(sym.localloc.reference.base);
  1429. templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  1430. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset));
  1431. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
  1432. end
  1433. else
  1434. internalerror(200601288);
  1435. end;
  1436. end;
  1437. end;
  1438. if sym.typ=paravarsym then
  1439. tag:=DW_TAG_formal_parameter
  1440. else
  1441. tag:=DW_TAG_variable;
  1442. append_entry(tag,false,[
  1443. DW_AT_name,DW_FORM_string,sym.name+#0,
  1444. {
  1445. DW_AT_decl_file,DW_FORM_data1,0,
  1446. DW_AT_decl_line,DW_FORM_data1,
  1447. }
  1448. DW_AT_external,DW_FORM_flag,true,
  1449. { data continues below }
  1450. DW_AT_location,DW_FORM_block1,blocksize
  1451. ]);
  1452. { append block data }
  1453. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1454. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vartype.def));
  1455. templist.free;
  1456. finish_entry;
  1457. end;
  1458. procedure TDebugInfoDwarf.appendsym_fieldvar(sym: tfieldvarsym);
  1459. begin
  1460. if sp_static in sym.symoptions then Exit;
  1461. append_entry(DW_TAG_member,false,[
  1462. DW_AT_name,DW_FORM_string,sym.name+#0,
  1463. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sym.fieldoffset)
  1464. ]);
  1465. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1466. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.fieldoffset));
  1467. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vartype.def));
  1468. finish_entry;
  1469. end;
  1470. procedure TDebugInfoDwarf.appendsym_const(sym:tconstsym);
  1471. begin
  1472. append_entry(DW_TAG_constant,false,[
  1473. DW_AT_name,DW_FORM_string,sym.name+#0
  1474. ]);
  1475. { for string constants, consttype isn't set because they have no real type }
  1476. if not(sym.consttyp in [conststring,constresourcestring]) then
  1477. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.consttype.def));
  1478. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_AT_const_value)));
  1479. case sym.consttyp of
  1480. conststring:
  1481. begin
  1482. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  1483. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(strpas(pchar(sym.value.valueptr))));
  1484. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1485. end;
  1486. constset,
  1487. constwstring,
  1488. constguid,
  1489. constresourcestring:
  1490. begin
  1491. { write dummy for now }
  1492. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  1493. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
  1494. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1495. end;
  1496. constord:
  1497. begin
  1498. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_sdata)));
  1499. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord));
  1500. end;
  1501. constnil:
  1502. begin
  1503. if isdwarf64 then
  1504. begin
  1505. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  1506. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(0));
  1507. end
  1508. else
  1509. begin
  1510. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  1511. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(0));
  1512. end;
  1513. end;
  1514. constpointer:
  1515. begin
  1516. if isdwarf64 then
  1517. begin
  1518. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  1519. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(sym.value.valueordptr));
  1520. end
  1521. else
  1522. begin
  1523. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  1524. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(sym.value.valueordptr));
  1525. end;
  1526. end;
  1527. constreal:
  1528. begin
  1529. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_block1)));
  1530. case tfloatdef(sym.consttype.def).typ of
  1531. s32real:
  1532. begin
  1533. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
  1534. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(psingle(sym.value.valueptr)^));
  1535. end;
  1536. s64comp,
  1537. s64currency,
  1538. s64real:
  1539. begin
  1540. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  1541. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
  1542. end;
  1543. s80real:
  1544. begin
  1545. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
  1546. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
  1547. end;
  1548. else
  1549. internalerror(200601291);
  1550. end;
  1551. end;
  1552. else
  1553. internalerror(200601292);
  1554. end;
  1555. finish_entry;
  1556. end;
  1557. procedure TDebugInfoDwarf.appendsym_typedconst(sym: ttypedconstsym);
  1558. begin
  1559. append_entry(DW_TAG_variable,false,[
  1560. DW_AT_name,DW_FORM_string,sym.name+#0,
  1561. {
  1562. DW_AT_decl_file,DW_FORM_data1,0,
  1563. DW_AT_decl_line,DW_FORM_data1,
  1564. }
  1565. DW_AT_external,DW_FORM_flag,true,
  1566. { data continues below }
  1567. DW_AT_location,DW_FORM_block1,1+sizeof(aword)
  1568. ]);
  1569. { append block data }
  1570. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(3));
  1571. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.createname(sym.mangledname,0));
  1572. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.typedconsttype.def));
  1573. finish_entry;
  1574. end;
  1575. procedure TDebugInfoDwarf.appendsym_label(sym: tlabelsym);
  1576. begin
  1577. { ignore label syms for now, the problem is that a label sym
  1578. can have more than one label associated e.g. in case of
  1579. an inline procedure expansion }
  1580. end;
  1581. procedure TDebugInfoDwarf.appendsym_proc(sym:tprocsym);
  1582. var
  1583. i : longint;
  1584. begin
  1585. for i:=1 to sym.procdef_count do
  1586. appendprocdef(sym.procdef[i]);
  1587. end;
  1588. procedure TDebugInfoDwarf.appendsym_property(sym: tpropertysym);
  1589. begin
  1590. { ignored for now }
  1591. end;
  1592. procedure TDebugInfoDwarf.appendsym_type(sym: ttypesym);
  1593. begin
  1594. append_entry(DW_TAG_typedef,false,[
  1595. DW_AT_name,DW_FORM_string,sym.name+#0
  1596. ]);
  1597. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.restype.def));
  1598. finish_entry;
  1599. { Moved fom append sym, do we need this (MWE)
  1600. { For object types write also the symtable entries }
  1601. if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then
  1602. write_symtable_syms(list,tobjectdef(ttypesym(sym).restype.def).symtable);
  1603. }
  1604. end;
  1605. procedure TDebugInfoDwarf.appendsym_unit(sym: tunitsym);
  1606. begin
  1607. { for now, we ignore unit symbols }
  1608. end;
  1609. procedure TDebugInfoDwarf.appendsym_absolute(sym:tabsolutevarsym);
  1610. var
  1611. templist : TAsmList;
  1612. blocksize : longint;
  1613. symlist : psymlistitem;
  1614. begin
  1615. templist:=TAsmList.create;
  1616. case tabsolutevarsym(sym).abstyp of
  1617. toaddr :
  1618. begin
  1619. { MWE: replaced ifdef i368 }
  1620. {
  1621. if target_cpu = cpu_i386 then
  1622. begin
  1623. { in theory, we could write a DW_AT_segment entry here for sym.absseg,
  1624. however I doubt that gdb supports this (FK) }
  1625. end;
  1626. }
  1627. templist.concat(tai_const.create_8bit(3));
  1628. templist.concat(tai_const.create_aint(sym.addroffset));
  1629. blocksize:=1+sizeof(aword);
  1630. end;
  1631. toasm :
  1632. begin
  1633. templist.concat(tai_const.create_8bit(3));
  1634. templist.concat(tai_const.createname(sym.mangledname,0));
  1635. blocksize:=1+sizeof(aword);
  1636. end;
  1637. tovar:
  1638. begin
  1639. symlist:=tabsolutevarsym(sym).ref.firstsym;
  1640. { can we insert the symbol? }
  1641. if assigned(symlist) and
  1642. (symlist^.sltype=sl_load) then
  1643. appendsym(symlist^.sym);
  1644. templist.free;
  1645. exit;
  1646. end;
  1647. end;
  1648. append_entry(DW_TAG_variable,false,[
  1649. DW_AT_name,DW_FORM_string,sym.name+#0,
  1650. {
  1651. DW_AT_decl_file,DW_FORM_data1,0,
  1652. DW_AT_decl_line,DW_FORM_data1,
  1653. }
  1654. DW_AT_external,DW_FORM_flag,true,
  1655. { data continues below }
  1656. DW_AT_location,DW_FORM_block1,blocksize
  1657. ]);
  1658. { append block data }
  1659. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1660. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vartype.def));
  1661. templist.free;
  1662. finish_entry;
  1663. end;
  1664. procedure TDebugInfoDwarf.appendsym(sym:tsym);
  1665. begin
  1666. if sym.isdbgwritten then
  1667. exit;
  1668. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+sym.name)));
  1669. case sym.typ of
  1670. globalvarsym :
  1671. appendsym_var(tglobalvarsym(sym));
  1672. unitsym:
  1673. appendsym_unit(tunitsym(sym));
  1674. procsym :
  1675. appendsym_proc(tprocsym(sym));
  1676. labelsym :
  1677. appendsym_label(tlabelsym(sym));
  1678. localvarsym :
  1679. appendsym_var(tlocalvarsym(sym));
  1680. paravarsym :
  1681. appendsym_var(tparavarsym(sym));
  1682. typedconstsym :
  1683. appendsym_typedconst(ttypedconstsym(sym));
  1684. constsym :
  1685. appendsym_const(tconstsym(sym));
  1686. typesym :
  1687. appendsym_type(ttypesym(sym));
  1688. enumsym :
  1689. { ignore enum syms, they are written by the owner }
  1690. ;
  1691. rttisym :
  1692. { ignore rtti syms, they are only of internal use }
  1693. ;
  1694. syssym :
  1695. { ignore sys syms, they are only of internal use }
  1696. ;
  1697. absolutevarsym :
  1698. appendsym_absolute(tabsolutevarsym(sym));
  1699. propertysym :
  1700. appendsym_property(tpropertysym(sym));
  1701. else
  1702. begin
  1703. writeln(ord(sym.typ));
  1704. internalerror(200601242);
  1705. end;
  1706. end;
  1707. sym.isdbgwritten:=true;
  1708. end;
  1709. procedure TDebugInfoDwarf.write_symtable_syms(st:tsymtable);
  1710. var
  1711. p : tsym;
  1712. old_writing_def_dwarf : boolean;
  1713. begin
  1714. old_writing_def_dwarf:=writing_def_dwarf;
  1715. writing_def_dwarf:=false;
  1716. p:=tsym(st.symindex.first);
  1717. while assigned(p) do
  1718. begin
  1719. if (not p.isdbgwritten) then
  1720. appendsym(p);
  1721. p:=tsym(p.indexnext);
  1722. end;
  1723. writing_def_dwarf:=old_writing_def_dwarf;
  1724. end;
  1725. procedure TDebugInfoDwarf.insertmoduleinfo;
  1726. var
  1727. templist: TAsmList;
  1728. linelist: TAsmList;
  1729. lbl: tasmlabel;
  1730. n: Integer;
  1731. ditem: TDirIndexItem;
  1732. fitem: TFileIndexItem;
  1733. dlist, flist: TFPList;
  1734. begin
  1735. { insert .Ltext0 label }
  1736. templist:=TAsmList.create;
  1737. new_section(templist,sec_code,'',0);
  1738. templist.concat(tai_symbol.createname('.Ltext0',AT_DATA,0));
  1739. current_asmdata.asmlists[al_start].insertlist(templist);
  1740. templist.free;
  1741. { insert .Letext0 label }
  1742. templist:=TAsmList.create;
  1743. new_section(templist,sec_code,'',0);
  1744. templist.concat(tai_symbol.createname('.Letext0',AT_DATA,0));
  1745. current_asmdata.asmlists[al_end].insertlist(templist);
  1746. templist.free;
  1747. { insert .Ldebug_abbrev0 label }
  1748. templist:=TAsmList.create;
  1749. new_section(templist,sec_debug_abbrev,'',0);
  1750. templist.concat(tai_symbol.createname('.Ldebug_abbrev0',AT_DATA,0));
  1751. current_asmdata.asmlists[al_start].insertlist(templist);
  1752. templist.free;
  1753. { insert .Ldebug_line0 label }
  1754. templist:=TAsmList.create;
  1755. new_section(templist,sec_debug_line,'',0);
  1756. templist.concat(tai_symbol.createname('.Ldebug_line0',AT_DATA,0));
  1757. current_asmdata.asmlists[al_start].insertlist(templist);
  1758. templist.free;
  1759. { debug line header }
  1760. linelist := current_asmdata.asmlists[al_dwarf_line];
  1761. new_section(linelist,sec_debug_line,'',0);
  1762. linelist.concat(tai_comment.Create(strpnew('=== header start ===')));
  1763. { size }
  1764. current_asmdata.getlabel(lbl,alt_dbgfile);
  1765. { currently we create only 32 bit dwarf }
  1766. linelist.concat(tai_const.create_rel_sym(aitconst_32bit,
  1767. lbl,tasmsymbol.create('.Ledebug_line0',AB_COMMON,AT_DATA)));
  1768. linelist.concat(tai_label.create(lbl));
  1769. { version }
  1770. linelist.concat(tai_const.create_16bit(dwarf_version));
  1771. { header length }
  1772. current_asmdata.getlabel(lbl,alt_dbgfile);
  1773. { currently we create only 32 bit dwarf }
  1774. linelist.concat(tai_const.create_rel_sym(aitconst_32bit,
  1775. lbl,tasmsymbol.create('.Lehdebug_line0',AB_COMMON,AT_DATA)));
  1776. linelist.concat(tai_label.create(lbl));
  1777. { minimum_instruction_length }
  1778. linelist.concat(tai_const.create_8bit(1));
  1779. { default_is_stmt }
  1780. linelist.concat(tai_const.create_8bit(1));
  1781. { line_base }
  1782. linelist.concat(tai_const.create_8bit(LINE_BASE));
  1783. { line_range }
  1784. { only line increase, no adress }
  1785. linelist.concat(tai_const.create_8bit(255));
  1786. { opcode_base }
  1787. linelist.concat(tai_const.create_8bit(OPCODE_BASE));
  1788. { standard_opcode_lengths }
  1789. { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) }
  1790. { DW_LNS_copy }
  1791. linelist.concat(tai_const.create_8bit(0));
  1792. { DW_LNS_advance_pc }
  1793. linelist.concat(tai_const.create_8bit(1));
  1794. { DW_LNS_advance_line }
  1795. linelist.concat(tai_const.create_8bit(1));
  1796. { DW_LNS_set_file }
  1797. linelist.concat(tai_const.create_8bit(1));
  1798. { DW_LNS_set_column }
  1799. linelist.concat(tai_const.create_8bit(1));
  1800. { DW_LNS_negate_stmt }
  1801. linelist.concat(tai_const.create_8bit(0));
  1802. { DW_LNS_set_basic_block }
  1803. linelist.concat(tai_const.create_8bit(0));
  1804. { DW_LNS_const_add_pc }
  1805. linelist.concat(tai_const.create_8bit(0));
  1806. { DW_LNS_fixed_advance_pc }
  1807. linelist.concat(tai_const.create_8bit(1));
  1808. { DW_LNS_set_prologue_end }
  1809. linelist.concat(tai_const.create_8bit(0));
  1810. { DW_LNS_set_epilogue_begin }
  1811. linelist.concat(tai_const.create_8bit(0));
  1812. { DW_LNS_set_isa }
  1813. linelist.concat(tai_const.create_8bit(1));
  1814. { generate directory and filelist}
  1815. dlist := TFPList.Create;
  1816. flist := TFPList.Create;
  1817. dirlist.foreach_static(@AddNamedIndexToList, dlist);
  1818. dlist.Sort(@DirListSortCompare);
  1819. { include_directories }
  1820. linelist.concat(tai_comment.Create(strpnew('include_directories')));
  1821. { list }
  1822. for n := 0 to dlist.Count - 1 do
  1823. begin
  1824. ditem := TDirIndexItem(dlist[n]);
  1825. ditem.Files.foreach_static(@AddNamedIndexToList, flist);
  1826. if ditem.Name = '.' then Continue;
  1827. linelist.concat(tai_string.create(ditem.Name+#0));
  1828. end;
  1829. { end of list }
  1830. linelist.concat(tai_const.create_8bit(0));
  1831. { file_names }
  1832. linelist.concat(tai_comment.Create(strpnew('file_names')));
  1833. { list }
  1834. flist.Sort(@FileListSortCompare);
  1835. for n := 0 to flist.Count - 1 do
  1836. begin
  1837. fitem := TFileIndexItem(flist[n]);
  1838. { file name }
  1839. linelist.concat(tai_string.create(fitem.Name+#0));
  1840. { directory index }
  1841. linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex));
  1842. { last modification }
  1843. linelist.concat(tai_const.create_uleb128bit(0));
  1844. { file length }
  1845. linelist.concat(tai_const.create_uleb128bit(0));
  1846. end;
  1847. { end of list }
  1848. linelist.concat(tai_const.create_8bit(0));
  1849. dlist.free;
  1850. flist.free;
  1851. { end of debug line header }
  1852. linelist.concat(tai_symbol.createname('.Lehdebug_line0',AT_DATA,0));
  1853. linelist.concat(tai_comment.Create(strpnew('=== header end ===')));
  1854. { add line program }
  1855. linelist.concatList(asmline);
  1856. { end of debug line table }
  1857. linelist.concat(tai_symbol.createname('.Ledebug_line0',AT_DATA,0));
  1858. end;
  1859. procedure TDebugInfoDwarf.inserttypeinfo;
  1860. procedure write_defs_to_write;
  1861. var
  1862. n : integer;
  1863. looplist,
  1864. templist: TFPObjectList;
  1865. def : tdef;
  1866. begin
  1867. templist := TFPObjectList.Create(False);
  1868. looplist := deftowritelist;
  1869. while looplist.count > 0 do
  1870. begin
  1871. deftowritelist := templist;
  1872. for n := 0 to looplist.count - 1 do
  1873. begin
  1874. def := tdef(looplist[n]);
  1875. case def.dbg_state of
  1876. dbg_state_written:
  1877. continue;
  1878. dbg_state_writing:
  1879. internalerror(200610052);
  1880. dbg_state_unused:
  1881. internalerror(200610053);
  1882. dbg_state_used:
  1883. appenddef(def)
  1884. else
  1885. internalerror(200610054);
  1886. end;
  1887. end;
  1888. looplist.clear;
  1889. templist := looplist;
  1890. looplist := deftowritelist;
  1891. end;
  1892. templist.free;
  1893. end;
  1894. var
  1895. storefilepos : tfileposinfo;
  1896. lenstartlabel : tasmlabel;
  1897. i : longint;
  1898. def: tdef;
  1899. begin
  1900. storefilepos:=aktfilepos;
  1901. aktfilepos:=current_module.mainfilepos;
  1902. currabbrevnumber:=0;
  1903. writing_def_dwarf:=false;
  1904. { not used (MWE)
  1905. nextdefnumber:=0;
  1906. }
  1907. defnumberlist:=TFPObjectList.create(false);
  1908. deftowritelist:=TFPObjectList.create(false);
  1909. { not exported (FK)
  1910. filerecdef:=gettypedef('FILEREC');
  1911. textrecdef:=gettypedef('TEXTREC');
  1912. }
  1913. vardatadef:=trecorddef(search_system_type('TVARDATA').restype.def);
  1914. { write start labels }
  1915. current_asmdata.asmlists[al_dwarf_info].concat(tai_section.create(sec_debug_info,'',0));
  1916. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname('.Ldebug_info0',AT_DATA,0));
  1917. { start abbrev section }
  1918. new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
  1919. { debug info header }
  1920. current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
  1921. { size }
  1922. { currently we create only 32 bit dwarf }
  1923. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(aitconst_32bit,
  1924. lenstartlabel,tasmsymbol.create('.Ledebug_info0',AB_COMMON,AT_DATA)));
  1925. current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
  1926. { version }
  1927. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(dwarf_version));
  1928. { abbrev table (=relative from section start)}
  1929. if isdwarf64 then
  1930. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_64bit,
  1931. current_asmdata.RefAsmSymbol('.Ldebug_abbrev0')))
  1932. else
  1933. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_32bit,
  1934. current_asmdata.RefAsmSymbol('.Ldebug_abbrev0')));
  1935. { address size }
  1936. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(aint)));
  1937. append_entry(DW_TAG_compile_unit,true,[
  1938. DW_AT_name,DW_FORM_string,FixFileName(current_module.sourcefiles.get_file(1).name^)+#0,
  1939. DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
  1940. DW_AT_comp_dir,DW_FORM_string,BsToSlash(FixPath(current_module.sourcefiles.get_file(1).path^,false))+#0,
  1941. DW_AT_language,DW_FORM_data1,DW_LANG_Pascal83,
  1942. DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
  1943. { reference to line info section }
  1944. append_labelentry_data(DW_AT_stmt_list,current_asmdata.RefAsmSymbol('.Ldebug_line0'));
  1945. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol('.Ltext0'));
  1946. append_labelentry(DW_AT_high_pc,current_asmdata.RefAsmSymbol('.Letext0'));
  1947. finish_entry;
  1948. { first write all global/local symbols. This will flag all required tdefs }
  1949. if assigned(current_module.globalsymtable) then
  1950. begin
  1951. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - Begin unit '+current_module.globalsymtable.name^+' has index '+tostr(current_module.globalsymtable.moduleid))));
  1952. write_symtable_syms(current_module.globalsymtable);
  1953. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - End unit '+current_module.globalsymtable.name^+' has index '+tostr(current_module.globalsymtable.moduleid))));
  1954. end;
  1955. if assigned(current_module.localsymtable) then
  1956. begin
  1957. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable')));
  1958. write_symtable_syms(current_module.localsymtable);
  1959. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - End Staticsymtable')));
  1960. end;
  1961. { reset unit type info flag }
  1962. reset_unit_type_info;
  1963. { write used types from the used units }
  1964. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  1965. { last write the types from this unit }
  1966. if assigned(current_module.globalsymtable) then
  1967. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  1968. if assigned(current_module.localsymtable) then
  1969. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  1970. { write defs not written yet }
  1971. write_defs_to_write;
  1972. { close compilation unit entry }
  1973. finish_children;
  1974. { end of debug info table }
  1975. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1976. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname('.Ledebug_info0',AT_DATA,0));
  1977. { end of abbrev table }
  1978. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  1979. { reset all def labels }
  1980. for i:=0 to defnumberlist.count-1 do
  1981. begin
  1982. def := tdef(defnumberlist[i]);
  1983. if assigned(def) then
  1984. begin
  1985. def.dwarf_lab:=nil;
  1986. def.dbg_state:=dbg_state_unused;
  1987. end;
  1988. end;
  1989. defnumberlist.free;
  1990. defnumberlist:=nil;
  1991. deftowritelist.free;
  1992. deftowritelist:=nil;
  1993. aktfilepos:=storefilepos;
  1994. end;
  1995. procedure TDebugInfoDwarf.referencesections(list:TAsmList);
  1996. begin
  1997. end;
  1998. procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
  1999. var
  2000. currfileinfo,
  2001. lastfileinfo : tfileposinfo;
  2002. currfuncname : pstring;
  2003. currsectype : TAsmSectiontype;
  2004. hlabel : tasmlabel;
  2005. hp : tai;
  2006. infile : tinputfile;
  2007. current_file : tai_file;
  2008. prevcolumn,
  2009. diffline,
  2010. prevline,
  2011. prevfileidx,
  2012. currfileidx: Integer;
  2013. prevlabel,
  2014. currlabel : tasmlabel;
  2015. begin
  2016. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  2017. currfuncname:=nil;
  2018. currsectype:=sec_code;
  2019. hp:=Tai(list.first);
  2020. prevcolumn := 0;
  2021. prevline := 1;
  2022. prevfileidx := 1;
  2023. prevlabel := nil;
  2024. while assigned(hp) do
  2025. begin
  2026. case hp.typ of
  2027. ait_section :
  2028. currsectype:=tai_section(hp).sectype;
  2029. ait_function_name :
  2030. begin
  2031. currfuncname:=tai_function_name(hp).funcname;
  2032. asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
  2033. end;
  2034. ait_force_line : begin
  2035. lastfileinfo.line:=-1;
  2036. end;
  2037. end;
  2038. if (currsectype=sec_code) and
  2039. (hp.typ=ait_instruction) then
  2040. begin
  2041. currfileinfo:=tailineinfo(hp).fileinfo;
  2042. { file changed ? (must be before line info) }
  2043. if (currfileinfo.fileindex<>0) and
  2044. (lastfileinfo.fileindex<>currfileinfo.fileindex) then
  2045. begin
  2046. infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
  2047. if assigned(infile) then
  2048. begin
  2049. currfileidx := get_file_index(infile);
  2050. if prevfileidx <> currfileidx then
  2051. begin
  2052. list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path^)), hp);
  2053. list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name^)), hp);
  2054. list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp);
  2055. { set file }
  2056. asmline.concat(tai_comment.Create(strpnew('path: '+infile.path^)));
  2057. asmline.concat(tai_comment.Create(strpnew('file: '+infile.name^)));
  2058. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  2059. asmline.concat(tai_const.create_uleb128bit(currfileidx));
  2060. prevfileidx := currfileidx;
  2061. end;
  2062. { force new line info }
  2063. lastfileinfo.line:=-1;
  2064. end;
  2065. end;
  2066. { line changed ? }
  2067. if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
  2068. begin
  2069. { set address }
  2070. current_asmdata.getlabel(currlabel, alt_dbgline);
  2071. list.insertbefore(tai_label.create(currlabel), hp);
  2072. asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']')));
  2073. if prevlabel = nil then
  2074. begin
  2075. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2076. if isdwarf64 then
  2077. asmline.concat(tai_const.create_uleb128bit(9)) { 1 + 8 }
  2078. else
  2079. asmline.concat(tai_const.create_uleb128bit(5)); { 1 + 4 }
  2080. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  2081. if isdwarf64 then
  2082. asmline.concat(tai_const.create_type_sym(aitconst_64bit, currlabel))
  2083. else
  2084. asmline.concat(tai_const.create_type_sym(aitconst_32bit, currlabel));
  2085. end
  2086. else
  2087. begin
  2088. asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc));
  2089. asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel));
  2090. end;
  2091. prevlabel := currlabel;
  2092. { set column }
  2093. if prevcolumn <> currfileinfo.column then
  2094. begin
  2095. asmline.concat(tai_const.create_8bit(DW_LNS_set_column));
  2096. asmline.concat(tai_const.create_uleb128bit(currfileinfo.column));
  2097. prevcolumn := currfileinfo.column;
  2098. end;
  2099. { set line }
  2100. diffline := currfileinfo.line - prevline;
  2101. if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then
  2102. begin
  2103. { use special opcode, this also adds a row }
  2104. asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE));
  2105. end
  2106. else
  2107. begin
  2108. if diffline <> 0 then
  2109. begin
  2110. asmline.concat(tai_const.create_8bit(DW_LNS_advance_line));
  2111. asmline.concat(tai_const.create_sleb128bit(diffline));
  2112. end;
  2113. { no row added yet, do it manually }
  2114. asmline.concat(tai_const.create_8bit(DW_LNS_copy));
  2115. end;
  2116. prevline := currfileinfo.line;
  2117. end;
  2118. lastfileinfo:=currfileinfo;
  2119. end;
  2120. hp:=tai(hp.next);
  2121. end;
  2122. { end sequence }
  2123. asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op));
  2124. asmline.concat(tai_const.Create_8bit(1));
  2125. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  2126. asmline.concat(tai_comment.Create(strpnew('###################')));
  2127. end;
  2128. {****************************************************************************
  2129. TDebugInfoDwarf2
  2130. ****************************************************************************}
  2131. procedure TDebugInfoDwarf2.appenddef_file(def: tfiledef);
  2132. begin
  2133. { gdb 6.4 doesn't support files so far so we use some fake recorddef
  2134. file recs. are less than 1k so using data2 is enough }
  2135. if assigned(def.typesym) then
  2136. append_entry(DW_TAG_structure_type,false,[
  2137. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  2138. DW_AT_byte_size,DW_FORM_udata,def.size
  2139. ])
  2140. else
  2141. append_entry(DW_TAG_structure_type,false,[
  2142. DW_AT_byte_size,DW_FORM_udata,def.size
  2143. ]);
  2144. finish_entry;
  2145. end;
  2146. procedure TDebugInfoDwarf2.appenddef_formal(def: tformaldef);
  2147. begin
  2148. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2149. replace it with a unsigned type with size 0 (FK)
  2150. }
  2151. append_entry(DW_TAG_base_type,false,[
  2152. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2153. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2154. DW_AT_byte_size,DW_FORM_data1,0
  2155. ]);
  2156. finish_entry;
  2157. end;
  2158. procedure TDebugInfoDwarf2.appenddef_object(def: tobjectdef);
  2159. procedure doappend;
  2160. begin
  2161. if assigned(def.objname) then
  2162. append_entry(DW_TAG_structure_type,true,[
  2163. DW_AT_name,DW_FORM_string,def.objname^+#0,
  2164. DW_AT_byte_size,DW_FORM_udata,def.size
  2165. ])
  2166. else
  2167. append_entry(DW_TAG_structure_type,true,[
  2168. DW_AT_byte_size,DW_FORM_udata,def.size
  2169. ]);
  2170. finish_entry;
  2171. if assigned(def.childof) then
  2172. begin
  2173. append_entry(DW_TAG_inheritance,false,[
  2174. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2175. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2176. ]);
  2177. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2178. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2179. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2180. finish_entry;
  2181. end;
  2182. def.symtable.foreach(@enum_membersyms_callback,nil);
  2183. finish_children;
  2184. end;
  2185. var
  2186. obj : tasmlabel;
  2187. begin
  2188. case def.objecttype of
  2189. odt_cppclass,
  2190. odt_object:
  2191. doappend;
  2192. odt_interfacecom,
  2193. odt_interfacecorba,
  2194. odt_dispinterface,
  2195. odt_class:
  2196. begin
  2197. current_asmdata.getdatalabel(obj);
  2198. { implicit pointer }
  2199. append_entry(DW_TAG_pointer_type,false,[]);
  2200. append_labelentry_ref(DW_AT_type,obj);
  2201. finish_entry;
  2202. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  2203. doappend;
  2204. end;
  2205. else
  2206. internalerror(200602041);
  2207. end;
  2208. end;
  2209. procedure TDebugInfoDwarf2.appenddef_set(def: tsetdef);
  2210. begin
  2211. { at least gdb up to 6.4 doesn't support sets in dwarf, there is a patch available to fix this:
  2212. http://sources.redhat.com/ml/gdb-patches/2005-05/msg00278.html (FK) }
  2213. if assigned(def.typesym) then
  2214. append_entry(DW_TAG_base_type,false,[
  2215. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  2216. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2217. DW_AT_byte_size,DW_FORM_data2,def.size
  2218. ])
  2219. else
  2220. append_entry(DW_TAG_base_type,false,[
  2221. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2222. DW_AT_byte_size,DW_FORM_data2,def.size
  2223. ]);
  2224. finish_entry;
  2225. end;
  2226. procedure TDebugInfoDwarf2.appenddef_unineddef(def: tundefineddef);
  2227. begin
  2228. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2229. replace it with a unsigned type with size 0 (FK)
  2230. }
  2231. append_entry(DW_TAG_base_type,false,[
  2232. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2233. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2234. DW_AT_byte_size,DW_FORM_data1,0
  2235. ]);
  2236. finish_entry;
  2237. end;
  2238. procedure TDebugInfoDwarf2.appenddef_variant(def: tvariantdef);
  2239. begin
  2240. { variants aren't known to dwarf2 but writting tvardata should be enough }
  2241. appenddef_record(trecorddef(vardatadef));
  2242. end;
  2243. function TDebugInfoDwarf2.dwarf_version: Word;
  2244. begin
  2245. Result:=2;
  2246. end;
  2247. {****************************************************************************
  2248. TDebugInfoDwarf3
  2249. ****************************************************************************}
  2250. procedure TDebugInfoDwarf3.appenddef_file(def: tfiledef);
  2251. begin
  2252. if assigned(def.typesym) then
  2253. append_entry(DW_TAG_file_type,false,[
  2254. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  2255. DW_AT_byte_size,DW_FORM_data2,def.size
  2256. ])
  2257. else
  2258. append_entry(DW_TAG_file_type,false,[
  2259. DW_AT_byte_size,DW_FORM_data2,def.size
  2260. ]);
  2261. if tfiledef(def).filetyp=ft_typed then
  2262. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiletype.def));
  2263. finish_entry;
  2264. end;
  2265. procedure TDebugInfoDwarf3.appenddef_formal(def: tformaldef);
  2266. begin
  2267. append_entry(DW_TAG_unspecified_type,false,[
  2268. ]);
  2269. finish_entry;
  2270. end;
  2271. procedure TDebugInfoDwarf3.appenddef_object(def: tobjectdef);
  2272. procedure dostruct(tag: tdwarf_tag);
  2273. begin
  2274. if assigned(def.objname) then
  2275. append_entry(tag,true,[
  2276. DW_AT_name,DW_FORM_string,def.objname^+#0,
  2277. DW_AT_byte_size,DW_FORM_udata,def.size
  2278. ])
  2279. else
  2280. append_entry(DW_TAG_structure_type,true,[
  2281. DW_AT_byte_size,DW_FORM_udata,def.size
  2282. ]);
  2283. finish_entry;
  2284. end;
  2285. procedure doimplicitpointer;
  2286. var
  2287. obj : tasmlabel;
  2288. begin
  2289. current_asmdata.getdatalabel(obj);
  2290. { implicit pointer }
  2291. append_entry(DW_TAG_pointer_type,false,[]);
  2292. append_labelentry_ref(DW_AT_type,obj);
  2293. finish_entry;
  2294. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  2295. end;
  2296. procedure doparent(isinterface: boolean);
  2297. begin
  2298. if not assigned(def.childof) then
  2299. exit;
  2300. if isinterface then
  2301. begin
  2302. append_entry(DW_TAG_inheritance,false,[]);
  2303. end
  2304. else
  2305. begin
  2306. append_entry(DW_TAG_inheritance,false,[
  2307. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2308. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2309. ]);
  2310. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2311. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2312. end;
  2313. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2314. finish_entry;
  2315. end;
  2316. var
  2317. n: integer;
  2318. begin
  2319. case def.objecttype of
  2320. odt_cppclass,
  2321. odt_object:
  2322. begin
  2323. dostruct(DW_TAG_structure_type);
  2324. doparent(false);
  2325. end;
  2326. odt_interfacecom,
  2327. odt_interfacecorba,
  2328. odt_dispinterface:
  2329. begin
  2330. dostruct(DW_TAG_interface_type);
  2331. doparent(true);
  2332. end;
  2333. odt_class:
  2334. begin
  2335. { not sure if the implicit pointer is needed for tag_class (MWE)}
  2336. {
  2337. doimplicitpointer;
  2338. }
  2339. dostruct(DW_TAG_class_type);
  2340. doparent(false);
  2341. end;
  2342. else
  2343. internalerror(200609171);
  2344. end;
  2345. { add implemented interfaces }
  2346. if assigned(def.implementedinterfaces) then
  2347. for n := 1 to def.implementedinterfaces.count do
  2348. begin
  2349. append_entry(DW_TAG_inheritance,false,[]);
  2350. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.implementedinterfaces.interfaces(n)));
  2351. finish_entry;
  2352. end;
  2353. { add members }
  2354. def.symtable.foreach(@enum_membersyms_callback,nil);
  2355. finish_children;
  2356. end;
  2357. procedure TDebugInfoDwarf3.appenddef_set(def: tsetdef);
  2358. begin
  2359. if assigned(def.typesym) then
  2360. append_entry(DW_TAG_set_type,false,[
  2361. DW_AT_name,DW_FORM_string,def.typesym.name+#0,
  2362. DW_AT_byte_size,DW_FORM_data2,def.size
  2363. ])
  2364. else
  2365. append_entry(DW_TAG_set_type,false,[
  2366. DW_AT_byte_size,DW_FORM_data2,def.size
  2367. ]);
  2368. if assigned(tsetdef(def).elementtype.def) then
  2369. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tsetdef(def).elementtype.def));
  2370. finish_entry;
  2371. end;
  2372. procedure TDebugInfoDwarf3.appenddef_unineddef(def: tundefineddef);
  2373. begin
  2374. { ??? can a undefined def have a typename ? }
  2375. if assigned(def.typesym) then
  2376. append_entry(DW_TAG_unspecified_type,false,[
  2377. DW_AT_name,DW_FORM_string,def.typesym.name+#0
  2378. ])
  2379. else
  2380. append_entry(DW_TAG_unspecified_type,false,[
  2381. ]);
  2382. finish_entry;
  2383. end;
  2384. procedure TDebugInfoDwarf3.appenddef_variant(def: tvariantdef);
  2385. const
  2386. VARIANTS: array[1..27] of record Value: Word; Name: String end = (
  2387. (value:0; name:''),
  2388. (value:1; name:''),
  2389. (value:2; name:'VSMALLINT'),
  2390. (value:3; name:'VINTEGER'),
  2391. (value:4; name:'VSINGLE'),
  2392. (value:5; name:'VDOUBLE'),
  2393. (value:6; name:'VCURRENCY'),
  2394. (value:7; name:'VDATE'),
  2395. (value:8; name:'VOLESTR'),
  2396. (value:9; name:'VDISPATCH'),
  2397. (value:10; name:'VERROR'),
  2398. (value:11; name:'VBOOLEAN'),
  2399. (value:12; name:''),
  2400. (value:13; name:'VUNKNOWN'),
  2401. (value:14; name:''),
  2402. (value:16; name:'VSHORTINT'),
  2403. (value:17; name:'VBYTE'),
  2404. (value:18; name:'VWORD'),
  2405. (value:19; name:'VLONGWORD'),
  2406. (value:20; name:'VINT64'),
  2407. (value:21; name:'VQWORD'),
  2408. (value:36; name:'VRECORD'),
  2409. (value:$48; name:''),
  2410. (value:$100; name:'VSTRING'),
  2411. (value:$101; name:'VANY'),
  2412. (value:$2000; name:'VARRAY'),
  2413. (value:$4000; name:'VPOINTER')
  2414. );
  2415. var
  2416. fs: tfieldvarsym;
  2417. lbl: tasmlabel;
  2418. idx: integer;
  2419. begin
  2420. { it could be done with DW_TAG_variant for the union part (if that info was available)
  2421. now we do it manually for variants (MWE) }
  2422. { struct }
  2423. append_entry(DW_TAG_structure_type,true,[
  2424. DW_AT_name,DW_FORM_string,'VARIANT'#0,
  2425. DW_AT_byte_size,DW_FORM_udata,vardatadef.size
  2426. ]);
  2427. finish_entry;
  2428. append_entry(DW_TAG_variant_part,true,[
  2429. ]);
  2430. current_asmdata.getaddrlabel(lbl);
  2431. append_labelentry_ref(DW_AT_discr,lbl);
  2432. finish_entry;
  2433. { discriminant }
  2434. fs := tfieldvarsym(vardatadef.symtable.search('VTYPE'));
  2435. if (fs = nil) or (fs.typ <> fieldvarsym) then
  2436. internalerror(200609271);
  2437. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0));
  2438. appendsym_fieldvar(fs);
  2439. { variants }
  2440. for idx := Low(VARIANTS) to High(VARIANTS) do
  2441. begin
  2442. append_entry(DW_TAG_variant,true,[
  2443. DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value
  2444. ]);
  2445. finish_entry;
  2446. if VARIANTS[idx].name <> '' then
  2447. begin
  2448. fs := tfieldvarsym(vardatadef.symtable.search(VARIANTS[idx].name));
  2449. if (fs = nil) or (fs.typ <> fieldvarsym) then
  2450. internalerror(20060927200+idx);
  2451. appendsym_fieldvar(fs);
  2452. end;
  2453. finish_children; { variant }
  2454. end;
  2455. finish_children; { variant part }
  2456. finish_children; { struct }
  2457. end;
  2458. function TDebugInfoDwarf3.dwarf_version: Word;
  2459. begin
  2460. Result:=3;
  2461. end;
  2462. {****************************************************************************
  2463. ****************************************************************************}
  2464. const
  2465. dbg_dwarf2_info : tdbginfo =
  2466. (
  2467. id : dbg_dwarf2;
  2468. idtxt : 'DWARF2';
  2469. );
  2470. dbg_dwarf3_info : tdbginfo =
  2471. (
  2472. id : dbg_dwarf3;
  2473. idtxt : 'DWARF3';
  2474. );
  2475. initialization
  2476. RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2);
  2477. RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3);
  2478. end.