dbgdwarf.pas 129 KB

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