dbgdwarf.pas 111 KB

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