dbgdwarf.pas 140 KB

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