dbgdwarf.pas 104 KB

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