dbgdwarf.pas 134 KB

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