dbgdwarf.pas 103 KB

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