dbgdwarf.pas 104 KB

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