dbgdwarf.pas 104 KB

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