dbgdwarf.pas 140 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542
  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. There is a similar utility called dwarfdump which is not elf-specific and
  26. which has been ported to most systems.
  27. }
  28. unit dbgdwarf;
  29. {$i fpcdefs.inc}
  30. interface
  31. uses
  32. cclasses,globtype,
  33. aasmbase,aasmtai,aasmdata,
  34. symbase,symtype,symdef,symsym,
  35. finput,
  36. DbgBase;
  37. type
  38. { Tag names and codes. }
  39. tdwarf_tag = (DW_TAG_padding := $00,DW_TAG_array_type := $01,
  40. DW_TAG_class_type := $02,DW_TAG_entry_point := $03,
  41. DW_TAG_enumeration_type := $04,DW_TAG_formal_parameter := $05,
  42. DW_TAG_imported_declaration := $08,DW_TAG_label := $0a,
  43. DW_TAG_lexical_block := $0b,DW_TAG_member := $0d,
  44. DW_TAG_pointer_type := $0f,DW_TAG_reference_type := $10,
  45. DW_TAG_compile_unit := $11,DW_TAG_stringtypee := $12,
  46. DW_TAG_structure_type := $13,DW_TAG_subroutine_type := $15,
  47. DW_TAG_typedef := $16,DW_TAG_union_type := $17,
  48. DW_TAG_unspecified_parameters := $18,
  49. DW_TAG_variant := $19,DW_TAG_common_block := $1a,
  50. DW_TAG_common_inclusion := $1b,DW_TAG_inheritance := $1c,
  51. DW_TAG_inlined_subroutine := $1d,DW_TAG_module := $1e,
  52. DW_TAG_ptr_to_member_type := $1f,DW_TAG_set_type := $20,
  53. DW_TAG_subrange_type := $21,DW_TAG_with_stmt := $22,
  54. DW_TAG_access_declaration := $23,DW_TAG_base_type := $24,
  55. DW_TAG_catch_block := $25,DW_TAG_const_type := $26,
  56. DW_TAG_constant := $27,DW_TAG_enumerator := $28,
  57. DW_TAG_file_type := $29,DW_TAG_friend := $2a,
  58. DW_TAG_namelist := $2b,DW_TAG_namelist_item := $2c,
  59. DW_TAG_packed_type := $2d,DW_TAG_subprogram := $2e,
  60. DW_TAG_template_type_param := $2f,DW_TAG_template_value_param := $30,
  61. DW_TAG_thrown_type := $31,DW_TAG_try_block := $32,
  62. DW_TAG_variant_part := $33,DW_TAG_variable := $34,
  63. DW_TAG_volatile_type := $35,
  64. { DWARF 3. }
  65. DW_TAG_dwarf_procedure := $36,
  66. DW_TAG_restrict_type := $37,DW_TAG_interface_type := $38,
  67. DW_TAG_namespace := $39,DW_TAG_imported_module := $3a,
  68. DW_TAG_unspecified_type := $3b,DW_TAG_partial_unit := $3c,
  69. DW_TAG_imported_unit := $3d,
  70. { SGI/MIPS Extensions. }
  71. DW_TAG_MIPS_loop := $4081,
  72. { HP extensions. See: ftp://ftp.hp.com/pub/lang/tools/WDB/wdb-4.0.tar.gz . }
  73. DW_TAG_HP_array_descriptor := $4090,
  74. { GNU extensions. }
  75. { For FORTRAN 77 and Fortran 90. }
  76. DW_TAG_format_label := $4101,
  77. { For C++. }
  78. DW_TAG_function_template := $4102,DW_TAG_class_template := $4103,
  79. DW_TAG_GNU_BINCL := $4104,DW_TAG_GNU_EINCL := $4105,
  80. { Extensions for UPC. See: http://upc.gwu.edu/~upc. }
  81. DW_TAG_upc_shared_type := $8765,DW_TAG_upc_strict_type := $8766,
  82. DW_TAG_upc_relaxed_type := $8767,
  83. { PGI (STMicroelectronics) extensions. No documentation available. }
  84. DW_TAG_PGI_kanji_type := $A000,
  85. DW_TAG_PGI_interface_block := $A020);
  86. {$notes off}
  87. { Attribute names and codes. }
  88. tdwarf_attribute = (DW_AT_sibling := $01,DW_AT_location := $02,
  89. DW_AT_name := $03,DW_AT_ordering := $09,
  90. DW_AT_subscr_data := $0a,DW_AT_byte_size := $0b,
  91. DW_AT_bit_offset := $0c,DW_AT_bit_size := $0d,
  92. DW_AT_element_list := $0f,DW_AT_stmt_list := $10,
  93. DW_AT_low_pc := $11,DW_AT_high_pc := $12,
  94. DW_AT_language := $13,DW_AT_member := $14,
  95. DW_AT_discr := $15,DW_AT_discr_value := $16,
  96. DW_AT_visibility := $17,DW_AT_import := $18,
  97. DW_AT_string_length := $19,DW_AT_common_reference := $1a,
  98. DW_AT_comp_dir := $1b,DW_AT_const_value := $1c,
  99. DW_AT_containing_type := $1d,DW_AT_default_value := $1e,
  100. DW_AT_inline := $20,DW_AT_is_optional := $21,
  101. DW_AT_lower_bound := $22,DW_AT_producer := $25,
  102. DW_AT_prototyped := $27,DW_AT_return_addr := $2a,
  103. DW_AT_start_scope := $2c,DW_AT_stride_size := $2e,
  104. DW_AT_upper_bound := $2f,DW_AT_abstract_origin := $31,
  105. DW_AT_accessibility := $32,DW_AT_address_class := $33,
  106. DW_AT_artificial := $34,DW_AT_base_types := $35,
  107. DW_AT_calling_convention := $36,DW_AT_count := $37,
  108. DW_AT_data_member_location := $38,DW_AT_decl_column := $39,
  109. DW_AT_decl_file := $3a,DW_AT_decl_line := $3b,
  110. DW_AT_declaration := $3c,DW_AT_discr_list := $3d,
  111. DW_AT_encoding := $3e,DW_AT_external := $3f,
  112. DW_AT_frame_base := $40,DW_AT_friend := $41,
  113. DW_AT_identifier_case := $42,DW_AT_macro_info := $43,
  114. DW_AT_namelist_items := $44,DW_AT_priority := $45,
  115. DW_AT_segment := $46,DW_AT_specification := $47,
  116. DW_AT_static_link := $48,DW_AT_type := $49,
  117. DW_AT_use_location := $4a,DW_AT_variable_parameter := $4b,
  118. DW_AT_virtuality := $4c,DW_AT_vtable_elem_location := $4d,
  119. { DWARF 3 values. }
  120. DW_AT_allocated := $4e,DW_AT_associated := $4f,
  121. DW_AT_data_location := $50,DW_AT_byte_stride := $51,
  122. DW_AT_entry_pc := $52,DW_AT_use_UTF8 := $53,
  123. DW_AT_extension := $54,DW_AT_ranges := $55,
  124. DW_AT_trampoline := $56,DW_AT_call_column := $57,
  125. DW_AT_call_file := $58,DW_AT_call_line := $59,
  126. { SGI/MIPS extensions. }
  127. DW_AT_MIPS_fde := $2001,DW_AT_MIPS_loop_begin := $2002,
  128. DW_AT_MIPS_tail_loop_begin := $2003,DW_AT_MIPS_epilog_begin := $2004,
  129. DW_AT_MIPS_loop_unroll_factor := $2005,
  130. DW_AT_MIPS_software_pipeline_depth := $2006,
  131. DW_AT_MIPS_linkage_name := $2007,DW_AT_MIPS_stride := $2008,
  132. DW_AT_MIPS_abstract_name := $2009,DW_AT_MIPS_clone_origin := $200a,
  133. DW_AT_MIPS_has_inlines := $200b,
  134. { HP extensions. }
  135. DW_AT_HP_block_index := $2000,
  136. DW_AT_HP_unmodifiable := $2001,DW_AT_HP_actuals_stmt_list := $2010,
  137. DW_AT_HP_proc_per_section := $2011,DW_AT_HP_raw_data_ptr := $2012,
  138. DW_AT_HP_pass_by_reference := $2013,DW_AT_HP_opt_level := $2014,
  139. DW_AT_HP_prof_version_id := $2015,DW_AT_HP_opt_flags := $2016,
  140. DW_AT_HP_cold_region_low_pc := $2017,DW_AT_HP_cold_region_high_pc := $2018,
  141. DW_AT_HP_all_variables_modifiable := $2019,
  142. DW_AT_HP_linkage_name := $201a,DW_AT_HP_prof_flags := $201b,
  143. { GNU extensions. }
  144. DW_AT_sf_names := $2101,DW_AT_src_info := $2102,
  145. DW_AT_mac_info := $2103,DW_AT_src_coords := $2104,
  146. DW_AT_body_begin := $2105,DW_AT_body_end := $2106,
  147. DW_AT_GNU_vector := $2107,
  148. { VMS extensions. }
  149. DW_AT_VMS_rtnbeg_pd_address := $2201,
  150. { UPC extension. }
  151. DW_AT_upc_threads_scaled := $3210,
  152. { PGI (STMicroelectronics) extensions. }
  153. DW_AT_PGI_lbase := $3a00,
  154. DW_AT_PGI_soffset := $3a01,DW_AT_PGI_lstride := $3a02
  155. );
  156. {$notes on}
  157. { Form names and codes. }
  158. Tdwarf_form = (DW_FORM_addr := $01,DW_FORM_block2 := $03,
  159. DW_FORM_block4 := $04,DW_FORM_data2 := $05,
  160. DW_FORM_data4 := $06,DW_FORM_data8 := $07,
  161. DW_FORM_string := $08,DW_FORM_block := $09,
  162. DW_FORM_block1 := $0a,DW_FORM_data1 := $0b,
  163. DW_FORM_flag := $0c,DW_FORM_sdata := $0d,
  164. DW_FORM_strp := $0e,DW_FORM_udata := $0f,
  165. DW_FORM_ref_addr := $10,DW_FORM_ref1 := $11,
  166. DW_FORM_ref2 := $12,DW_FORM_ref4 := $13,
  167. DW_FORM_ref8 := $14,DW_FORM_ref_udata := $15,
  168. DW_FORM_indirect := $16);
  169. TDwarfFile = record
  170. Index: integer;
  171. Name: PChar;
  172. end;
  173. { TDebugInfoDwarf }
  174. TDebugInfoDwarf = class(TDebugInfo)
  175. private
  176. currabbrevnumber : longint;
  177. { collect all defs in one list so we can reset them easily }
  178. defnumberlist,
  179. deftowritelist : TFPObjectList;
  180. { use this defs to create info for variants and file handles }
  181. { unused (MWE)
  182. filerecdef,
  183. textrecdef : tdef;
  184. }
  185. dirlist: TFPHashObjectList;
  186. filesequence: Integer;
  187. loclist: tdynamicarray;
  188. asmline: TAsmList;
  189. function def_dwarf_lab(def:tdef) : tasmsymbol;
  190. function def_dwarf_ref_lab(def:tdef) : tasmsymbol;
  191. function def_dwarf_class_struct_lab(def:tobjectdef) : tasmsymbol;
  192. function get_file_index(afile: tinputfile): Integer;
  193. function relative_dwarf_path(const s:tcmdstr):tcmdstr;
  194. protected
  195. // set if we should use 64bit headers (dwarf3 and up)
  196. _use_64bit_headers: Boolean;
  197. // set to ait_const32bit if use_64bit_headers is false, otherwise
  198. // to ait_const64bit
  199. offsetreltype,
  200. offsetabstype : taiconst_type;
  201. // set if we generated any lineinfo at all. If not, we have to terminate
  202. // when insertmoduleinfo is called.
  203. generated_lineinfo: boolean;
  204. vardatadef: trecorddef;
  205. procedure set_use_64bit_headers(state: boolean);
  206. property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers;
  207. procedure set_def_dwarf_labs(def:tdef);
  208. { Convenience version of the method below, so the compiler creates the
  209. tvarrec for us (must only pass one element in the last parameter). }
  210. procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
  211. procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
  212. procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  213. procedure append_block1(attr: tdwarf_attribute; size: aint);
  214. procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  215. procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  216. procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
  217. procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
  218. procedure append_labelentry_dataptr_common(attr : tdwarf_attribute);
  219. procedure beforeappenddef(list:TAsmList;def:tdef);override;
  220. procedure afterappenddef(list:TAsmList;def:tdef);override;
  221. procedure appenddef_ord(list:TAsmList;def:torddef);override;
  222. procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
  223. procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
  224. procedure appenddef_array(list:TAsmList;def:tarraydef);override;
  225. procedure appenddef_record(list:TAsmList;def:trecorddef);override;
  226. procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
  227. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  228. procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
  229. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  230. function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  231. procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  232. { used for global/static variables, local variables, parameters and
  233. absolute variables
  234. }
  235. procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; do_self: boolean);
  236. { used for fields and properties mapped to fields }
  237. procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
  238. procedure beforeappendsym(list:TAsmList;sym:tsym);override;
  239. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  240. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  241. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  242. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  243. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  244. procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
  245. procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
  246. procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
  247. procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
  248. function symname(sym:tsym): String; virtual;
  249. procedure enum_membersyms_callback(p:TObject;arg:pointer);
  250. procedure finish_children;
  251. procedure finish_entry;
  252. procedure finish_lineinfo;
  253. public
  254. constructor Create;override;
  255. destructor Destroy;override;
  256. procedure insertmoduleinfo;override;
  257. procedure inserttypeinfo;override;
  258. procedure referencesections(list:TAsmList);override;
  259. procedure insertlineinfo(list:TAsmList);override;
  260. function dwarf_version: Word; virtual; abstract;
  261. end;
  262. { TDebugInfoDwarf2 }
  263. TDebugInfoDwarf2 = class(TDebugInfoDwarf)
  264. private
  265. protected
  266. procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean);
  267. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  268. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  269. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  270. procedure appenddef_set(list:TAsmList;def:tsetdef); override;
  271. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  272. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  273. public
  274. function dwarf_version: Word; override;
  275. end;
  276. { TDebugInfoDwarf3 }
  277. TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
  278. private
  279. protected
  280. procedure appenddef_array(list:TAsmList;def:tarraydef); override;
  281. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  282. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  283. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  284. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  285. procedure appenddef_set(list:TAsmList;def: tsetdef); override;
  286. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  287. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  288. function symname(sym:tsym): String; override;
  289. public
  290. function dwarf_version: Word; override;
  291. end;
  292. implementation
  293. uses
  294. sysutils,cutils,cfileutl,constexp,
  295. version,globals,verbose,systems,
  296. cpubase,cgbase,paramgr,
  297. fmodule,
  298. defutil,symconst,symtable,ppu
  299. ;
  300. const
  301. LINE_BASE = 1;
  302. OPCODE_BASE = 13;
  303. const
  304. DW_TAG_lo_user = $4080;
  305. DW_TAG_hi_user = $ffff;
  306. { Flag that tells whether entry has a child or not. }
  307. DW_children_no = 0;
  308. DW_children_yes = 1;
  309. const
  310. { Implementation-defined range start. }
  311. DW_AT_lo_user = $2000;
  312. { Implementation-defined range end. }
  313. DW_AT_hi_user = $3ff0;
  314. type
  315. { Source language names and codes. }
  316. tdwarf_source_language = (DW_LANG_C89 := $0001,DW_LANG_C := $0002,DW_LANG_Ada83 := $0003,
  317. DW_LANG_C_plus_plus := $0004,DW_LANG_Cobol74 := $0005,
  318. DW_LANG_Cobol85 := $0006,DW_LANG_Fortran77 := $0007,
  319. DW_LANG_Fortran90 := $0008,DW_LANG_Pascal83 := $0009,
  320. DW_LANG_Modula2 := $000a,DW_LANG_Java := $000b,
  321. { DWARF 3. }
  322. DW_LANG_C99 := $000c,DW_LANG_Ada95 := $000d,
  323. DW_LANG_Fortran95 := $000e,
  324. { MIPS. }
  325. DW_LANG_Mips_Assembler := $8001,
  326. { UPC. }
  327. DW_LANG_Upc := $8765
  328. );
  329. const
  330. { Implementation-defined range start. }
  331. DW_LANG_lo_user = $8000;
  332. { Implementation-defined range start. }
  333. DW_LANG_hi_user = $ffff;
  334. type
  335. { Names and codes for macro information. }
  336. tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2,
  337. DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4,
  338. DW_MACINFO_vendor_ext := 255);
  339. type
  340. { Type encodings. }
  341. Tdwarf_type = (DW_ATE_void := $0,DW_ATE_address := $1,
  342. DW_ATE_boolean := $2,DW_ATE_complex_float := $3,
  343. DW_ATE_float := $4,DW_ATE_signed := $5,
  344. DW_ATE_signed_char := $6,DW_ATE_unsigned := $7,
  345. DW_ATE_unsigned_char := $8,DW_ATE_imaginary_float := $9,
  346. { HP extensions. }
  347. DW_ATE_HP_float80 := $80,DW_ATE_HP_complex_float80 := $81,
  348. DW_ATE_HP_float128 := $82,DW_ATE_HP_complex_float128 := $83,
  349. DW_ATE_HP_floathpintel := $84,DW_ATE_HP_imaginary_float80 := $85,
  350. DW_ATE_HP_imaginary_float128 := $86
  351. );
  352. const
  353. DW_ATE_lo_user = $80;
  354. DW_ATE_hi_user = $ff;
  355. type
  356. Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1
  357. );
  358. { Access attribute. }
  359. Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2,
  360. DW_ACCESS_private := 3);
  361. { Visibility. }
  362. Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2,
  363. DW_VIS_qualified := 3);
  364. { Virtuality. }
  365. Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1,
  366. DW_VIRTUALITY_pure_virtual := 2);
  367. { Case sensitivity. }
  368. Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1,
  369. DW_ID_down_case := 2,DW_ID_case_insensitive := 3
  370. );
  371. { Calling convention. }
  372. Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2,
  373. DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40, DW_CC_GNU_borland_fastcall_i386 := $41
  374. );
  375. {$notes off}
  376. { Location atom names and codes. }
  377. Tdwarf_location_atom = (DW_OP_addr := $03,DW_OP_deref := $06,DW_OP_const1u := $08,
  378. DW_OP_const1s := $09,DW_OP_const2u := $0a,
  379. DW_OP_const2s := $0b,DW_OP_const4u := $0c,
  380. DW_OP_const4s := $0d,DW_OP_const8u := $0e,
  381. DW_OP_const8s := $0f,DW_OP_constu := $10,
  382. DW_OP_consts := $11,DW_OP_dup := $12,DW_OP_drop := $13,
  383. DW_OP_over := $14,DW_OP_pick := $15,DW_OP_swap := $16,
  384. DW_OP_rot := $17,DW_OP_xderef := $18,DW_OP_abs := $19,
  385. DW_OP_and := $1a,DW_OP_div := $1b,DW_OP_minus := $1c,
  386. DW_OP_mod := $1d,DW_OP_mul := $1e,DW_OP_neg := $1f,
  387. DW_OP_not := $20,DW_OP_or := $21,DW_OP_plus := $22,
  388. DW_OP_plus_uconst := $23,DW_OP_shl := $24,
  389. DW_OP_shr := $25,DW_OP_shra := $26,DW_OP_xor := $27,
  390. DW_OP_bra := $28,DW_OP_eq := $29,DW_OP_ge := $2a,
  391. DW_OP_gt := $2b,DW_OP_le := $2c,DW_OP_lt := $2d,
  392. DW_OP_ne := $2e,DW_OP_skip := $2f,DW_OP_lit0 := $30,
  393. DW_OP_lit1 := $31,DW_OP_lit2 := $32,DW_OP_lit3 := $33,
  394. DW_OP_lit4 := $34,DW_OP_lit5 := $35,DW_OP_lit6 := $36,
  395. DW_OP_lit7 := $37,DW_OP_lit8 := $38,DW_OP_lit9 := $39,
  396. DW_OP_lit10 := $3a,DW_OP_lit11 := $3b,
  397. DW_OP_lit12 := $3c,DW_OP_lit13 := $3d,
  398. DW_OP_lit14 := $3e,DW_OP_lit15 := $3f,
  399. DW_OP_lit16 := $40,DW_OP_lit17 := $41,
  400. DW_OP_lit18 := $42,DW_OP_lit19 := $43,
  401. DW_OP_lit20 := $44,DW_OP_lit21 := $45,
  402. DW_OP_lit22 := $46,DW_OP_lit23 := $47,
  403. DW_OP_lit24 := $48,DW_OP_lit25 := $49,
  404. DW_OP_lit26 := $4a,DW_OP_lit27 := $4b,
  405. DW_OP_lit28 := $4c,DW_OP_lit29 := $4d,
  406. DW_OP_lit30 := $4e,DW_OP_lit31 := $4f,
  407. DW_OP_reg0 := $50,DW_OP_reg1 := $51,DW_OP_reg2 := $52,
  408. DW_OP_reg3 := $53,DW_OP_reg4 := $54,DW_OP_reg5 := $55,
  409. DW_OP_reg6 := $56,DW_OP_reg7 := $57,DW_OP_reg8 := $58,
  410. DW_OP_reg9 := $59,DW_OP_reg10 := $5a,DW_OP_reg11 := $5b,
  411. DW_OP_reg12 := $5c,DW_OP_reg13 := $5d,
  412. DW_OP_reg14 := $5e,DW_OP_reg15 := $5f,
  413. DW_OP_reg16 := $60,DW_OP_reg17 := $61,
  414. DW_OP_reg18 := $62,DW_OP_reg19 := $63,
  415. DW_OP_reg20 := $64,DW_OP_reg21 := $65,
  416. DW_OP_reg22 := $66,DW_OP_reg23 := $67,
  417. DW_OP_reg24 := $68,DW_OP_reg25 := $69,
  418. DW_OP_reg26 := $6a,DW_OP_reg27 := $6b,
  419. DW_OP_reg28 := $6c,DW_OP_reg29 := $6d,
  420. DW_OP_reg30 := $6e,DW_OP_reg31 := $6f,
  421. DW_OP_breg0 := $70,DW_OP_breg1 := $71,
  422. DW_OP_breg2 := $72,DW_OP_breg3 := $73,
  423. DW_OP_breg4 := $74,DW_OP_breg5 := $75,
  424. DW_OP_breg6 := $76,DW_OP_breg7 := $77,
  425. DW_OP_breg8 := $78,DW_OP_breg9 := $79,
  426. DW_OP_breg10 := $7a,DW_OP_breg11 := $7b,
  427. DW_OP_breg12 := $7c,DW_OP_breg13 := $7d,
  428. DW_OP_breg14 := $7e,DW_OP_breg15 := $7f,
  429. DW_OP_breg16 := $80,DW_OP_breg17 := $81,
  430. DW_OP_breg18 := $82,DW_OP_breg19 := $83,
  431. DW_OP_breg20 := $84,DW_OP_breg21 := $85,
  432. DW_OP_breg22 := $86,DW_OP_breg23 := $87,
  433. DW_OP_breg24 := $88,DW_OP_breg25 := $89,
  434. DW_OP_breg26 := $8a,DW_OP_breg27 := $8b,
  435. DW_OP_breg28 := $8c,DW_OP_breg29 := $8d,
  436. DW_OP_breg30 := $8e,DW_OP_breg31 := $8f,
  437. DW_OP_regx := $90,DW_OP_fbreg := $91,DW_OP_bregx := $92,
  438. DW_OP_piece := $93,DW_OP_deref_size := $94,
  439. DW_OP_xderef_size := $95,DW_OP_nop := $96,
  440. { DWARF 3 extensions. }
  441. DW_OP_push_object_address := $97,DW_OP_call2 := $98,
  442. DW_OP_call4 := $99,DW_OP_call_ref := $9a,
  443. { GNU extensions. }
  444. DW_OP_GNU_push_tls_address := $e0,
  445. { HP extensions. }
  446. DW_OP_HP_unknown := $e0,
  447. DW_OP_HP_is_value := $e1,DW_OP_HP_fltconst4 := $e2,
  448. DW_OP_HP_fltconst8 := $e3,DW_OP_HP_mod_range := $e4,
  449. DW_OP_HP_unmod_range := $e5,DW_OP_HP_tls := $e6
  450. );
  451. {$notes on}
  452. const
  453. { Implementation-defined range start. }
  454. DW_OP_lo_user = $e0;
  455. { Implementation-defined range end. }
  456. DW_OP_hi_user = $ff;
  457. const
  458. DW_LNS_extended_op = $00;
  459. { next copied from cfidwarf, need to go to something shared }
  460. DW_LNS_copy = $01;
  461. DW_LNS_advance_pc = $02;
  462. DW_LNS_advance_line = $03;
  463. DW_LNS_set_file = $04;
  464. DW_LNS_set_column = $05;
  465. DW_LNS_negate_stmt = $06;
  466. DW_LNS_set_basic_block = $07;
  467. DW_LNS_const_add_pc = $08;
  468. DW_LNS_fixed_advance_pc = $09;
  469. DW_LNS_set_prologue_end = $0a;
  470. DW_LNS_set_epilogue_begin = $0b;
  471. DW_LNS_set_isa = $0c;
  472. DW_LNE_end_sequence = $01;
  473. DW_LNE_set_address = $02;
  474. DW_LNE_define_file = $03;
  475. DW_LNE_lo_user = $80;
  476. DW_LNE_hi_user = $ff;
  477. type
  478. { TDirIndexItem }
  479. TDirIndexItem = class(TFPHashObject)
  480. private
  481. FFiles: TFPHashObjectList;
  482. public
  483. IndexNr : Integer;
  484. constructor Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
  485. destructor Destroy;override;
  486. property Files: TFPHashObjectList read FFiles;
  487. end;
  488. { TFileIndexItem }
  489. TFileIndexItem = class(TFPHashObject)
  490. private
  491. FDirIndex: Integer;
  492. public
  493. IndexNr : Integer;
  494. constructor Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
  495. property DirIndex: Integer read FDirIndex;
  496. end;
  497. {****************************************************************************
  498. procs
  499. ****************************************************************************}
  500. function DirListSortCompare(AItem1, AItem2: Pointer): Integer;
  501. begin
  502. Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr;
  503. end;
  504. function FileListSortCompare(AItem1, AItem2: Pointer): Integer;
  505. begin
  506. Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr;
  507. end;
  508. {****************************************************************************
  509. TDirIndexItem
  510. ****************************************************************************}
  511. constructor TDirIndexItem.Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
  512. begin
  513. inherited Create(AList,AName);
  514. FFiles := TFPHashObjectList.Create;
  515. IndexNr := AIndex;
  516. end;
  517. destructor TDirIndexItem.Destroy;
  518. begin
  519. FFiles.Free;
  520. inherited Destroy;
  521. end;
  522. {****************************************************************************
  523. TFileIndexItem
  524. ****************************************************************************}
  525. constructor TFileIndexItem.Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
  526. begin
  527. inherited Create(AList,Aname);
  528. FDirIndex := ADirIndex;
  529. IndexNr := AIndex;
  530. end;
  531. {****************************************************************************
  532. TDebugInfoDwarf
  533. ****************************************************************************}
  534. function TDebugInfoDwarf.relative_dwarf_path(const s:tcmdstr):tcmdstr;
  535. begin
  536. { Make a clean path for gdb. Remove trailing / and ./ prefixes and
  537. use always a / }
  538. result:=BsToSlash(ExcludeTrailingPathDelimiter(ExtractRelativePath(GetCurrentDir,FixFileName(ExpandFileName(s)))));
  539. end;
  540. procedure TDebugInfoDwarf.set_use_64bit_headers(state: boolean);
  541. begin
  542. _use_64bit_headers:=state;
  543. if not(state) then
  544. begin
  545. if (target_info.system in system_windows+system_wince) then
  546. offsetabstype:=aitconst_secrel32_symbol
  547. else
  548. offsetabstype:=aitconst_32bit;
  549. if (target_info.system in systems_darwin) then
  550. offsetreltype:=aitconst_darwin_dwarf_delta32
  551. else
  552. offsetreltype:=aitconst_32bit;
  553. end
  554. else
  555. begin
  556. if (target_info.system in systems_darwin) then
  557. offsetreltype:=aitconst_darwin_dwarf_delta64
  558. else
  559. offsetreltype:=aitconst_64bit;
  560. offsetabstype:=aitconst_64bit;
  561. end;
  562. end;
  563. procedure TDebugInfoDwarf.set_def_dwarf_labs(def:tdef);
  564. begin
  565. { Keep track of used dwarf entries, this info is only usefull for dwarf entries
  566. referenced by the symbols. Definitions will always include all
  567. required stabs }
  568. if def.dbg_state=dbg_state_unused then
  569. def.dbg_state:=dbg_state_used;
  570. { Need a new label? }
  571. if not assigned(def.dwarf_lab) then
  572. begin
  573. if not(tf_dwarf_only_local_labels in target_info.flags) then
  574. begin
  575. if (ds_dwarf_dbg_info_written in def.defstates) then
  576. begin
  577. if not assigned(def.typesym) then
  578. internalerror(200610011);
  579. def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)));
  580. def.dwarf_ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym)));
  581. if is_class_or_interface_or_dispinterface(def) then
  582. tobjectdef(def).dwarf_struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym)));
  583. def.dbg_state:=dbg_state_written;
  584. end
  585. else
  586. begin
  587. { Create an exported DBG symbol if we are generating a def defined in the
  588. globalsymtable of the current unit }
  589. if assigned(def.typesym) and
  590. (def.owner.symtabletype=globalsymtable) and
  591. (def.owner.iscurrentunit) then
  592. begin
  593. def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
  594. def.dwarf_ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
  595. if is_class_or_interface_or_dispinterface(def) then
  596. tobjectdef(def).dwarf_struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA);
  597. include(def.defstates,ds_dwarf_dbg_info_written);
  598. end
  599. else
  600. begin
  601. { The pointer typecast is needed to prevent a problem with range checking
  602. on when the typecast is changed to 'as' }
  603. current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_lab)));
  604. current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
  605. if is_class_or_interface_or_dispinterface(def) then
  606. current_asmdata.getdatalabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
  607. end;
  608. end;
  609. end
  610. else
  611. begin
  612. { The pointer typecast is needed to prevent a problem with range checking
  613. on when the typecast is changed to 'as' }
  614. { addrlabel instead of datalabel because it must be a local one }
  615. current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_lab)));
  616. current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
  617. if is_class_or_interface_or_dispinterface(def) then
  618. current_asmdata.getaddrlabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
  619. end;
  620. if def.dbg_state=dbg_state_used then
  621. deftowritelist.Add(def);
  622. defnumberlist.Add(def);
  623. end;
  624. end;
  625. function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol;
  626. begin
  627. set_def_dwarf_labs(def);
  628. result:=def.dwarf_lab;
  629. end;
  630. function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tobjectdef): tasmsymbol;
  631. begin
  632. set_def_dwarf_labs(def);
  633. result:=def.dwarf_struct_lab;
  634. end;
  635. function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol;
  636. begin
  637. set_def_dwarf_labs(def);
  638. result:=def.dwarf_ref_lab;
  639. end;
  640. constructor TDebugInfoDwarf.Create;
  641. begin
  642. inherited Create;
  643. { 64bit headers are only supported for dwarf3 and up, so default off }
  644. use_64bit_headers := false;
  645. { we haven't generated any lineinfo yet }
  646. generated_lineinfo := false;
  647. dirlist := TFPHashObjectList.Create;
  648. { add current dir as first item (index=0) }
  649. TDirIndexItem.Create(dirlist,'.', 0);
  650. asmline := TAsmList.create;
  651. loclist := tdynamicarray.Create(4096);
  652. end;
  653. destructor TDebugInfoDwarf.Destroy;
  654. begin
  655. dirlist.Free;
  656. dirlist := nil;
  657. asmline.free;
  658. asmline:=nil;
  659. loclist.Free;
  660. loclist := nil;
  661. inherited Destroy;
  662. end;
  663. procedure TDebugInfoDwarf.enum_membersyms_callback(p:TObject; arg: pointer);
  664. begin
  665. case tsym(p).typ of
  666. fieldvarsym:
  667. appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
  668. propertysym:
  669. appendsym_property(TAsmList(arg),tpropertysym(p));
  670. end;
  671. end;
  672. function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer;
  673. var
  674. dirname: String;
  675. diritem: TDirIndexItem;
  676. diridx: Integer;
  677. fileitem: TFileIndexItem;
  678. begin
  679. if afile.path^ = '' then
  680. dirname := '.'
  681. else
  682. begin
  683. { add the canonical form here already to avoid problems with }
  684. { paths such as './' etc }
  685. dirname := relative_dwarf_path(afile.path^);
  686. if dirname = '' then
  687. dirname := '.';
  688. end;
  689. diritem := TDirIndexItem(dirlist.Find(dirname));
  690. if diritem = nil then
  691. diritem := TDirIndexItem.Create(dirlist,dirname, dirlist.Count);
  692. diridx := diritem.IndexNr;
  693. fileitem := TFileIndexItem(diritem.files.Find(afile.name^));
  694. if fileitem = nil then
  695. begin
  696. Inc(filesequence);
  697. fileitem := TFileIndexItem.Create(diritem.files,afile.name^, diridx, filesequence);
  698. end;
  699. Result := fileitem.IndexNr;
  700. end;
  701. procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
  702. begin
  703. if length(values)<>1 then
  704. internalerror(2009040402);
  705. append_attribute(attr,form,values[0]);
  706. end;
  707. procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
  708. begin
  709. { attribute }
  710. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(cardinal(attr)));
  711. { form }
  712. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(cardinal(form)));
  713. { info itself }
  714. case form of
  715. DW_FORM_string:
  716. case value.VType of
  717. vtChar:
  718. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VChar));
  719. vtString:
  720. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VString^));
  721. vtAnsistring:
  722. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(Ansistring(value.VAnsiString)));
  723. else
  724. internalerror(200601264);
  725. end;
  726. DW_FORM_flag:
  727. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(value.VBoolean)));
  728. DW_FORM_data1:
  729. case value.VType of
  730. vtInteger:
  731. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger));
  732. vtInt64:
  733. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^));
  734. vtQWord:
  735. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^));
  736. else
  737. internalerror(200602143);
  738. end;
  739. DW_FORM_data2:
  740. case value.VType of
  741. vtInteger:
  742. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VInteger));
  743. vtInt64:
  744. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VInt64^));
  745. vtQWord:
  746. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VQWord^));
  747. else
  748. internalerror(200602144);
  749. end;
  750. DW_FORM_data4:
  751. case value.VType of
  752. vtInteger:
  753. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VInteger));
  754. vtInt64:
  755. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VInt64^));
  756. vtQWord:
  757. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VQWord^));
  758. else
  759. internalerror(200602145);
  760. end;
  761. DW_FORM_data8:
  762. case value.VType of
  763. vtInteger:
  764. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VInteger));
  765. vtInt64:
  766. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VInt64^));
  767. vtQWord:
  768. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VQWord^));
  769. else
  770. internalerror(200602146);
  771. end;
  772. DW_FORM_sdata:
  773. case value.VType of
  774. vtInteger:
  775. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInteger));
  776. vtInt64:
  777. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInt64^));
  778. vtQWord:
  779. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VQWord^));
  780. else
  781. internalerror(200601285);
  782. end;
  783. DW_FORM_udata:
  784. case value.VType of
  785. vtInteger:
  786. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInteger));
  787. vtInt64:
  788. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInt64^));
  789. vtQWord:
  790. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VQWord^));
  791. else
  792. internalerror(200601284);
  793. end;
  794. { block gets only the size, the rest is appended manually by the caller }
  795. DW_FORM_block1:
  796. case value.VType of
  797. vtInteger:
  798. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger));
  799. vtInt64:
  800. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^));
  801. vtQWord:
  802. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^));
  803. else
  804. internalerror(200602141);
  805. end;
  806. else
  807. internalerror(200601263);
  808. end;
  809. end;
  810. { writing the data through a few simply procedures allows to create easily extra information
  811. for debugging of debug info }
  812. procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  813. var
  814. i : longint;
  815. begin
  816. { todo: store defined abbrevs, so you have to define tehm only once (for this unit) (MWE) }
  817. inc(currabbrevnumber);
  818. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber))));
  819. { abbrev number }
  820. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(currabbrevnumber));
  821. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber));
  822. { tag }
  823. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(tag)));
  824. { children? }
  825. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(ord(has_children)));
  826. i:=0;
  827. while i<=high(data) do
  828. begin
  829. if (i+2 > high(data)) then
  830. internalerror(2009040401);
  831. if data[i].VType<>vtInteger then
  832. internalerror(200601261);
  833. if data[i+1].VType<>vtInteger then
  834. internalerror(200601261);
  835. append_attribute(tdwarf_attribute(data[i].VInteger),tdwarf_form(data[i+1].VInteger),data[i+2]);
  836. inc(i,3);
  837. end;
  838. end;
  839. procedure TDebugInfoDwarf.append_block1(attr: tdwarf_attribute; size: aint);
  840. begin
  841. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  842. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_block1)));
  843. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(size));
  844. end;
  845. procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  846. begin
  847. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  848. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_addr)));
  849. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym));
  850. end;
  851. procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  852. begin
  853. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  854. if not(tf_dwarf_only_local_labels in target_info.flags) then
  855. begin
  856. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_ref_addr)));
  857. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym))
  858. end
  859. else
  860. begin
  861. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_ref4)));
  862. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_info0'),sym));
  863. end;
  864. end;
  865. procedure TDebugInfoDwarf.append_labelentry_dataptr_common(attr : tdwarf_attribute);
  866. begin
  867. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(attr)));
  868. if use_64bit_headers then
  869. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)))
  870. else
  871. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  872. end;
  873. procedure TDebugInfoDwarf.append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
  874. begin
  875. {
  876. used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
  877. The size of these depend on the header format
  878. Must be relative to another symbol on tf_dwarf_relative_addresses
  879. targets
  880. }
  881. if (tf_dwarf_relative_addresses in target_info.flags) then
  882. { use append_labelentry_dataptr_rel instead }
  883. internalerror(2007020210);
  884. append_labelentry_dataptr_common(attr);
  885. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,sym))
  886. end;
  887. procedure TDebugInfoDwarf.append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
  888. begin
  889. {
  890. used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
  891. The size of these depend on the header format
  892. Must be relative to another symbol on tf_dwarf_relative_addresses
  893. targets
  894. }
  895. append_labelentry_dataptr_common(attr);
  896. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,sym,endsym));
  897. end;
  898. procedure TDebugInfoDwarf.finish_entry;
  899. begin
  900. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  901. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  902. end;
  903. procedure TDebugInfoDwarf.finish_children;
  904. begin
  905. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  906. end;
  907. procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef);
  908. var
  909. basedef : tdef;
  910. sign : tdwarf_type;
  911. signform : tdwarf_form;
  912. fullbytesize : byte;
  913. begin
  914. case def.ordtype of
  915. s8bit,
  916. s16bit,
  917. s32bit,
  918. u8bit,
  919. u16bit,
  920. u32bit :
  921. begin
  922. { generate proper signed/unsigned info for types like 0..3 }
  923. { these are s8bit, but should be identified as unsigned }
  924. { because otherwise they are interpreted wrongly when used }
  925. { in a bitpacked record }
  926. if (def.low<0) then
  927. begin
  928. sign:=DW_ATE_signed;
  929. signform:=DW_FORM_sdata
  930. end
  931. else
  932. begin
  933. sign:=DW_ATE_unsigned;
  934. signform:=DW_FORM_udata
  935. end;
  936. fullbytesize:=def.size;
  937. case fullbytesize of
  938. 1:
  939. if (sign=DW_ATE_signed) then
  940. basedef:=s8inttype
  941. else
  942. basedef:=u8inttype;
  943. 2:
  944. if (sign=DW_ATE_signed) then
  945. basedef:=s16inttype
  946. else
  947. basedef:=u16inttype;
  948. 4:
  949. if (sign=DW_ATE_signed) then
  950. basedef:=s32inttype
  951. else
  952. basedef:=u32inttype;
  953. else
  954. internalerror(2008032201);
  955. end;
  956. if (def.low=torddef(basedef).low) and
  957. (def.high=torddef(basedef).high) then
  958. { base type such as byte/shortint/word/... }
  959. if assigned(def.typesym) then
  960. append_entry(DW_TAG_base_type,false,[
  961. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  962. DW_AT_encoding,DW_FORM_data1,sign,
  963. DW_AT_byte_size,DW_FORM_data1,fullbytesize])
  964. else
  965. append_entry(DW_TAG_base_type,false,[
  966. DW_AT_encoding,DW_FORM_data1,sign,
  967. DW_AT_byte_size,DW_FORM_data1,fullbytesize])
  968. else
  969. begin
  970. { subrange type }
  971. { note: don't do this 64 bit int types, they appear }
  972. { to be always clipped to s32bit for some reason }
  973. if assigned(def.typesym) then
  974. append_entry(DW_TAG_subrange_type,false,[
  975. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  976. DW_AT_lower_bound,signform,int64(def.low),
  977. DW_AT_upper_bound,signform,int64(def.high)
  978. ])
  979. else
  980. append_entry(DW_TAG_subrange_type,false,[
  981. DW_AT_lower_bound,signform,int64(def.low),
  982. DW_AT_upper_bound,signform,int64(def.high)
  983. ]);
  984. append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef));
  985. end;
  986. finish_entry;
  987. end;
  988. uvoid :
  989. begin
  990. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  991. replace it with a unsigned type with size 0 (FK)
  992. }
  993. append_entry(DW_TAG_base_type,false,[
  994. DW_AT_name,DW_FORM_string,'Void'#0,
  995. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  996. DW_AT_byte_size,DW_FORM_data1,0
  997. ]);
  998. finish_entry;
  999. end;
  1000. uchar :
  1001. begin
  1002. append_entry(DW_TAG_base_type,false,[
  1003. DW_AT_name,DW_FORM_string,'Char'#0,
  1004. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  1005. DW_AT_byte_size,DW_FORM_data1,1
  1006. ]);
  1007. finish_entry;
  1008. end;
  1009. uwidechar :
  1010. begin
  1011. append_entry(DW_TAG_base_type,false,[
  1012. DW_AT_name,DW_FORM_string,'WideChar'#0,
  1013. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  1014. DW_AT_byte_size,DW_FORM_data1,2
  1015. ]);
  1016. finish_entry;
  1017. end;
  1018. pasbool,
  1019. bool8bit :
  1020. begin
  1021. append_entry(DW_TAG_base_type,false,[
  1022. DW_AT_name,DW_FORM_string,'Boolean'#0,
  1023. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1024. DW_AT_byte_size,DW_FORM_data1,1
  1025. ]);
  1026. finish_entry;
  1027. end;
  1028. bool16bit :
  1029. begin
  1030. append_entry(DW_TAG_base_type,false,[
  1031. DW_AT_name,DW_FORM_string,'WordBool'#0,
  1032. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1033. DW_AT_byte_size,DW_FORM_data1,2
  1034. ]);
  1035. finish_entry;
  1036. end;
  1037. bool32bit :
  1038. begin
  1039. append_entry(DW_TAG_base_type,false,[
  1040. DW_AT_name,DW_FORM_string,'LongBool'#0,
  1041. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1042. DW_AT_byte_size,DW_FORM_data1,4
  1043. ]);
  1044. finish_entry;
  1045. end;
  1046. bool64bit :
  1047. begin
  1048. append_entry(DW_TAG_base_type,false,[
  1049. DW_AT_name,DW_FORM_string,'QWordBool'#0,
  1050. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1051. DW_AT_byte_size,DW_FORM_data1,8
  1052. ]);
  1053. finish_entry;
  1054. end;
  1055. u64bit :
  1056. begin
  1057. append_entry(DW_TAG_base_type,false,[
  1058. DW_AT_name,DW_FORM_string,'QWord'#0,
  1059. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  1060. DW_AT_byte_size,DW_FORM_data1,8
  1061. ]);
  1062. finish_entry;
  1063. end;
  1064. scurrency :
  1065. begin
  1066. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  1067. append_entry(DW_TAG_base_type,false,[
  1068. DW_AT_name,DW_FORM_string,'Currency'#0,
  1069. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1070. DW_AT_byte_size,DW_FORM_data1,8
  1071. ]);
  1072. finish_entry;
  1073. end;
  1074. s64bit :
  1075. begin
  1076. append_entry(DW_TAG_base_type,false,[
  1077. DW_AT_name,DW_FORM_string,'Int64'#0,
  1078. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1079. DW_AT_byte_size,DW_FORM_data1,8
  1080. ]);
  1081. finish_entry;
  1082. end;
  1083. else
  1084. internalerror(200601287);
  1085. end;
  1086. end;
  1087. procedure TDebugInfoDwarf.appenddef_float(list:TAsmList;def:tfloatdef);
  1088. begin
  1089. case def.floattype of
  1090. s32real,
  1091. s64real,
  1092. s80real:
  1093. if assigned(def.typesym) then
  1094. append_entry(DW_TAG_base_type,false,[
  1095. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1096. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  1097. DW_AT_byte_size,DW_FORM_data1,def.size
  1098. ])
  1099. else
  1100. append_entry(DW_TAG_base_type,false,[
  1101. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  1102. DW_AT_byte_size,DW_FORM_data1,def.size
  1103. ]);
  1104. s64currency:
  1105. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  1106. if assigned(def.typesym) then
  1107. append_entry(DW_TAG_base_type,false,[
  1108. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1109. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1110. DW_AT_byte_size,DW_FORM_data1,8
  1111. ])
  1112. else
  1113. append_entry(DW_TAG_base_type,false,[
  1114. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1115. DW_AT_byte_size,DW_FORM_data1,8
  1116. ]);
  1117. s64comp:
  1118. if assigned(def.typesym) then
  1119. append_entry(DW_TAG_base_type,false,[
  1120. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1121. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1122. DW_AT_byte_size,DW_FORM_data1,8
  1123. ])
  1124. else
  1125. append_entry(DW_TAG_base_type,false,[
  1126. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1127. DW_AT_byte_size,DW_FORM_data1,8
  1128. ]);
  1129. else
  1130. internalerror(200601289);
  1131. end;
  1132. finish_entry;
  1133. end;
  1134. procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef);
  1135. var
  1136. hp : tenumsym;
  1137. begin
  1138. if assigned(def.typesym) then
  1139. append_entry(DW_TAG_enumeration_type,true,[
  1140. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1141. DW_AT_byte_size,DW_FORM_data1,def.size
  1142. ])
  1143. else
  1144. append_entry(DW_TAG_enumeration_type,true,[
  1145. DW_AT_byte_size,DW_FORM_data1,def.size
  1146. ]);
  1147. if assigned(def.basedef) then
  1148. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef));
  1149. finish_entry;
  1150. { write enum symbols }
  1151. hp:=tenumsym(def.firstenum);
  1152. while assigned(hp) do
  1153. begin
  1154. append_entry(DW_TAG_enumerator,false,[
  1155. DW_AT_name,DW_FORM_string,symname(hp)+#0,
  1156. DW_AT_const_value,DW_FORM_data4,hp.value
  1157. ]);
  1158. finish_entry;
  1159. hp:=tenumsym(hp).nextenum;
  1160. end;
  1161. finish_children;
  1162. end;
  1163. procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef);
  1164. var
  1165. size : aint;
  1166. elesize : aint;
  1167. elestrideattr : tdwarf_attribute;
  1168. labsym: tasmlabel;
  1169. begin
  1170. if is_dynamic_array(def) then
  1171. begin
  1172. { It's a pointer to the actual array }
  1173. current_asmdata.getaddrlabel(labsym);
  1174. append_entry(DW_TAG_pointer_type,false,[]);
  1175. append_labelentry_ref(DW_AT_type,labsym);
  1176. finish_entry;
  1177. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1178. end;
  1179. if not is_packed_array(def) then
  1180. begin
  1181. elestrideattr := DW_AT_byte_stride;
  1182. elesize := def.elesize;
  1183. end
  1184. else
  1185. begin
  1186. elestrideattr := DW_AT_stride_size;
  1187. elesize := def.elepackedbitsize;
  1188. end;
  1189. if is_special_array(def) then
  1190. begin
  1191. { no known size, no known upper bound }
  1192. if assigned(def.typesym) then
  1193. append_entry(DW_TAG_array_type,true,[
  1194. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1195. elestrideattr,DW_FORM_udata,elesize
  1196. ])
  1197. else
  1198. append_entry(DW_TAG_array_type,true,[
  1199. elestrideattr,DW_FORM_udata,elesize
  1200. ]);
  1201. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  1202. finish_entry;
  1203. { a missing upper bound means "unknown"/default }
  1204. append_entry(DW_TAG_subrange_type,false,[
  1205. DW_AT_lower_bound,DW_FORM_sdata,def.lowrange
  1206. ]);
  1207. end
  1208. else
  1209. begin
  1210. size:=def.size;
  1211. if assigned(def.typesym) then
  1212. append_entry(DW_TAG_array_type,true,[
  1213. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1214. DW_AT_byte_size,DW_FORM_udata,size,
  1215. elestrideattr,DW_FORM_udata,elesize
  1216. ])
  1217. else
  1218. append_entry(DW_TAG_array_type,true,[
  1219. DW_AT_byte_size,DW_FORM_udata,size,
  1220. elestrideattr,DW_FORM_udata,elesize
  1221. ]);
  1222. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  1223. finish_entry;
  1224. { to simplify things, we don't write a multidimensional array here }
  1225. append_entry(DW_TAG_subrange_type,false,[
  1226. DW_AT_lower_bound,DW_FORM_sdata,def.lowrange,
  1227. DW_AT_upper_bound,DW_FORM_sdata,def.highrange
  1228. ]);
  1229. end;
  1230. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
  1231. finish_entry;
  1232. finish_children;
  1233. end;
  1234. procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef);
  1235. begin
  1236. if assigned(def.typesym) then
  1237. append_entry(DW_TAG_structure_type,true,[
  1238. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1239. DW_AT_byte_size,DW_FORM_udata,def.size
  1240. ])
  1241. else
  1242. append_entry(DW_TAG_structure_type,true,[
  1243. DW_AT_byte_size,DW_FORM_udata,def.size
  1244. ]);
  1245. finish_entry;
  1246. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  1247. finish_children;
  1248. end;
  1249. procedure TDebugInfoDwarf.appenddef_pointer(list:TAsmList;def:tpointerdef);
  1250. begin
  1251. append_entry(DW_TAG_pointer_type,false,[]);
  1252. if not(is_voidpointer(def)) then
  1253. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointeddef));
  1254. finish_entry;
  1255. end;
  1256. procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef);
  1257. procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: aword);
  1258. var
  1259. { maxlen can be > high(int64) }
  1260. slen : aword;
  1261. arr : tasmlabel;
  1262. begin
  1263. { fix length of openshortstring }
  1264. slen:=aword(def.len);
  1265. if slen=0 then
  1266. slen:=maxlen;
  1267. { create a structure with two elements }
  1268. if not(tf_dwarf_only_local_labels in target_info.flags) then
  1269. current_asmdata.getdatalabel(arr)
  1270. else
  1271. current_asmdata.getaddrlabel(arr);
  1272. append_entry(DW_TAG_structure_type,true,[
  1273. DW_AT_name,DW_FORM_string,name+#0,
  1274. DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint)
  1275. ]);
  1276. finish_entry;
  1277. { length entry }
  1278. append_entry(DW_TAG_member,false,[
  1279. DW_AT_name,DW_FORM_string,'length'#0,
  1280. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1281. ]);
  1282. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1283. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  1284. append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
  1285. finish_entry;
  1286. { string data entry }
  1287. append_entry(DW_TAG_member,false,[
  1288. DW_AT_name,DW_FORM_string,'st'#0,
  1289. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1)
  1290. ]);
  1291. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1292. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(lendef.size));
  1293. append_labelentry_ref(DW_AT_type,arr);
  1294. finish_entry;
  1295. finish_children;
  1296. { now the data array }
  1297. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
  1298. append_entry(DW_TAG_array_type,true,[
  1299. DW_AT_byte_size,DW_FORM_udata,def.size,
  1300. DW_AT_byte_stride,DW_FORM_udata,1
  1301. ]);
  1302. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype));
  1303. finish_entry;
  1304. append_entry(DW_TAG_subrange_type,false,[
  1305. DW_AT_lower_bound,DW_FORM_udata,0,
  1306. DW_AT_upper_bound,DW_FORM_udata,qword(slen)
  1307. ]);
  1308. append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
  1309. finish_entry;
  1310. finish_children;
  1311. end;
  1312. begin
  1313. case def.stringtype of
  1314. st_shortstring:
  1315. begin
  1316. addnormalstringdef('ShortString',u8inttype,255);
  1317. end;
  1318. st_longstring:
  1319. begin
  1320. {$ifdef cpu64bitaddr}
  1321. addnormalstringdef('LongString',u64inttype,qword(-1));
  1322. {$else cpu64bitaddr}
  1323. addnormalstringdef('LongString',u32inttype,cardinal(-1));
  1324. {$endif cpu64bitaddr}
  1325. end;
  1326. st_ansistring:
  1327. begin
  1328. { looks like a pchar }
  1329. append_entry(DW_TAG_pointer_type,false,[]);
  1330. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype));
  1331. finish_entry;
  1332. end;
  1333. st_unicodestring,
  1334. st_widestring:
  1335. begin
  1336. { looks like a pwidechar }
  1337. append_entry(DW_TAG_pointer_type,false,[]);
  1338. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype));
  1339. finish_entry;
  1340. end;
  1341. end;
  1342. end;
  1343. procedure TDebugInfoDwarf.appenddef_procvar(list:TAsmList;def:tprocvardef);
  1344. procedure doappend;
  1345. var
  1346. i : longint;
  1347. begin
  1348. if assigned(def.typesym) then
  1349. append_entry(DW_TAG_subroutine_type,true,[
  1350. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  1351. DW_AT_prototyped,DW_FORM_flag,true
  1352. ])
  1353. else
  1354. append_entry(DW_TAG_subroutine_type,true,[
  1355. DW_AT_prototyped,DW_FORM_flag,true
  1356. ]);
  1357. if not(is_void(tprocvardef(def).returndef)) then
  1358. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef));
  1359. finish_entry;
  1360. { write parameters }
  1361. for i:=0 to def.paras.count-1 do
  1362. begin
  1363. append_entry(DW_TAG_formal_parameter,false,[
  1364. DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]))+#0
  1365. ]);
  1366. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
  1367. finish_entry;
  1368. end;
  1369. finish_children;
  1370. end;
  1371. var
  1372. proc : tasmlabel;
  1373. begin
  1374. if def.is_methodpointer then
  1375. begin
  1376. { create a structure with two elements }
  1377. if not(tf_dwarf_only_local_labels in target_info.flags) then
  1378. current_asmdata.getdatalabel(proc)
  1379. else
  1380. current_asmdata.getaddrlabel(proc);
  1381. append_entry(DW_TAG_structure_type,true,[
  1382. DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint)
  1383. ]);
  1384. finish_entry;
  1385. { proc entry }
  1386. append_entry(DW_TAG_member,false,[
  1387. DW_AT_name,DW_FORM_string,'Proc'#0,
  1388. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1389. ]);
  1390. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1391. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  1392. append_labelentry_ref(DW_AT_type,proc);
  1393. finish_entry;
  1394. { self entry }
  1395. append_entry(DW_TAG_member,false,[
  1396. DW_AT_name,DW_FORM_string,'Self'#0,
  1397. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(pint))
  1398. ]);
  1399. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1400. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sizeof(pint)));
  1401. append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject));
  1402. finish_entry;
  1403. finish_children;
  1404. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
  1405. doappend;
  1406. end
  1407. else
  1408. doappend;
  1409. end;
  1410. procedure TDebugInfoDwarf.beforeappenddef(list:TAsmList;def:tdef);
  1411. var
  1412. labsym : tasmsymbol;
  1413. begin
  1414. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
  1415. labsym:=def_dwarf_lab(def);
  1416. if ds_dwarf_dbg_info_written in def.defstates then
  1417. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
  1418. else
  1419. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1420. if (target_info.system in systems_darwin) then
  1421. begin
  1422. { On Darwin, dwarf info is not linked in the final binary,
  1423. but kept in the individual object files. This allows for
  1424. faster linking, but means that you have to keep the object
  1425. files for debugging and also that gdb only loads in the
  1426. debug info of a particular object file once you step into
  1427. or over a procedure in it.
  1428. To solve this, there is a tool called dsymutil which can
  1429. extract all the dwarf info from a program's object files.
  1430. This utility however performs "smart linking" on the dwarf
  1431. info and throws away all unreferenced dwarf entries. Since
  1432. variables' types always point to the dwarfino for a tdef
  1433. and never to that for a typesym, this means all debug
  1434. entries generated for typesyms are thrown away.
  1435. The problem with that is that we translate typesyms into
  1436. DW_TAG_typedef, and gdb's dwarf-2 reader only makes types
  1437. globally visibly if they are defined using a DW_TAG_typedef.
  1438. So as a result, before running dsymutil types only become
  1439. available once you stepped into/over a function in the object
  1440. file where they are declared, and after running dsymutil they
  1441. are all gone (printng variables still works because the
  1442. tdef dwarf info is still available, but you cannot typecast
  1443. anything outside the declaring units because the type names
  1444. are not known there).
  1445. The solution: if a tdef has an associated typesym, let the
  1446. debug label for the tdef point to a DW_TAG_typedef instead
  1447. of directly to the tdef itself. And don't write anything
  1448. special for the typesym itself.
  1449. }
  1450. if assigned(def.typesym) and
  1451. not(df_generic in def.defoptions) then
  1452. begin
  1453. current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
  1454. append_entry(DW_TAG_typedef,false,[
  1455. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
  1456. ]);
  1457. append_labelentry_ref(DW_AT_type,labsym);
  1458. finish_entry;
  1459. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1460. end;
  1461. end;
  1462. end;
  1463. procedure TDebugInfoDwarf.afterappenddef(list:TAsmList;def:tdef);
  1464. var
  1465. labsym : tasmsymbol;
  1466. begin
  1467. { create a derived reference type for pass-by-reference parameters }
  1468. { (gdb doesn't support DW_AT_variable_parameter yet) }
  1469. labsym:=def_dwarf_ref_lab(def);
  1470. if ds_dwarf_dbg_info_written in def.defstates then
  1471. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
  1472. else
  1473. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1474. append_entry(DW_TAG_reference_type,false,[]);
  1475. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1476. finish_entry;
  1477. end;
  1478. procedure TDebugInfoDwarf.appendprocdef(list:TAsmList; def:tprocdef);
  1479. function dwarf_calling_convention(def: tprocdef): Tdwarf_calling_convention;
  1480. begin
  1481. case def.proccalloption of
  1482. pocall_register:
  1483. result:=DW_CC_GNU_borland_fastcall_i386;
  1484. pocall_cdecl,
  1485. pocall_stdcall,
  1486. pocall_cppdecl,
  1487. pocall_mwpascal:
  1488. result:=DW_CC_normal;
  1489. else
  1490. result:=DW_CC_nocall;
  1491. end
  1492. end;
  1493. var
  1494. procendlabel : tasmlabel;
  1495. procentry : string;
  1496. cc : Tdwarf_calling_convention;
  1497. st : tsymtable;
  1498. i : longint;
  1499. vmtindexnr : pint;
  1500. begin
  1501. if not assigned(def.procstarttai) then
  1502. exit;
  1503. { Procdefs are not handled by the regular def writing code, so
  1504. dbg_state is not set/checked for them. Do it here. }
  1505. if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
  1506. exit;
  1507. { Write methods and only in the scope of their parent objectdefs. }
  1508. if (def.owner.symtabletype=objectsymtable) then
  1509. begin
  1510. { this code can also work for nested procdefs, but is not yet
  1511. activated for those because there is no clear advantage yet to
  1512. limiting the scope of nested procedures to that of their parent,
  1513. and it makes it impossible to set breakpoints in them by
  1514. referring to their name. }
  1515. st:=def.owner;
  1516. while assigned(st.defowner) and
  1517. (tdef(st.defowner).typ = procdef) do
  1518. st:=tprocdef(st.defowner).owner;
  1519. if assigned(st) and
  1520. (tdef(st.defowner).dbg_state<>dbg_state_writing) then
  1521. exit;
  1522. end;
  1523. def.dbg_state:=dbg_state_writing;
  1524. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
  1525. append_entry(DW_TAG_subprogram,true,
  1526. [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0
  1527. { data continues below }
  1528. { problem: base reg isn't known here
  1529. DW_AT_frame_base,DW_FORM_block1,1
  1530. }
  1531. ]);
  1532. { Append optional flags. }
  1533. { Calling convention. }
  1534. cc:=dwarf_calling_convention(def);
  1535. if (cc<>DW_CC_normal) then
  1536. append_attribute(DW_AT_calling_convention,DW_FORM_data1,[ord(cc)]);
  1537. { Externally visible. }
  1538. if (po_global in def.procoptions) and
  1539. (def.parast.symtablelevel<=normal_function_level) then
  1540. append_attribute(DW_AT_external,DW_FORM_flag,[true]);
  1541. { Abstract or virtual/overriding method. }
  1542. if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) then
  1543. begin
  1544. if not(po_abstractmethod in def.procoptions) then
  1545. append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)])
  1546. else
  1547. append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_pure_virtual)]);
  1548. { Element number in the vmt (needs to skip stuff coming before the
  1549. actual method addresses in the vmt, so we use vmtmethodoffset()
  1550. and then divide by sizeof(pint)). }
  1551. vmtindexnr:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber) div sizeof(pint);
  1552. append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[1+LengthUleb128(vmtindexnr)]);
  1553. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_constu)));
  1554. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtindexnr));
  1555. end;
  1556. { Return type. }
  1557. if not(is_void(tprocdef(def).returndef)) then
  1558. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
  1559. { mark end of procedure }
  1560. current_asmdata.getlabel(procendlabel,alt_dbgtype);
  1561. current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
  1562. if (target_info.system = system_powerpc64_linux) then
  1563. procentry := '.' + def.mangledname
  1564. else
  1565. procentry := def.mangledname;
  1566. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
  1567. append_labelentry(DW_AT_high_pc,procendlabel);
  1568. { Don't write the funcretsym explicitly, it's also in the
  1569. localsymtable and/or parasymtable.
  1570. }
  1571. finish_entry;
  1572. if assigned(def.parast) then
  1573. begin
  1574. { First insert self, because gdb uses the fact whether or not the
  1575. first parameter of a method is artificial to distinguish static
  1576. from regular methods. }
  1577. { Find the self parameter (it's usually last in the list). }
  1578. for i:=def.parast.symlist.count-1 downto 0 do
  1579. if (tsym(def.parast.symlist[i]).typ = paravarsym) and
  1580. (vo_is_self in tparavarsym(def.parast.symlist[i]).varoptions) then
  1581. { insert it as the first one }
  1582. appendsym_var_with_name_type_offset(list,
  1583. tparavarsym(def.parast.symlist[i]),
  1584. symname(tsym(def.parast.symlist[i])),
  1585. tparavarsym(def.parast.symlist[i]).vardef,0,true);
  1586. { Now insert the rest (this will skip the self parameter). }
  1587. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.parast);
  1588. end;
  1589. { local type defs and vars should not be written
  1590. inside the main proc }
  1591. if assigned(def.localst) and
  1592. (def.localst.symtabletype=localsymtable) then
  1593. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1594. { last write the types from this procdef }
  1595. if assigned(def.parast) then
  1596. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
  1597. if assigned(def.localst) and
  1598. (def.localst.symtabletype=localsymtable) then
  1599. begin
  1600. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1601. { Write nested procedures -- disabled, see scope check at the
  1602. beginning; currently, these are still written in the global
  1603. scope. }
  1604. // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1605. end;
  1606. finish_children;
  1607. end;
  1608. function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  1609. var
  1610. elesize : pint;
  1611. currdef : tdef;
  1612. begin
  1613. result:=false;
  1614. if not assigned(symlist) then
  1615. exit;
  1616. sym:=nil;
  1617. offset:=0;
  1618. currdef:=nil;
  1619. repeat
  1620. case symlist^.sltype of
  1621. sl_load:
  1622. begin
  1623. if assigned(sym) then
  1624. internalerror(2009031203);
  1625. if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
  1626. { can't handle... }
  1627. exit;
  1628. sym:=tabstractvarsym(symlist^.sym);
  1629. currdef:=tabstractvarsym(sym).vardef;
  1630. end;
  1631. sl_subscript:
  1632. begin
  1633. if not assigned(currdef) then
  1634. internalerror(2009031301);
  1635. if (symlist^.sym.typ<>fieldvarsym) then
  1636. internalerror(2009031202);
  1637. if is_packed_record_or_object(currdef) then
  1638. begin
  1639. { can't calculate the address of a non-byte aligned field }
  1640. if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then
  1641. exit;
  1642. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8)
  1643. end
  1644. else
  1645. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset);
  1646. currdef:=tfieldvarsym(symlist^.sym).vardef;
  1647. end;
  1648. sl_absolutetype,
  1649. sl_typeconv:
  1650. begin
  1651. currdef:=tfieldvarsym(symlist^.sym).vardef;
  1652. { ignore, these don't change the address }
  1653. end;
  1654. sl_vec:
  1655. begin
  1656. if not assigned(currdef) or
  1657. (currdef.typ<>arraydef) then
  1658. internalerror(2009031201);
  1659. if not is_packed_array(currdef) then
  1660. elesize:=tarraydef(currdef).elesize
  1661. else
  1662. begin
  1663. elesize:=tarraydef(currdef).elepackedbitsize;
  1664. { can't calculate the address of a non-byte aligned element }
  1665. if (elesize mod 8)<>0 then
  1666. exit;
  1667. elesize:=elesize div 8;
  1668. end;
  1669. inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
  1670. currdef:=tarraydef(currdef).elementdef;
  1671. end;
  1672. else
  1673. internalerror(2009031401);
  1674. end;
  1675. symlist:=symlist^.next;
  1676. until not assigned(symlist);
  1677. if not assigned(sym) then
  1678. internalerror(2009031205);
  1679. result:=true;
  1680. end;
  1681. procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  1682. begin
  1683. appendsym_var_with_name_type_offset(list,sym,symname(sym),sym.vardef,0,false);
  1684. end;
  1685. procedure TDebugInfoDwarf.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; do_self: boolean);
  1686. var
  1687. templist : TAsmList;
  1688. blocksize : longint;
  1689. tag : tdwarf_tag;
  1690. dreg : byte;
  1691. begin
  1692. { external symbols can't be resolved at link time, so we
  1693. can't generate stabs for them
  1694. not sure if this applies to dwarf as well (FK)
  1695. }
  1696. if vo_is_external in sym.varoptions then
  1697. exit;
  1698. { Self must be the first inserted parameter, see
  1699. appendprocdef(). }
  1700. if not(do_self) and
  1701. (vo_is_self in sym.varoptions) then
  1702. exit;
  1703. { There is no space allocated for not referenced locals }
  1704. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  1705. exit;
  1706. templist:=TAsmList.create;
  1707. case sym.localloc.loc of
  1708. LOC_REGISTER,
  1709. LOC_CREGISTER,
  1710. LOC_MMREGISTER,
  1711. LOC_CMMREGISTER,
  1712. LOC_FPUREGISTER,
  1713. LOC_CFPUREGISTER :
  1714. begin
  1715. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1716. dreg:=dwarf_reg(sym.localloc.register);
  1717. templist.concat(tai_const.create_uleb128bit(dreg));
  1718. blocksize:=1+Lengthuleb128(dreg);
  1719. end;
  1720. else
  1721. begin
  1722. case sym.typ of
  1723. staticvarsym:
  1724. begin
  1725. if (vo_is_thread_var in sym.varoptions) then
  1726. begin
  1727. { TODO: !!! FIXME: dwarf for thread vars !!!}
  1728. blocksize:=0;
  1729. end
  1730. else
  1731. begin
  1732. templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
  1733. templist.concat(tai_const.createname(sym.mangledname,offset));
  1734. blocksize:=1+sizeof(puint);
  1735. end;
  1736. end;
  1737. paravarsym,
  1738. localvarsym:
  1739. begin
  1740. dreg:=dwarf_reg(sym.localloc.reference.base);
  1741. templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  1742. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  1743. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
  1744. end
  1745. else
  1746. internalerror(200601288);
  1747. end;
  1748. end;
  1749. end;
  1750. { function results must not be added to the parameter list,
  1751. as they are not part of the signature of the function
  1752. (gdb automatically adds them according to the ABI specifications
  1753. when calling the function)
  1754. }
  1755. if (sym.typ=paravarsym) and
  1756. not(vo_is_funcret in sym.varoptions) then
  1757. tag:=DW_TAG_formal_parameter
  1758. else
  1759. tag:=DW_TAG_variable;
  1760. if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
  1761. LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  1762. ((sym.owner.symtabletype = globalsymtable) or
  1763. (sp_static in sym.symoptions) or
  1764. (vo_is_public in sym.varoptions)) then
  1765. append_entry(tag,false,[
  1766. DW_AT_name,DW_FORM_string,name+#0,
  1767. {
  1768. DW_AT_decl_file,DW_FORM_data1,0,
  1769. DW_AT_decl_line,DW_FORM_data1,
  1770. }
  1771. DW_AT_external,DW_FORM_flag,true,
  1772. { data continues below }
  1773. DW_AT_location,DW_FORM_block1,blocksize
  1774. ])
  1775. {$ifdef gdb_supports_DW_AT_variable_parameter}
  1776. else if (sym.typ=paravarsym) and
  1777. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1778. not(vo_has_local_copy in sym.varoptions) and
  1779. not is_open_string(sym.vardef) then
  1780. append_entry(tag,false,[
  1781. DW_AT_name,DW_FORM_string,name+#0,
  1782. DW_AT_variable_parameter,DW_FORM_flag,true,
  1783. {
  1784. DW_AT_decl_file,DW_FORM_data1,0,
  1785. DW_AT_decl_line,DW_FORM_data1,
  1786. }
  1787. { data continues below }
  1788. DW_AT_location,DW_FORM_block1,blocksize
  1789. ])
  1790. {$endif gdb_supports_DW_AT_variable_parameter}
  1791. else
  1792. append_entry(tag,false,[
  1793. DW_AT_name,DW_FORM_string,name+#0,
  1794. {
  1795. DW_AT_decl_file,DW_FORM_data1,0,
  1796. DW_AT_decl_line,DW_FORM_data1,
  1797. }
  1798. { data continues below }
  1799. DW_AT_location,DW_FORM_block1,blocksize
  1800. ]);
  1801. { append block data }
  1802. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1803. { Mark self as artificial for methods, because gdb uses the fact
  1804. whether or not the first parameter of a method is artificial to
  1805. distinguish regular from static methods (since there are no
  1806. no vo_is_self parameters for static methods, we don't have to check
  1807. that). }
  1808. if (vo_is_self in sym.varoptions) then
  1809. append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
  1810. {$ifndef gdb_supports_DW_AT_variable_parameter}
  1811. if (sym.typ=paravarsym) and
  1812. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1813. not(vo_has_local_copy in sym.varoptions) and
  1814. not is_open_string(sym.vardef) then
  1815. append_labelentry_ref(DW_AT_type,def_dwarf_ref_lab(def))
  1816. else
  1817. {$endif not gdb_supports_DW_AT_variable_parameter}
  1818. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1819. templist.free;
  1820. finish_entry;
  1821. end;
  1822. procedure TDebugInfoDwarf.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  1823. begin
  1824. appendsym_var(list,sym);
  1825. end;
  1826. procedure TDebugInfoDwarf.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  1827. begin
  1828. appendsym_var(list,sym);
  1829. end;
  1830. procedure TDebugInfoDwarf.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  1831. begin
  1832. appendsym_var(list,sym);
  1833. end;
  1834. procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  1835. begin
  1836. appendsym_fieldvar_with_name_offset(list,sym,symname(sym),sym.vardef,0);
  1837. end;
  1838. procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
  1839. var
  1840. bitoffset,
  1841. fieldoffset,
  1842. fieldnatsize: aint;
  1843. begin
  1844. if (sp_static in sym.symoptions) or
  1845. (sym.visibility=vis_hidden) then
  1846. exit;
  1847. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
  1848. { only ordinals are bitpacked }
  1849. not is_ordinal(sym.vardef) then
  1850. begin
  1851. { other kinds of fields can however also appear in a bitpacked }
  1852. { record, and then their offset is also specified in bits rather }
  1853. { than in bytes }
  1854. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
  1855. fieldoffset:=sym.fieldoffset
  1856. else
  1857. fieldoffset:=sym.fieldoffset div 8;
  1858. inc(fieldoffset,offset);
  1859. append_entry(DW_TAG_member,false,[
  1860. DW_AT_name,DW_FORM_string,name+#0,
  1861. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  1862. ]);
  1863. end
  1864. else
  1865. begin
  1866. if (sym.vardef.packedbitsize > 255) then
  1867. internalerror(2007061201);
  1868. { we don't bitpack according to the ABI, but as close as }
  1869. { possible, i.e., equivalent to gcc's }
  1870. { __attribute__((__packed__)), which is also what gpc }
  1871. { does. }
  1872. fieldnatsize:=max(sizeof(pint),sym.vardef.size);
  1873. fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
  1874. inc(fieldoffset,offset);
  1875. bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
  1876. if (target_info.endian=endian_little) then
  1877. bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
  1878. append_entry(DW_TAG_member,false,[
  1879. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  1880. { gcc also generates both a bit and byte size attribute }
  1881. { we don't support ordinals >= 256 bits }
  1882. DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
  1883. { nor >= 256 bits (not yet, anyway, see IE above) }
  1884. DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
  1885. { data1 and data2 are unsigned, bitoffset can also be negative }
  1886. DW_AT_bit_offset,DW_FORM_data4,bitoffset,
  1887. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  1888. ]);
  1889. end;
  1890. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1891. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
  1892. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1893. finish_entry;
  1894. end;
  1895. procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym);
  1896. begin
  1897. append_entry(DW_TAG_constant,false,[
  1898. DW_AT_name,DW_FORM_string,symname(sym)+#0
  1899. ]);
  1900. { for string constants, constdef isn't set because they have no real type }
  1901. if not(sym.consttyp in [conststring,constresourcestring,constwstring]) then
  1902. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.constdef));
  1903. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_AT_const_value)));
  1904. case sym.consttyp of
  1905. conststring:
  1906. begin
  1907. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  1908. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(strpas(pchar(sym.value.valueptr))));
  1909. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1910. end;
  1911. constset,
  1912. constwstring,
  1913. constguid,
  1914. constresourcestring:
  1915. begin
  1916. { write dummy for now }
  1917. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  1918. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
  1919. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1920. end;
  1921. constord:
  1922. begin
  1923. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_sdata)));
  1924. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
  1925. end;
  1926. constnil:
  1927. begin
  1928. {$ifdef cpu64bitaddr}
  1929. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  1930. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(0));
  1931. {$else cpu64bitaddr}
  1932. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  1933. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(0));
  1934. {$endif cpu64bitaddr}
  1935. end;
  1936. constpointer:
  1937. begin
  1938. {$ifdef cpu64bitaddr}
  1939. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  1940. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(int64(sym.value.valueordptr)));
  1941. {$else cpu64bitaddr}
  1942. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  1943. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(longint(sym.value.valueordptr)));
  1944. {$endif cpu64bitaddr}
  1945. end;
  1946. constreal:
  1947. begin
  1948. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_block1)));
  1949. case tfloatdef(sym.constdef).floattype of
  1950. s32real:
  1951. begin
  1952. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
  1953. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(psingle(sym.value.valueptr)^));
  1954. end;
  1955. s64comp,
  1956. s64currency,
  1957. s64real:
  1958. begin
  1959. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  1960. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
  1961. end;
  1962. s80real:
  1963. begin
  1964. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
  1965. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
  1966. end;
  1967. else
  1968. internalerror(200601291);
  1969. end;
  1970. end;
  1971. else
  1972. internalerror(200601292);
  1973. end;
  1974. finish_entry;
  1975. end;
  1976. procedure TDebugInfoDwarf.appendsym_label(list:TAsmList;sym: tlabelsym);
  1977. begin
  1978. { ignore label syms for now, the problem is that a label sym
  1979. can have more than one label associated e.g. in case of
  1980. an inline procedure expansion }
  1981. end;
  1982. procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym);
  1983. var
  1984. symlist: ppropaccesslistitem;
  1985. tosym: tabstractvarsym;
  1986. offset: pint;
  1987. begin
  1988. if assigned(sym.propaccesslist[palt_read]) and
  1989. not assigned(sym.propaccesslist[palt_read].procdef) then
  1990. symlist:=sym.propaccesslist[palt_read].firstsym
  1991. else
  1992. { can't handle }
  1993. exit;
  1994. if not get_symlist_sym_offset(symlist,tosym,offset) then
  1995. exit;
  1996. if (tosym.owner.symtabletype<>objectsymtable) then
  1997. begin
  1998. if (tosym.typ=fieldvarsym) then
  1999. internalerror(2009031404);
  2000. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),sym.propdef,offset,false)
  2001. end
  2002. else
  2003. appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym),sym.propdef,offset)
  2004. end;
  2005. procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym);
  2006. begin
  2007. if not (target_info.system in systems_darwin) then
  2008. begin
  2009. if not(df_generic in sym.typedef.defoptions) then
  2010. begin
  2011. append_entry(DW_TAG_typedef,false,[
  2012. DW_AT_name,DW_FORM_string,symname(sym)+#0
  2013. ]);
  2014. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.typedef));
  2015. end;
  2016. finish_entry;
  2017. end
  2018. else
  2019. { just queue the def if needed }
  2020. def_dwarf_lab(sym.typedef);
  2021. end;
  2022. procedure TDebugInfoDwarf.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  2023. var
  2024. templist : TAsmList;
  2025. blocksize : longint;
  2026. symlist : ppropaccesslistitem;
  2027. tosym: tabstractvarsym;
  2028. offset: pint;
  2029. begin
  2030. templist:=TAsmList.create;
  2031. case tabsolutevarsym(sym).abstyp of
  2032. toaddr :
  2033. begin
  2034. { MWE: replaced ifdef i368 }
  2035. (*
  2036. if target_cpu = cpu_i386 then
  2037. begin
  2038. { in theory, we could write a DW_AT_segment entry here for sym.absseg,
  2039. however I doubt that gdb supports this (FK) }
  2040. end;
  2041. *)
  2042. templist.concat(tai_const.create_8bit(3));
  2043. templist.concat(tai_const.create_pint(sym.addroffset));
  2044. blocksize:=1+sizeof(puint);
  2045. end;
  2046. toasm :
  2047. begin
  2048. templist.concat(tai_const.create_8bit(3));
  2049. templist.concat(tai_const.createname(sym.mangledname,0));
  2050. blocksize:=1+sizeof(puint);
  2051. end;
  2052. tovar:
  2053. begin
  2054. symlist:=tabsolutevarsym(sym).ref.firstsym;
  2055. get_symlist_sym_offset(symlist,tosym,offset);
  2056. if (tosym.typ=fieldvarsym) then
  2057. internalerror(2009031402);
  2058. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),tabstractvarsym(sym).vardef,offset,false);
  2059. templist.free;
  2060. exit;
  2061. end;
  2062. end;
  2063. append_entry(DW_TAG_variable,false,[
  2064. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  2065. {
  2066. DW_AT_decl_file,DW_FORM_data1,0,
  2067. DW_AT_decl_line,DW_FORM_data1,
  2068. }
  2069. DW_AT_external,DW_FORM_flag,true,
  2070. { data continues below }
  2071. DW_AT_location,DW_FORM_block1,blocksize
  2072. ]);
  2073. { append block data }
  2074. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  2075. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  2076. templist.free;
  2077. finish_entry;
  2078. end;
  2079. procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym);
  2080. begin
  2081. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym))));
  2082. end;
  2083. procedure TDebugInfoDwarf.insertmoduleinfo;
  2084. var
  2085. templist: TAsmList;
  2086. linelist: TAsmList;
  2087. lbl : tasmlabel;
  2088. n,m : Integer;
  2089. ditem : TDirIndexItem;
  2090. fitem : TFileIndexItem;
  2091. flist : TFPList;
  2092. dbgname : String;
  2093. begin
  2094. { insert DEBUGSTART and DEBUGEND labels }
  2095. dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
  2096. { Darwin's linker does not like two global labels both pointing to the
  2097. end of a section, which can happen in case of units without code ->
  2098. make them local; we don't need the debugtable stuff there either,
  2099. so it doesn't matter that they are not global.
  2100. }
  2101. if (target_info.system in systems_darwin) then
  2102. dbgname:='L'+dbgname;
  2103. new_section(current_asmdata.asmlists[al_start],sec_code,dbgname,0,secorder_begin);
  2104. if not(target_info.system in systems_darwin) then
  2105. current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(dbgname,AT_DATA,0))
  2106. else
  2107. current_asmdata.asmlists[al_start].concat(tai_symbol.Createname(dbgname,AT_DATA,0));
  2108. dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
  2109. { See above. }
  2110. if (target_info.system in systems_darwin) then
  2111. dbgname:='L'+dbgname;
  2112. new_section(current_asmdata.asmlists[al_end],sec_code,dbgname,0,secorder_end);
  2113. if not(target_info.system in systems_darwin) then
  2114. current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(dbgname,AT_DATA,0))
  2115. else
  2116. current_asmdata.asmlists[al_end].concat(tai_symbol.Createname(dbgname,AT_DATA,0));
  2117. { insert .Ldebug_abbrev0 label }
  2118. templist:=TAsmList.create;
  2119. new_section(templist,sec_debug_abbrev,'',0);
  2120. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrevsection0',AT_DATA,0));
  2121. { add any extra stuff which needs to be in the abbrev section, but before }
  2122. { the actual abbreviations, in between the symbol above and below, i.e. here }
  2123. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrev0',AT_DATA,0));
  2124. current_asmdata.asmlists[al_start].insertlist(templist);
  2125. templist.free;
  2126. { insert .Ldebug_line0 label }
  2127. templist:=TAsmList.create;
  2128. new_section(templist,sec_debug_line,'',0);
  2129. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_linesection0',AT_DATA,0));
  2130. { add any extra stuff which needs to be in the line section, but before }
  2131. { the actual line info, in between the symbol above and below, i.e. here }
  2132. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_line0',AT_DATA,0));
  2133. current_asmdata.asmlists[al_start].insertlist(templist);
  2134. templist.free;
  2135. { finalize line info if the unit doesn't contain any function/ }
  2136. { procedure/init/final code }
  2137. finish_lineinfo;
  2138. { debug line header }
  2139. linelist := current_asmdata.asmlists[al_dwarf_line];
  2140. new_section(linelist,sec_debug_line,'',0);
  2141. linelist.concat(tai_comment.Create(strpnew('=== header start ===')));
  2142. { size }
  2143. current_asmdata.getlabel(lbl,alt_dbgfile);
  2144. if use_64bit_headers then
  2145. linelist.concat(tai_const.create_32bit(longint($FFFFFFFF)));
  2146. linelist.concat(tai_const.create_rel_sym(offsetreltype,
  2147. lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_line0')));
  2148. linelist.concat(tai_label.create(lbl));
  2149. { version }
  2150. linelist.concat(tai_const.create_16bit(dwarf_version));
  2151. { header length }
  2152. current_asmdata.getlabel(lbl,alt_dbgfile);
  2153. linelist.concat(tai_const.create_rel_sym(offsetreltype,
  2154. lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'ehdebug_line0')));
  2155. linelist.concat(tai_label.create(lbl));
  2156. { minimum_instruction_length }
  2157. linelist.concat(tai_const.create_8bit(1));
  2158. { default_is_stmt }
  2159. linelist.concat(tai_const.create_8bit(1));
  2160. { line_base }
  2161. linelist.concat(tai_const.create_8bit(LINE_BASE));
  2162. { line_range }
  2163. { only line increase, no adress }
  2164. linelist.concat(tai_const.create_8bit(255));
  2165. { opcode_base }
  2166. linelist.concat(tai_const.create_8bit(OPCODE_BASE));
  2167. { standard_opcode_lengths }
  2168. { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) }
  2169. { DW_LNS_copy }
  2170. linelist.concat(tai_const.create_8bit(0));
  2171. { DW_LNS_advance_pc }
  2172. linelist.concat(tai_const.create_8bit(1));
  2173. { DW_LNS_advance_line }
  2174. linelist.concat(tai_const.create_8bit(1));
  2175. { DW_LNS_set_file }
  2176. linelist.concat(tai_const.create_8bit(1));
  2177. { DW_LNS_set_column }
  2178. linelist.concat(tai_const.create_8bit(1));
  2179. { DW_LNS_negate_stmt }
  2180. linelist.concat(tai_const.create_8bit(0));
  2181. { DW_LNS_set_basic_block }
  2182. linelist.concat(tai_const.create_8bit(0));
  2183. { DW_LNS_const_add_pc }
  2184. linelist.concat(tai_const.create_8bit(0));
  2185. { DW_LNS_fixed_advance_pc }
  2186. linelist.concat(tai_const.create_8bit(1));
  2187. { DW_LNS_set_prologue_end }
  2188. linelist.concat(tai_const.create_8bit(0));
  2189. { DW_LNS_set_epilogue_begin }
  2190. linelist.concat(tai_const.create_8bit(0));
  2191. { DW_LNS_set_isa }
  2192. linelist.concat(tai_const.create_8bit(1));
  2193. { Create single list of filenames sorted in IndexNr }
  2194. flist:=TFPList.Create;
  2195. for n := 0 to dirlist.Count - 1 do
  2196. begin
  2197. ditem := TDirIndexItem(dirlist[n]);
  2198. for m := 0 to ditem.Files.Count - 1 do
  2199. flist.Add(ditem.Files[m]);
  2200. end;
  2201. flist.Sort(@FileListSortCompare);
  2202. { include_directories }
  2203. linelist.concat(tai_comment.Create(strpnew('include_directories')));
  2204. for n := 0 to dirlist.Count - 1 do
  2205. begin
  2206. ditem := TDirIndexItem(dirlist[n]);
  2207. if ditem.Name = '.' then
  2208. Continue;
  2209. { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist }
  2210. linelist.concat(tai_string.create(ditem.Name+#0));
  2211. end;
  2212. linelist.concat(tai_const.create_8bit(0));
  2213. { file_names }
  2214. linelist.concat(tai_comment.Create(strpnew('file_names')));
  2215. for n := 0 to flist.Count - 1 do
  2216. begin
  2217. fitem := TFileIndexItem(flist[n]);
  2218. { file name }
  2219. linelist.concat(tai_string.create(fitem.Name+#0));
  2220. { directory index }
  2221. linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex));
  2222. { last modification }
  2223. linelist.concat(tai_const.create_uleb128bit(0));
  2224. { file length }
  2225. linelist.concat(tai_const.create_uleb128bit(0));
  2226. end;
  2227. linelist.concat(tai_const.create_8bit(0));
  2228. { end of debug line header }
  2229. linelist.concat(tai_symbol.createname(target_asm.labelprefix+'ehdebug_line0',AT_DATA,0));
  2230. linelist.concat(tai_comment.Create(strpnew('=== header end ===')));
  2231. { add line program }
  2232. linelist.concatList(asmline);
  2233. { end of debug line table }
  2234. linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_DATA,0));
  2235. flist.free;
  2236. end;
  2237. procedure TDebugInfoDwarf.inserttypeinfo;
  2238. procedure write_defs_to_write;
  2239. var
  2240. n : integer;
  2241. looplist,
  2242. templist: TFPObjectList;
  2243. def : tdef;
  2244. begin
  2245. templist := TFPObjectList.Create(False);
  2246. looplist := deftowritelist;
  2247. while looplist.count > 0 do
  2248. begin
  2249. deftowritelist := templist;
  2250. for n := 0 to looplist.count - 1 do
  2251. begin
  2252. def := tdef(looplist[n]);
  2253. case def.dbg_state of
  2254. dbg_state_written:
  2255. continue;
  2256. dbg_state_writing:
  2257. internalerror(200610052);
  2258. dbg_state_unused:
  2259. internalerror(200610053);
  2260. dbg_state_used:
  2261. appenddef(nil,def)
  2262. else
  2263. internalerror(200610054);
  2264. end;
  2265. end;
  2266. looplist.clear;
  2267. templist := looplist;
  2268. looplist := deftowritelist;
  2269. end;
  2270. templist.free;
  2271. end;
  2272. var
  2273. storefilepos : tfileposinfo;
  2274. lenstartlabel : tasmlabel;
  2275. i : longint;
  2276. def: tdef;
  2277. dbgname: string;
  2278. begin
  2279. current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
  2280. storefilepos:=current_filepos;
  2281. current_filepos:=current_module.mainfilepos;
  2282. currabbrevnumber:=0;
  2283. defnumberlist:=TFPObjectList.create(false);
  2284. deftowritelist:=TFPObjectList.create(false);
  2285. { not exported (FK)
  2286. FILEREC
  2287. TEXTREC
  2288. }
  2289. vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
  2290. { write start labels }
  2291. current_asmdata.asmlists[al_dwarf_info].concat(tai_section.create(sec_debug_info,'',0));
  2292. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'debug_info0',AT_DATA,0));
  2293. { start abbrev section }
  2294. new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
  2295. { debug info header }
  2296. current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
  2297. { size }
  2298. if use_64bit_headers then
  2299. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(longint($FFFFFFFF)));
  2300. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
  2301. lenstartlabel,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_info0')));
  2302. current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
  2303. { version }
  2304. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(dwarf_version));
  2305. { abbrev table (=relative from section start)}
  2306. if not(tf_dwarf_relative_addresses in target_info.flags) then
  2307. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,
  2308. current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0')))
  2309. else
  2310. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
  2311. current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0'),
  2312. current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0')));
  2313. { address size }
  2314. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint)));
  2315. { first manadatory compilation unit TAG }
  2316. append_entry(DW_TAG_compile_unit,true,[
  2317. DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path^+current_module.sourcefiles.get_file(1).name^)+#0,
  2318. DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
  2319. DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0,
  2320. DW_AT_language,DW_FORM_data1,DW_LANG_Pascal83,
  2321. DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
  2322. { reference to line info section }
  2323. if not(tf_dwarf_relative_addresses in target_info.flags) then
  2324. append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0'))
  2325. else
  2326. append_labelentry_dataptr_rel(DW_AT_stmt_list,
  2327. current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_linesection0'),
  2328. current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0'));
  2329. dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
  2330. if (target_info.system in systems_darwin) then
  2331. dbgname:='L'+dbgname;
  2332. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(dbgname));
  2333. dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
  2334. if (target_info.system in systems_darwin) then
  2335. dbgname:='L'+dbgname;
  2336. append_labelentry(DW_AT_high_pc,current_asmdata.RefAsmSymbol(dbgname));
  2337. finish_entry;
  2338. { write all global/local variables. This will flag all required tdefs }
  2339. if assigned(current_module.globalsymtable) then
  2340. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2341. if assigned(current_module.localsymtable) then
  2342. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2343. { write all procedures and methods. This will flag all required tdefs }
  2344. if assigned(current_module.globalsymtable) then
  2345. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2346. if assigned(current_module.localsymtable) then
  2347. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2348. { reset unit type info flag }
  2349. reset_unit_type_info;
  2350. { write used types from the used units }
  2351. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  2352. { last write the types from this unit }
  2353. if assigned(current_module.globalsymtable) then
  2354. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2355. if assigned(current_module.localsymtable) then
  2356. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2357. { write defs not written yet }
  2358. write_defs_to_write;
  2359. { close compilation unit entry }
  2360. finish_children;
  2361. { end of debug info table }
  2362. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_DATA,0));
  2363. { end of abbrev table }
  2364. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  2365. { reset all def labels }
  2366. for i:=0 to defnumberlist.count-1 do
  2367. begin
  2368. def := tdef(defnumberlist[i]);
  2369. if assigned(def) then
  2370. begin
  2371. def.dwarf_lab:=nil;
  2372. def.dbg_state:=dbg_state_unused;
  2373. end;
  2374. end;
  2375. defnumberlist.free;
  2376. defnumberlist:=nil;
  2377. deftowritelist.free;
  2378. deftowritelist:=nil;
  2379. current_filepos:=storefilepos;
  2380. end;
  2381. procedure TDebugInfoDwarf.referencesections(list:TAsmList);
  2382. var
  2383. hp : tmodule;
  2384. begin
  2385. { Reference all DEBUGINFO sections from the main .fpc section }
  2386. { to prevent eliminating them by smartlinking }
  2387. if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then
  2388. exit;
  2389. list.concat(Tai_section.create(sec_fpc,'links',0));
  2390. { include reference to all debuginfo sections of used units }
  2391. hp:=tmodule(loaded_units.first);
  2392. while assigned(hp) do
  2393. begin
  2394. If (hp.flags and uf_has_dwarf_debuginfo)=uf_has_dwarf_debuginfo then
  2395. begin
  2396. list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
  2397. list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
  2398. end;
  2399. hp:=tmodule(hp.next);
  2400. end;
  2401. end;
  2402. function TDebugInfoDwarf.symname(sym: tsym): String;
  2403. begin
  2404. if (sym.typ=paravarsym) and
  2405. (vo_is_self in tparavarsym(sym).varoptions) then
  2406. result:='this'
  2407. else
  2408. result := sym.Name;
  2409. end;
  2410. procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
  2411. var
  2412. currfileinfo,
  2413. lastfileinfo : tfileposinfo;
  2414. currfuncname : pshortstring;
  2415. currsectype : TAsmSectiontype;
  2416. hp, hpend : tai;
  2417. infile : tinputfile;
  2418. prevcolumn,
  2419. diffline,
  2420. prevline,
  2421. prevfileidx,
  2422. currfileidx: Integer;
  2423. prevlabel,
  2424. currlabel : tasmlabel;
  2425. begin
  2426. { this function will always terminate the lineinfo block }
  2427. generated_lineinfo := true;
  2428. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  2429. currfuncname:=nil;
  2430. currsectype:=sec_code;
  2431. hp:=Tai(list.first);
  2432. prevcolumn := 0;
  2433. prevline := 1;
  2434. prevfileidx := 1;
  2435. prevlabel := nil;
  2436. while assigned(hp) do
  2437. begin
  2438. case hp.typ of
  2439. ait_section :
  2440. currsectype:=tai_section(hp).sectype;
  2441. ait_function_name :
  2442. begin
  2443. currfuncname:=tai_function_name(hp).funcname;
  2444. asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
  2445. end;
  2446. ait_force_line : begin
  2447. lastfileinfo.line:=-1;
  2448. end;
  2449. end;
  2450. if (currsectype=sec_code) and
  2451. (hp.typ=ait_instruction) then
  2452. begin
  2453. currfileinfo:=tailineinfo(hp).fileinfo;
  2454. { file changed ? (must be before line info) }
  2455. if (currfileinfo.fileindex<>0) and
  2456. ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
  2457. (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
  2458. begin
  2459. infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
  2460. if assigned(infile) then
  2461. begin
  2462. currfileidx := get_file_index(infile);
  2463. if prevfileidx <> currfileidx then
  2464. begin
  2465. list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path^)), hp);
  2466. list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name^)), hp);
  2467. list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp);
  2468. { set file }
  2469. asmline.concat(tai_comment.Create(strpnew('path: '+infile.path^)));
  2470. asmline.concat(tai_comment.Create(strpnew('file: '+infile.name^)));
  2471. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  2472. asmline.concat(tai_const.create_uleb128bit(currfileidx));
  2473. prevfileidx := currfileidx;
  2474. end;
  2475. { force new line info }
  2476. lastfileinfo.line:=-1;
  2477. end;
  2478. end;
  2479. { line changed ? }
  2480. if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
  2481. begin
  2482. { set address }
  2483. current_asmdata.getlabel(currlabel, alt_dbgline);
  2484. list.insertbefore(tai_label.create(currlabel), hp);
  2485. asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']')));
  2486. if (prevlabel = nil) or
  2487. { darwin's assembler cannot create an uleb128 of the difference }
  2488. { between to symbols }
  2489. (target_info.system in systems_darwin) then
  2490. begin
  2491. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2492. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  2493. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  2494. asmline.concat(tai_const.create_sym(currlabel));
  2495. end
  2496. else
  2497. begin
  2498. asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc));
  2499. asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel));
  2500. end;
  2501. prevlabel := currlabel;
  2502. { set column }
  2503. if prevcolumn <> currfileinfo.column then
  2504. begin
  2505. asmline.concat(tai_const.create_8bit(DW_LNS_set_column));
  2506. asmline.concat(tai_const.create_uleb128bit(currfileinfo.column));
  2507. prevcolumn := currfileinfo.column;
  2508. end;
  2509. { set line }
  2510. diffline := currfileinfo.line - prevline;
  2511. if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then
  2512. begin
  2513. { use special opcode, this also adds a row }
  2514. asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE));
  2515. end
  2516. else
  2517. begin
  2518. if diffline <> 0 then
  2519. begin
  2520. asmline.concat(tai_const.create_8bit(DW_LNS_advance_line));
  2521. asmline.concat(tai_const.create_sleb128bit(diffline));
  2522. end;
  2523. { no row added yet, do it manually }
  2524. asmline.concat(tai_const.create_8bit(DW_LNS_copy));
  2525. end;
  2526. prevline := currfileinfo.line;
  2527. end;
  2528. lastfileinfo:=currfileinfo;
  2529. end;
  2530. hpend:=hp;
  2531. hp:=tai(hp.next);
  2532. end;
  2533. if assigned(hpend) then
  2534. begin
  2535. { set address for end (see appendix 3 of dwarf 2 specs) }
  2536. current_asmdata.getlabel(currlabel, alt_dbgline);
  2537. list.insertafter(tai_label.create(currlabel), hpend);
  2538. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2539. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  2540. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  2541. asmline.concat(tai_const.create_sym(currlabel));
  2542. end;
  2543. { end sequence }
  2544. asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op));
  2545. asmline.concat(tai_const.Create_8bit(1));
  2546. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  2547. asmline.concat(tai_comment.Create(strpnew('###################')));
  2548. end;
  2549. procedure TDebugInfoDwarf.finish_lineinfo;
  2550. var
  2551. infile: tinputfile;
  2552. begin
  2553. { only needed if no line info at all has been generated }
  2554. if generated_lineinfo then
  2555. begin
  2556. { reset for next module compilation }
  2557. generated_lineinfo:=false;
  2558. exit;
  2559. end;
  2560. { at least the Darwin linker is annoyed if you do not }
  2561. { finish the lineinfo section, or if it doesn't }
  2562. { contain at least one file name and set_address }
  2563. infile:=current_module.sourcefiles.get_file(1);
  2564. if not assigned(infile) then
  2565. internalerror(2006020211);
  2566. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  2567. asmline.concat(tai_const.create_uleb128bit(get_file_index(infile)));
  2568. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2569. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  2570. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  2571. asmline.concat(tai_const.create_sym(nil));
  2572. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2573. asmline.concat(tai_const.Create_8bit(1));
  2574. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  2575. asmline.concat(tai_comment.Create(strpnew('###################')));
  2576. end;
  2577. {****************************************************************************
  2578. TDebugInfoDwarf2
  2579. ****************************************************************************}
  2580. procedure TDebugInfoDwarf2.appenddef_file(list:TAsmList;def: tfiledef);
  2581. begin
  2582. { gdb 6.4 doesn't support files so far so we use some fake recorddef
  2583. file recs. are less than 1k so using data2 is enough }
  2584. if assigned(def.typesym) then
  2585. append_entry(DW_TAG_structure_type,false,[
  2586. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2587. DW_AT_byte_size,DW_FORM_udata,def.size
  2588. ])
  2589. else
  2590. append_entry(DW_TAG_structure_type,false,[
  2591. DW_AT_byte_size,DW_FORM_udata,def.size
  2592. ]);
  2593. finish_entry;
  2594. end;
  2595. procedure TDebugInfoDwarf2.appenddef_formal(list:TAsmList;def: tformaldef);
  2596. begin
  2597. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2598. replace it with a unsigned type with size 0 (FK)
  2599. }
  2600. append_entry(DW_TAG_base_type,false,[
  2601. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2602. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2603. DW_AT_byte_size,DW_FORM_data1,0
  2604. ]);
  2605. finish_entry;
  2606. end;
  2607. procedure TDebugInfoDwarf2.appenddef_object(list:TAsmList;def: tobjectdef);
  2608. procedure doappend;
  2609. begin
  2610. if assigned(def.objname) then
  2611. append_entry(DW_TAG_structure_type,true,[
  2612. DW_AT_name,DW_FORM_string,def.objname^+#0,
  2613. DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
  2614. ])
  2615. else
  2616. append_entry(DW_TAG_structure_type,true,[
  2617. DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
  2618. ]);
  2619. finish_entry;
  2620. if assigned(def.childof) then
  2621. begin
  2622. append_entry(DW_TAG_inheritance,false,[
  2623. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2624. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2625. ]);
  2626. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2627. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2628. if (def.childof.dbg_state=dbg_state_unused) then
  2629. def.childof.dbg_state:=dbg_state_used;
  2630. if is_class_or_interface_or_dispinterface(def) then
  2631. append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def.childof))
  2632. else
  2633. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2634. finish_entry;
  2635. end;
  2636. if (oo_has_vmt in def.objectoptions) and
  2637. (not assigned(def.childof) or
  2638. not(oo_has_vmt in def.childof.objectoptions)) then
  2639. begin
  2640. { vmt field }
  2641. append_entry(DW_TAG_member,false,[
  2642. DW_AT_artificial,DW_FORM_flag,true,
  2643. DW_AT_name,DW_FORM_string,'_vptr$'+def.objname^+#0,
  2644. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(def.vmt_offset)
  2645. ]);
  2646. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2647. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(def.vmt_offset));
  2648. { should be changed into a pointer to a function returning an }
  2649. { int and with TAG_unspecified_parameters }
  2650. if (voidpointertype.dbg_state=dbg_state_unused) then
  2651. voidpointertype.dbg_state:=dbg_state_used;
  2652. append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype));
  2653. finish_entry;
  2654. end;
  2655. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  2656. { Write the methods in the scope of the class/object. }
  2657. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
  2658. finish_children;
  2659. end;
  2660. begin
  2661. case def.objecttype of
  2662. odt_cppclass,
  2663. odt_object:
  2664. doappend;
  2665. odt_interfacecom,
  2666. odt_interfacecorba,
  2667. odt_dispinterface,
  2668. odt_class:
  2669. begin
  2670. { implicit pointer }
  2671. append_entry(DW_TAG_pointer_type,false,[]);
  2672. append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def));
  2673. finish_entry;
  2674. if not(tf_dwarf_only_local_labels in target_info.flags) then
  2675. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(def_dwarf_class_struct_lab(def),0))
  2676. else
  2677. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
  2678. doappend;
  2679. end;
  2680. else
  2681. internalerror(200602041);
  2682. end;
  2683. end;
  2684. procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean);
  2685. var
  2686. lab: tasmlabel;
  2687. begin
  2688. if force_tag_set or
  2689. (ds_dwarf_sets in current_settings.debugswitches) then
  2690. begin
  2691. { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types }
  2692. if assigned(def.typesym) then
  2693. append_entry(DW_TAG_set_type,false,[
  2694. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2695. DW_AT_byte_size,DW_FORM_data2,def.size
  2696. ])
  2697. else
  2698. append_entry(DW_TAG_set_type,false,[
  2699. DW_AT_byte_size,DW_FORM_data2,def.size
  2700. ]);
  2701. if assigned(def.elementdef) then
  2702. begin
  2703. if not(tf_dwarf_only_local_labels in target_info.flags) then
  2704. current_asmdata.getdatalabel(lab)
  2705. else
  2706. current_asmdata.getaddrlabel(lab);
  2707. append_labelentry_ref(DW_AT_type,lab);
  2708. finish_entry;
  2709. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
  2710. { Sets of e.g. [1..5] are actually stored as a set of [0..7],
  2711. so write the exact boundaries of the set here. Let's hope no
  2712. debugger ever rejects this because this "subrange" type can
  2713. actually have a larger range than the original one. }
  2714. append_entry(DW_TAG_subrange_type,false,[
  2715. DW_AT_lower_bound,DW_FORM_sdata,def.setbase,
  2716. DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue
  2717. ]);
  2718. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef))
  2719. end
  2720. end
  2721. else
  2722. begin
  2723. { gdb versions which don't support sets refuse to load the debug }
  2724. { info of modules that contain set tags }
  2725. if assigned(def.typesym) then
  2726. append_entry(DW_TAG_base_type,false,[
  2727. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2728. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2729. DW_AT_byte_size,DW_FORM_data2,def.size
  2730. ])
  2731. else
  2732. append_entry(DW_TAG_base_type,false,[
  2733. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2734. DW_AT_byte_size,DW_FORM_data2,def.size
  2735. ]);
  2736. end;
  2737. finish_entry;
  2738. end;
  2739. procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
  2740. begin
  2741. appenddef_set_intern(list,def,false);
  2742. end;
  2743. procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef);
  2744. begin
  2745. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2746. replace it with a unsigned type with size 0 (FK)
  2747. }
  2748. append_entry(DW_TAG_base_type,false,[
  2749. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2750. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2751. DW_AT_byte_size,DW_FORM_data1,0
  2752. ]);
  2753. finish_entry;
  2754. end;
  2755. procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef);
  2756. begin
  2757. { variants aren't known to dwarf2 but writting tvardata should be enough }
  2758. appenddef_record(list,trecorddef(vardatadef));
  2759. end;
  2760. function TDebugInfoDwarf2.dwarf_version: Word;
  2761. begin
  2762. Result:=2;
  2763. end;
  2764. {****************************************************************************
  2765. TDebugInfoDwarf3
  2766. ****************************************************************************}
  2767. procedure tdebuginfodwarf3.appenddef_array(list: tasmlist; def: tarraydef);
  2768. begin
  2769. if not is_dynamic_array(def) then
  2770. begin
  2771. inherited appenddef_array(list,def);
  2772. exit;
  2773. end;
  2774. if assigned(def.typesym) then
  2775. append_entry(DW_TAG_array_type,true,[
  2776. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2777. DW_AT_data_location,DW_FORM_block1,2
  2778. ])
  2779. else
  2780. append_entry(DW_TAG_array_type,true,[
  2781. DW_AT_data_location,DW_FORM_block1,2
  2782. ]);
  2783. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2784. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2785. append_block1(DW_AT_allocated,2);
  2786. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2787. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2788. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  2789. finish_entry;
  2790. { to simplify things, we don't write a multidimensional array here }
  2791. append_entry(DW_TAG_subrange_type,false,[
  2792. DW_AT_byte_stride,DW_FORM_udata,def.elesize,
  2793. DW_AT_lower_bound,DW_FORM_udata,0,
  2794. DW_AT_upper_bound,DW_FORM_block1,5
  2795. ]);
  2796. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2797. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2798. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint)));
  2799. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
  2800. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2801. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
  2802. finish_entry;
  2803. finish_children;
  2804. end;
  2805. procedure tdebuginfodwarf3.appenddef_string(list: tasmlist; def: tstringdef);
  2806. procedure addstringdef(const name: shortstring; chardef: tdef; deref: boolean; lensize: aint);
  2807. var
  2808. upperopcodes: longint;
  2809. begin
  2810. { deref=true -> ansi/unicde/widestring; deref = false -> short/longstring }
  2811. if assigned(def.typesym) then
  2812. append_entry(DW_TAG_array_type,true,[
  2813. DW_AT_name,DW_FORM_string,name+#0,
  2814. DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
  2815. ])
  2816. else
  2817. append_entry(DW_TAG_array_type,true,[
  2818. DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
  2819. ]);
  2820. { in all cases we start with the address of the string }
  2821. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2822. if deref then
  2823. begin
  2824. { ansi/unicode/widestring -> dereference the address of the string, and then
  2825. we point to address of the string
  2826. }
  2827. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2828. { also add how to detect whether or not the string is allocated: if the pointer is 0
  2829. then it isn't, otherwise it is
  2830. }
  2831. append_block1(DW_AT_allocated,2);
  2832. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2833. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2834. end
  2835. else
  2836. begin
  2837. { shortstring characters begin at string[1], so add one to the string's address }
  2838. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+lensize));
  2839. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus)))
  2840. end;
  2841. { reference to the element type of the string }
  2842. append_labelentry_ref(DW_AT_type,def_dwarf_lab(chardef));
  2843. finish_entry;
  2844. { now the information about the length of the string }
  2845. if deref then
  2846. begin
  2847. if (chardef.size=1) then
  2848. upperopcodes:=5
  2849. else
  2850. upperopcodes:=7;
  2851. { lower bound is always 1, upper bound (length) needs to be calculated }
  2852. append_entry(DW_TAG_subrange_type,false,[
  2853. DW_AT_lower_bound,DW_FORM_udata,1,
  2854. DW_AT_upper_bound,DW_FORM_block1,upperopcodes
  2855. ]);
  2856. { high(string) is stored sizeof(ptrint) bytes before the string data }
  2857. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2858. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2859. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint)));
  2860. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
  2861. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
  2862. { for widestrings, the length is specified in bytes, so divide by two }
  2863. if (upperopcodes=7) then
  2864. begin
  2865. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1)));
  2866. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shra)));
  2867. end;
  2868. end
  2869. else
  2870. begin
  2871. append_entry(DW_TAG_subrange_type,false,[
  2872. DW_AT_lower_bound,DW_FORM_udata,1,
  2873. DW_AT_upper_bound,DW_FORM_block1,3
  2874. ]);
  2875. { for shortstrings, the length is the first byte of the string }
  2876. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  2877. { load 1 byte }
  2878. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size)));
  2879. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(lensize));
  2880. end;
  2881. finish_entry;
  2882. finish_children;
  2883. end;
  2884. begin
  2885. case def.stringtype of
  2886. st_shortstring:
  2887. begin
  2888. addstringdef('ShortString',cchartype,false,1);
  2889. end;
  2890. st_longstring:
  2891. begin
  2892. {$ifdef cpu64bitaddr}
  2893. addstringdef('LongString',cchartype,false,8);
  2894. {$else cpu64bitaddr}
  2895. addstringdef('LongString',cchartype,false,4);
  2896. {$endif cpu64bitaddr}
  2897. end;
  2898. st_ansistring:
  2899. begin
  2900. addstringdef('AnsiString',cchartype,true,-1);
  2901. end;
  2902. st_unicodestring:
  2903. begin
  2904. addstringdef('UnicodeString',cwidechartype,true,-1);
  2905. end;
  2906. st_widestring:
  2907. begin
  2908. if not(tf_winlikewidestring in target_info.flags) then
  2909. addstringdef('WideString',cwidechartype,true,-1)
  2910. else
  2911. begin
  2912. { looks like a pwidechar (no idea about length location) }
  2913. append_entry(DW_TAG_pointer_type,false,[]);
  2914. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype));
  2915. finish_entry;
  2916. end;
  2917. end;
  2918. end;
  2919. end;
  2920. procedure TDebugInfoDwarf3.appenddef_file(list:TAsmList;def: tfiledef);
  2921. begin
  2922. if assigned(def.typesym) then
  2923. append_entry(DW_TAG_file_type,false,[
  2924. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2925. DW_AT_byte_size,DW_FORM_data2,def.size
  2926. ])
  2927. else
  2928. append_entry(DW_TAG_file_type,false,[
  2929. DW_AT_byte_size,DW_FORM_data2,def.size
  2930. ]);
  2931. if tfiledef(def).filetyp=ft_typed then
  2932. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef));
  2933. finish_entry;
  2934. end;
  2935. procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef);
  2936. begin
  2937. append_entry(DW_TAG_unspecified_type,false,[
  2938. ]);
  2939. finish_entry;
  2940. end;
  2941. procedure TDebugInfoDwarf3.appenddef_object(list:TAsmList;def: tobjectdef);
  2942. procedure dostruct(tag: tdwarf_tag);
  2943. begin
  2944. if assigned(def.objname) then
  2945. append_entry(tag,true,[
  2946. DW_AT_name,DW_FORM_string,def.objrealname^+#0,
  2947. DW_AT_byte_size,DW_FORM_udata,def.size
  2948. ])
  2949. else
  2950. append_entry(DW_TAG_structure_type,true,[
  2951. DW_AT_byte_size,DW_FORM_udata,def.size
  2952. ]);
  2953. finish_entry;
  2954. end;
  2955. procedure doimplicitpointer;
  2956. var
  2957. obj : tasmlabel;
  2958. begin
  2959. if not(tf_dwarf_only_local_labels in target_info.flags) then
  2960. current_asmdata.getdatalabel(obj)
  2961. else
  2962. current_asmdata.getaddrlabel(obj);
  2963. { implicit pointer }
  2964. append_entry(DW_TAG_pointer_type,false,[]);
  2965. append_labelentry_ref(DW_AT_type,obj);
  2966. finish_entry;
  2967. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  2968. end;
  2969. procedure doparent(isinterface: boolean);
  2970. begin
  2971. if not assigned(def.childof) then
  2972. exit;
  2973. if isinterface then
  2974. begin
  2975. append_entry(DW_TAG_inheritance,false,[]);
  2976. end
  2977. else
  2978. begin
  2979. append_entry(DW_TAG_inheritance,false,[
  2980. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2981. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2982. ]);
  2983. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2984. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2985. end;
  2986. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2987. finish_entry;
  2988. end;
  2989. var
  2990. n: integer;
  2991. begin
  2992. case def.objecttype of
  2993. odt_cppclass,
  2994. odt_object:
  2995. begin
  2996. dostruct(DW_TAG_structure_type);
  2997. doparent(false);
  2998. end;
  2999. odt_interfacecom,
  3000. odt_interfacecorba,
  3001. odt_dispinterface:
  3002. begin
  3003. dostruct(DW_TAG_interface_type);
  3004. doparent(true);
  3005. end;
  3006. odt_class:
  3007. begin
  3008. { not sure if the implicit pointer is needed for tag_class (MWE)}
  3009. {
  3010. doimplicitpointer;
  3011. }
  3012. dostruct(DW_TAG_class_type);
  3013. doparent(false);
  3014. end;
  3015. else
  3016. internalerror(200609171);
  3017. end;
  3018. { add implemented interfaces }
  3019. if assigned(def.ImplementedInterfaces) then
  3020. for n := 0 to def.ImplementedInterfaces.count-1 do
  3021. begin
  3022. append_entry(DW_TAG_inheritance,false,[]);
  3023. append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef));
  3024. finish_entry;
  3025. end;
  3026. { add members }
  3027. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  3028. finish_children;
  3029. end;
  3030. procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef);
  3031. begin
  3032. appenddef_set_intern(list,def,true);
  3033. end;
  3034. procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef);
  3035. begin
  3036. { ??? can a undefined def have a typename ? }
  3037. if assigned(def.typesym) then
  3038. append_entry(DW_TAG_unspecified_type,false,[
  3039. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
  3040. ])
  3041. else
  3042. append_entry(DW_TAG_unspecified_type,false,[
  3043. ]);
  3044. finish_entry;
  3045. end;
  3046. procedure TDebugInfoDwarf3.appenddef_variant(list:TAsmList;def: tvariantdef);
  3047. const
  3048. VARIANTS: array[1..27] of record Value: Word; Name: String end = (
  3049. (value:0; name:''),
  3050. (value:1; name:''),
  3051. (value:2; name:'VSMALLINT'),
  3052. (value:3; name:'VINTEGER'),
  3053. (value:4; name:'VSINGLE'),
  3054. (value:5; name:'VDOUBLE'),
  3055. (value:6; name:'VCURRENCY'),
  3056. (value:7; name:'VDATE'),
  3057. (value:8; name:'VOLESTR'),
  3058. (value:9; name:'VDISPATCH'),
  3059. (value:10; name:'VERROR'),
  3060. (value:11; name:'VBOOLEAN'),
  3061. (value:12; name:''),
  3062. (value:13; name:'VUNKNOWN'),
  3063. (value:14; name:''),
  3064. (value:16; name:'VSHORTINT'),
  3065. (value:17; name:'VBYTE'),
  3066. (value:18; name:'VWORD'),
  3067. (value:19; name:'VLONGWORD'),
  3068. (value:20; name:'VINT64'),
  3069. (value:21; name:'VQWORD'),
  3070. (value:36; name:'VRECORD'),
  3071. (value:$48; name:''),
  3072. (value:$100; name:'VSTRING'),
  3073. (value:$101; name:'VANY'),
  3074. (value:$2000; name:'VARRAY'),
  3075. (value:$4000; name:'VPOINTER')
  3076. );
  3077. var
  3078. fs: tfieldvarsym;
  3079. lbl: tasmlabel;
  3080. idx: integer;
  3081. begin
  3082. { it could be done with DW_TAG_variant for the union part (if that info was available)
  3083. now we do it manually for variants (MWE) }
  3084. { struct }
  3085. append_entry(DW_TAG_structure_type,true,[
  3086. DW_AT_name,DW_FORM_string,'Variant'#0,
  3087. DW_AT_byte_size,DW_FORM_udata,vardatadef.size
  3088. ]);
  3089. finish_entry;
  3090. append_entry(DW_TAG_variant_part,true,[
  3091. ]);
  3092. current_asmdata.getaddrlabel(lbl);
  3093. append_labelentry_ref(DW_AT_discr,lbl);
  3094. finish_entry;
  3095. { discriminant }
  3096. fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE'));
  3097. if (fs = nil) or (fs.typ <> fieldvarsym) then
  3098. internalerror(200609271);
  3099. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0));
  3100. appendsym_fieldvar(list,fs);
  3101. { variants }
  3102. for idx := Low(VARIANTS) to High(VARIANTS) do
  3103. begin
  3104. append_entry(DW_TAG_variant,true,[
  3105. DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value
  3106. ]);
  3107. finish_entry;
  3108. if VARIANTS[idx].name <> '' then
  3109. begin
  3110. fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name));
  3111. if (fs = nil) or (fs.typ <> fieldvarsym) then
  3112. internalerror(20060927200+idx);
  3113. appendsym_fieldvar(list,fs);
  3114. end;
  3115. finish_children; { variant }
  3116. end;
  3117. finish_children; { variant part }
  3118. finish_children; { struct }
  3119. end;
  3120. function TDebugInfoDwarf3.dwarf_version: Word;
  3121. begin
  3122. Result:=3;
  3123. end;
  3124. function TDebugInfoDwarf3.symname(sym: tsym): String;
  3125. begin
  3126. Result:=sym.realname;
  3127. end;
  3128. {****************************************************************************
  3129. ****************************************************************************}
  3130. const
  3131. dbg_dwarf2_info : tdbginfo =
  3132. (
  3133. id : dbg_dwarf2;
  3134. idtxt : 'DWARF2';
  3135. );
  3136. dbg_dwarf3_info : tdbginfo =
  3137. (
  3138. id : dbg_dwarf3;
  3139. idtxt : 'DWARF3';
  3140. );
  3141. initialization
  3142. RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2);
  3143. RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3);
  3144. end.