dbgdwarf.pas 104 KB

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