dbgdwarf.pas 104 KB

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