dbgdwarf.pas 104 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800
  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. syssym :
  1681. { ignore sys syms, they are only of internal use }
  1682. ;
  1683. absolutevarsym :
  1684. appendsym_absolute(tabsolutevarsym(sym));
  1685. propertysym :
  1686. appendsym_property(tpropertysym(sym));
  1687. else
  1688. begin
  1689. writeln(ord(sym.typ));
  1690. internalerror(200601242);
  1691. end;
  1692. end;
  1693. sym.isdbgwritten:=true;
  1694. end;
  1695. procedure TDebugInfoDwarf.write_symtable_syms(st:TSymtable);
  1696. var
  1697. i : longint;
  1698. sym : tsym;
  1699. old_writing_def_dwarf : boolean;
  1700. begin
  1701. old_writing_def_dwarf:=writing_def_dwarf;
  1702. writing_def_dwarf:=false;
  1703. for i:=0 to st.SymList.Count-1 do
  1704. begin
  1705. sym:=tsym(st.SymList[i]);
  1706. if not(sp_hidden in sym.symoptions) and
  1707. (not sym.isdbgwritten) then
  1708. appendsym(sym);
  1709. end;
  1710. writing_def_dwarf:=old_writing_def_dwarf;
  1711. end;
  1712. procedure TDebugInfoDwarf.insertmoduleinfo;
  1713. var
  1714. templist: TAsmList;
  1715. linelist: TAsmList;
  1716. lbl : tasmlabel;
  1717. n,m : Integer;
  1718. ditem : TDirIndexItem;
  1719. fitem : TFileIndexItem;
  1720. flist : TFPList;
  1721. begin
  1722. { insert .Ltext0 label }
  1723. templist:=TAsmList.create;
  1724. new_section(templist,sec_code,'',0);
  1725. templist.concat(tai_symbol.createname('.Ltext0',AT_DATA,0));
  1726. current_asmdata.asmlists[al_start].insertlist(templist);
  1727. templist.free;
  1728. { insert .Letext0 label }
  1729. templist:=TAsmList.create;
  1730. new_section(templist,sec_code,'',0);
  1731. templist.concat(tai_symbol.createname('.Letext0',AT_DATA,0));
  1732. current_asmdata.asmlists[al_end].insertlist(templist);
  1733. templist.free;
  1734. { insert .Ldebug_abbrev0 label }
  1735. templist:=TAsmList.create;
  1736. new_section(templist,sec_debug_abbrev,'',0);
  1737. templist.concat(tai_symbol.createname('.Ldebug_abbrev0',AT_DATA,0));
  1738. current_asmdata.asmlists[al_start].insertlist(templist);
  1739. templist.free;
  1740. { insert .Ldebug_line0 label }
  1741. templist:=TAsmList.create;
  1742. new_section(templist,sec_debug_line,'',0);
  1743. templist.concat(tai_symbol.createname('.Ldebug_line0',AT_DATA,0));
  1744. current_asmdata.asmlists[al_start].insertlist(templist);
  1745. templist.free;
  1746. { debug line header }
  1747. linelist := current_asmdata.asmlists[al_dwarf_line];
  1748. new_section(linelist,sec_debug_line,'',0);
  1749. linelist.concat(tai_comment.Create(strpnew('=== header start ===')));
  1750. { size }
  1751. current_asmdata.getlabel(lbl,alt_dbgfile);
  1752. { currently we create only 32 bit dwarf }
  1753. linelist.concat(tai_const.create_rel_sym(aitconst_32bit,
  1754. lbl,current_asmdata.RefAsmSymbol('.Ledebug_line0')));
  1755. linelist.concat(tai_label.create(lbl));
  1756. { version }
  1757. linelist.concat(tai_const.create_16bit(dwarf_version));
  1758. { header length }
  1759. current_asmdata.getlabel(lbl,alt_dbgfile);
  1760. { currently we create only 32 bit dwarf }
  1761. linelist.concat(tai_const.create_rel_sym(aitconst_32bit,
  1762. lbl,current_asmdata.RefAsmSymbol('.Lehdebug_line0')));
  1763. linelist.concat(tai_label.create(lbl));
  1764. { minimum_instruction_length }
  1765. linelist.concat(tai_const.create_8bit(1));
  1766. { default_is_stmt }
  1767. linelist.concat(tai_const.create_8bit(1));
  1768. { line_base }
  1769. linelist.concat(tai_const.create_8bit(LINE_BASE));
  1770. { line_range }
  1771. { only line increase, no adress }
  1772. linelist.concat(tai_const.create_8bit(255));
  1773. { opcode_base }
  1774. linelist.concat(tai_const.create_8bit(OPCODE_BASE));
  1775. { standard_opcode_lengths }
  1776. { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) }
  1777. { DW_LNS_copy }
  1778. linelist.concat(tai_const.create_8bit(0));
  1779. { DW_LNS_advance_pc }
  1780. linelist.concat(tai_const.create_8bit(1));
  1781. { DW_LNS_advance_line }
  1782. linelist.concat(tai_const.create_8bit(1));
  1783. { DW_LNS_set_file }
  1784. linelist.concat(tai_const.create_8bit(1));
  1785. { DW_LNS_set_column }
  1786. linelist.concat(tai_const.create_8bit(1));
  1787. { DW_LNS_negate_stmt }
  1788. linelist.concat(tai_const.create_8bit(0));
  1789. { DW_LNS_set_basic_block }
  1790. linelist.concat(tai_const.create_8bit(0));
  1791. { DW_LNS_const_add_pc }
  1792. linelist.concat(tai_const.create_8bit(0));
  1793. { DW_LNS_fixed_advance_pc }
  1794. linelist.concat(tai_const.create_8bit(1));
  1795. { DW_LNS_set_prologue_end }
  1796. linelist.concat(tai_const.create_8bit(0));
  1797. { DW_LNS_set_epilogue_begin }
  1798. linelist.concat(tai_const.create_8bit(0));
  1799. { DW_LNS_set_isa }
  1800. linelist.concat(tai_const.create_8bit(1));
  1801. { Create single list of filenames sorted in IndexNr }
  1802. flist:=TFPList.Create;
  1803. for n := 0 to dirlist.Count - 1 do
  1804. begin
  1805. ditem := TDirIndexItem(dirlist[n]);
  1806. for m := 0 to ditem.Files.Count - 1 do
  1807. flist.Add(ditem.Files[m]);
  1808. end;
  1809. flist.Sort(@FileListSortCompare);
  1810. { include_directories }
  1811. linelist.concat(tai_comment.Create(strpnew('include_directories')));
  1812. for n := 0 to dirlist.Count - 1 do
  1813. begin
  1814. ditem := TDirIndexItem(dirlist[n]);
  1815. if ditem.Name = '.' then
  1816. Continue;
  1817. linelist.concat(tai_string.create(ditem.Name+#0));
  1818. end;
  1819. linelist.concat(tai_const.create_8bit(0));
  1820. { file_names }
  1821. linelist.concat(tai_comment.Create(strpnew('file_names')));
  1822. for n := 0 to flist.Count - 1 do
  1823. begin
  1824. fitem := TFileIndexItem(flist[n]);
  1825. { file name }
  1826. linelist.concat(tai_string.create(fitem.Name+#0));
  1827. { directory index }
  1828. linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex));
  1829. { last modification }
  1830. linelist.concat(tai_const.create_uleb128bit(0));
  1831. { file length }
  1832. linelist.concat(tai_const.create_uleb128bit(0));
  1833. end;
  1834. linelist.concat(tai_const.create_8bit(0));
  1835. { end of debug line header }
  1836. linelist.concat(tai_symbol.createname('.Lehdebug_line0',AT_DATA,0));
  1837. linelist.concat(tai_comment.Create(strpnew('=== header end ===')));
  1838. { add line program }
  1839. linelist.concatList(asmline);
  1840. { end of debug line table }
  1841. linelist.concat(tai_symbol.createname('.Ledebug_line0',AT_DATA,0));
  1842. end;
  1843. procedure TDebugInfoDwarf.inserttypeinfo;
  1844. procedure write_defs_to_write;
  1845. var
  1846. n : integer;
  1847. looplist,
  1848. templist: TFPObjectList;
  1849. def : tdef;
  1850. begin
  1851. templist := TFPObjectList.Create(False);
  1852. looplist := deftowritelist;
  1853. while looplist.count > 0 do
  1854. begin
  1855. deftowritelist := templist;
  1856. for n := 0 to looplist.count - 1 do
  1857. begin
  1858. def := tdef(looplist[n]);
  1859. case def.dbg_state of
  1860. dbg_state_written:
  1861. continue;
  1862. dbg_state_writing:
  1863. internalerror(200610052);
  1864. dbg_state_unused:
  1865. internalerror(200610053);
  1866. dbg_state_used:
  1867. appenddef(def)
  1868. else
  1869. internalerror(200610054);
  1870. end;
  1871. end;
  1872. looplist.clear;
  1873. templist := looplist;
  1874. looplist := deftowritelist;
  1875. end;
  1876. templist.free;
  1877. end;
  1878. var
  1879. storefilepos : tfileposinfo;
  1880. lenstartlabel : tasmlabel;
  1881. i : longint;
  1882. def: tdef;
  1883. begin
  1884. storefilepos:=current_filepos;
  1885. current_filepos:=current_module.mainfilepos;
  1886. currabbrevnumber:=0;
  1887. writing_def_dwarf:=false;
  1888. defnumberlist:=TFPObjectList.create(false);
  1889. deftowritelist:=TFPObjectList.create(false);
  1890. { not exported (FK)
  1891. FILEREC
  1892. TEXTREC
  1893. }
  1894. vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
  1895. { write start labels }
  1896. current_asmdata.asmlists[al_dwarf_info].concat(tai_section.create(sec_debug_info,'',0));
  1897. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname('.Ldebug_info0',AT_DATA,0));
  1898. { start abbrev section }
  1899. new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
  1900. { debug info header }
  1901. current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
  1902. { size }
  1903. { currently we create only 32 bit dwarf }
  1904. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(aitconst_32bit,
  1905. lenstartlabel,current_asmdata.RefAsmSymbol('.Ledebug_info0')));
  1906. current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
  1907. { version }
  1908. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(dwarf_version));
  1909. { abbrev table (=relative from section start)}
  1910. if isdwarf64 then
  1911. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_64bit,
  1912. current_asmdata.RefAsmSymbol('.Ldebug_abbrev0')))
  1913. else
  1914. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_32bit,
  1915. current_asmdata.RefAsmSymbol('.Ldebug_abbrev0')));
  1916. { address size }
  1917. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(aint)));
  1918. append_entry(DW_TAG_compile_unit,true,[
  1919. DW_AT_name,DW_FORM_string,FixFileName(current_module.sourcefiles.get_file(1).name^)+#0,
  1920. DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
  1921. DW_AT_comp_dir,DW_FORM_string,BsToSlash(FixPath(current_module.sourcefiles.get_file(1).path^,false))+#0,
  1922. DW_AT_language,DW_FORM_data1,DW_LANG_Pascal83,
  1923. DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
  1924. { reference to line info section }
  1925. append_labelentry_data(DW_AT_stmt_list,current_asmdata.RefAsmSymbol('.Ldebug_line0'));
  1926. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol('.Ltext0'));
  1927. append_labelentry(DW_AT_high_pc,current_asmdata.RefAsmSymbol('.Letext0'));
  1928. finish_entry;
  1929. { first write all global/local symbols. This will flag all required tdefs }
  1930. if assigned(current_module.globalsymtable) then
  1931. begin
  1932. 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))));
  1933. write_symtable_syms(current_module.globalsymtable);
  1934. 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))));
  1935. end;
  1936. if assigned(current_module.localsymtable) then
  1937. begin
  1938. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable')));
  1939. write_symtable_syms(current_module.localsymtable);
  1940. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Syms - End Staticsymtable')));
  1941. end;
  1942. { reset unit type info flag }
  1943. reset_unit_type_info;
  1944. { write used types from the used units }
  1945. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  1946. { last write the types from this unit }
  1947. if assigned(current_module.globalsymtable) then
  1948. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  1949. if assigned(current_module.localsymtable) then
  1950. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  1951. { write defs not written yet }
  1952. write_defs_to_write;
  1953. { close compilation unit entry }
  1954. finish_children;
  1955. { end of debug info table }
  1956. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1957. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname('.Ledebug_info0',AT_DATA,0));
  1958. { end of abbrev table }
  1959. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  1960. { reset all def labels }
  1961. for i:=0 to defnumberlist.count-1 do
  1962. begin
  1963. def := tdef(defnumberlist[i]);
  1964. if assigned(def) then
  1965. begin
  1966. def.dwarf_lab:=nil;
  1967. def.dbg_state:=dbg_state_unused;
  1968. end;
  1969. end;
  1970. defnumberlist.free;
  1971. defnumberlist:=nil;
  1972. deftowritelist.free;
  1973. deftowritelist:=nil;
  1974. current_filepos:=storefilepos;
  1975. end;
  1976. procedure TDebugInfoDwarf.referencesections(list:TAsmList);
  1977. begin
  1978. end;
  1979. function TDebugInfoDwarf.symname(sym: tsym): String;
  1980. begin
  1981. result := sym.Name;
  1982. end;
  1983. procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
  1984. var
  1985. currfileinfo,
  1986. lastfileinfo : tfileposinfo;
  1987. currfuncname : pshortstring;
  1988. currsectype : TAsmSectiontype;
  1989. hlabel : tasmlabel;
  1990. hp : tai;
  1991. infile : tinputfile;
  1992. current_file : tai_file;
  1993. prevcolumn,
  1994. diffline,
  1995. prevline,
  1996. prevfileidx,
  1997. currfileidx: Integer;
  1998. prevlabel,
  1999. currlabel : tasmlabel;
  2000. begin
  2001. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  2002. currfuncname:=nil;
  2003. currsectype:=sec_code;
  2004. hp:=Tai(list.first);
  2005. prevcolumn := 0;
  2006. prevline := 1;
  2007. prevfileidx := 1;
  2008. prevlabel := nil;
  2009. while assigned(hp) do
  2010. begin
  2011. case hp.typ of
  2012. ait_section :
  2013. currsectype:=tai_section(hp).sectype;
  2014. ait_function_name :
  2015. begin
  2016. currfuncname:=tai_function_name(hp).funcname;
  2017. asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
  2018. end;
  2019. ait_force_line : begin
  2020. lastfileinfo.line:=-1;
  2021. end;
  2022. end;
  2023. if (currsectype=sec_code) and
  2024. (hp.typ=ait_instruction) then
  2025. begin
  2026. currfileinfo:=tailineinfo(hp).fileinfo;
  2027. { file changed ? (must be before line info) }
  2028. if (currfileinfo.fileindex<>0) and
  2029. (lastfileinfo.fileindex<>currfileinfo.fileindex) then
  2030. begin
  2031. infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
  2032. if assigned(infile) then
  2033. begin
  2034. currfileidx := get_file_index(infile);
  2035. if prevfileidx <> currfileidx then
  2036. begin
  2037. list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path^)), hp);
  2038. list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name^)), hp);
  2039. list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp);
  2040. { set file }
  2041. asmline.concat(tai_comment.Create(strpnew('path: '+infile.path^)));
  2042. asmline.concat(tai_comment.Create(strpnew('file: '+infile.name^)));
  2043. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  2044. asmline.concat(tai_const.create_uleb128bit(currfileidx));
  2045. prevfileidx := currfileidx;
  2046. end;
  2047. { force new line info }
  2048. lastfileinfo.line:=-1;
  2049. end;
  2050. end;
  2051. { line changed ? }
  2052. if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
  2053. begin
  2054. { set address }
  2055. current_asmdata.getlabel(currlabel, alt_dbgline);
  2056. list.insertbefore(tai_label.create(currlabel), hp);
  2057. asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']')));
  2058. if prevlabel = nil then
  2059. begin
  2060. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  2061. if isdwarf64 then
  2062. asmline.concat(tai_const.create_uleb128bit(9)) { 1 + 8 }
  2063. else
  2064. asmline.concat(tai_const.create_uleb128bit(5)); { 1 + 4 }
  2065. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  2066. if isdwarf64 then
  2067. asmline.concat(tai_const.create_type_sym(aitconst_64bit, currlabel))
  2068. else
  2069. asmline.concat(tai_const.create_type_sym(aitconst_32bit, currlabel));
  2070. end
  2071. else
  2072. begin
  2073. asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc));
  2074. asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel));
  2075. end;
  2076. prevlabel := currlabel;
  2077. { set column }
  2078. if prevcolumn <> currfileinfo.column then
  2079. begin
  2080. asmline.concat(tai_const.create_8bit(DW_LNS_set_column));
  2081. asmline.concat(tai_const.create_uleb128bit(currfileinfo.column));
  2082. prevcolumn := currfileinfo.column;
  2083. end;
  2084. { set line }
  2085. diffline := currfileinfo.line - prevline;
  2086. if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then
  2087. begin
  2088. { use special opcode, this also adds a row }
  2089. asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE));
  2090. end
  2091. else
  2092. begin
  2093. if diffline <> 0 then
  2094. begin
  2095. asmline.concat(tai_const.create_8bit(DW_LNS_advance_line));
  2096. asmline.concat(tai_const.create_sleb128bit(diffline));
  2097. end;
  2098. { no row added yet, do it manually }
  2099. asmline.concat(tai_const.create_8bit(DW_LNS_copy));
  2100. end;
  2101. prevline := currfileinfo.line;
  2102. end;
  2103. lastfileinfo:=currfileinfo;
  2104. end;
  2105. hp:=tai(hp.next);
  2106. end;
  2107. { end sequence }
  2108. asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op));
  2109. asmline.concat(tai_const.Create_8bit(1));
  2110. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  2111. asmline.concat(tai_comment.Create(strpnew('###################')));
  2112. end;
  2113. {****************************************************************************
  2114. TDebugInfoDwarf2
  2115. ****************************************************************************}
  2116. procedure TDebugInfoDwarf2.appenddef_file(def: tfiledef);
  2117. begin
  2118. { gdb 6.4 doesn't support files so far so we use some fake recorddef
  2119. file recs. are less than 1k so using data2 is enough }
  2120. if assigned(def.typesym) then
  2121. append_entry(DW_TAG_structure_type,false,[
  2122. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2123. DW_AT_byte_size,DW_FORM_udata,def.size
  2124. ])
  2125. else
  2126. append_entry(DW_TAG_structure_type,false,[
  2127. DW_AT_byte_size,DW_FORM_udata,def.size
  2128. ]);
  2129. finish_entry;
  2130. end;
  2131. procedure TDebugInfoDwarf2.appenddef_formal(def: tformaldef);
  2132. begin
  2133. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2134. replace it with a unsigned type with size 0 (FK)
  2135. }
  2136. append_entry(DW_TAG_base_type,false,[
  2137. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2138. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2139. DW_AT_byte_size,DW_FORM_data1,0
  2140. ]);
  2141. finish_entry;
  2142. end;
  2143. procedure TDebugInfoDwarf2.appenddef_object(def: tobjectdef);
  2144. procedure doappend;
  2145. begin
  2146. if assigned(def.objname) then
  2147. append_entry(DW_TAG_structure_type,true,[
  2148. DW_AT_name,DW_FORM_string,def.objname^+#0,
  2149. DW_AT_byte_size,DW_FORM_udata,def.size
  2150. ])
  2151. else
  2152. append_entry(DW_TAG_structure_type,true,[
  2153. DW_AT_byte_size,DW_FORM_udata,def.size
  2154. ]);
  2155. finish_entry;
  2156. if assigned(def.childof) then
  2157. begin
  2158. append_entry(DW_TAG_inheritance,false,[
  2159. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2160. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2161. ]);
  2162. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2163. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2164. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2165. finish_entry;
  2166. end;
  2167. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  2168. finish_children;
  2169. end;
  2170. var
  2171. obj : tasmlabel;
  2172. begin
  2173. case def.objecttype of
  2174. odt_cppclass,
  2175. odt_object:
  2176. doappend;
  2177. odt_interfacecom,
  2178. odt_interfacecorba,
  2179. odt_dispinterface,
  2180. odt_class:
  2181. begin
  2182. current_asmdata.getdatalabel(obj);
  2183. { implicit pointer }
  2184. append_entry(DW_TAG_pointer_type,false,[]);
  2185. append_labelentry_ref(DW_AT_type,obj);
  2186. finish_entry;
  2187. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  2188. doappend;
  2189. end;
  2190. else
  2191. internalerror(200602041);
  2192. end;
  2193. end;
  2194. procedure TDebugInfoDwarf2.appenddef_set(def: tsetdef);
  2195. begin
  2196. { at least gdb up to 6.4 doesn't support sets in dwarf, there is a patch available to fix this:
  2197. http://sources.redhat.com/ml/gdb-patches/2005-05/msg00278.html (FK) }
  2198. if assigned(def.typesym) then
  2199. append_entry(DW_TAG_base_type,false,[
  2200. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2201. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2202. DW_AT_byte_size,DW_FORM_data2,def.size
  2203. ])
  2204. else
  2205. append_entry(DW_TAG_base_type,false,[
  2206. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2207. DW_AT_byte_size,DW_FORM_data2,def.size
  2208. ]);
  2209. finish_entry;
  2210. end;
  2211. procedure TDebugInfoDwarf2.appenddef_unineddef(def: tundefineddef);
  2212. begin
  2213. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  2214. replace it with a unsigned type with size 0 (FK)
  2215. }
  2216. append_entry(DW_TAG_base_type,false,[
  2217. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  2218. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  2219. DW_AT_byte_size,DW_FORM_data1,0
  2220. ]);
  2221. finish_entry;
  2222. end;
  2223. procedure TDebugInfoDwarf2.appenddef_variant(def: tvariantdef);
  2224. begin
  2225. { variants aren't known to dwarf2 but writting tvardata should be enough }
  2226. appenddef_record(trecorddef(vardatadef));
  2227. end;
  2228. function TDebugInfoDwarf2.dwarf_version: Word;
  2229. begin
  2230. Result:=2;
  2231. end;
  2232. {****************************************************************************
  2233. TDebugInfoDwarf3
  2234. ****************************************************************************}
  2235. procedure TDebugInfoDwarf3.appenddef_file(def: tfiledef);
  2236. begin
  2237. if assigned(def.typesym) then
  2238. append_entry(DW_TAG_file_type,false,[
  2239. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2240. DW_AT_byte_size,DW_FORM_data2,def.size
  2241. ])
  2242. else
  2243. append_entry(DW_TAG_file_type,false,[
  2244. DW_AT_byte_size,DW_FORM_data2,def.size
  2245. ]);
  2246. if tfiledef(def).filetyp=ft_typed then
  2247. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef));
  2248. finish_entry;
  2249. end;
  2250. procedure TDebugInfoDwarf3.appenddef_formal(def: tformaldef);
  2251. begin
  2252. append_entry(DW_TAG_unspecified_type,false,[
  2253. ]);
  2254. finish_entry;
  2255. end;
  2256. procedure TDebugInfoDwarf3.appenddef_object(def: tobjectdef);
  2257. procedure dostruct(tag: tdwarf_tag);
  2258. begin
  2259. if assigned(def.objname) then
  2260. append_entry(tag,true,[
  2261. DW_AT_name,DW_FORM_string,def.objrealname^+#0,
  2262. DW_AT_byte_size,DW_FORM_udata,def.size
  2263. ])
  2264. else
  2265. append_entry(DW_TAG_structure_type,true,[
  2266. DW_AT_byte_size,DW_FORM_udata,def.size
  2267. ]);
  2268. finish_entry;
  2269. end;
  2270. procedure doimplicitpointer;
  2271. var
  2272. obj : tasmlabel;
  2273. begin
  2274. current_asmdata.getdatalabel(obj);
  2275. { implicit pointer }
  2276. append_entry(DW_TAG_pointer_type,false,[]);
  2277. append_labelentry_ref(DW_AT_type,obj);
  2278. finish_entry;
  2279. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  2280. end;
  2281. procedure doparent(isinterface: boolean);
  2282. begin
  2283. if not assigned(def.childof) then
  2284. exit;
  2285. if isinterface then
  2286. begin
  2287. append_entry(DW_TAG_inheritance,false,[]);
  2288. end
  2289. else
  2290. begin
  2291. append_entry(DW_TAG_inheritance,false,[
  2292. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  2293. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  2294. ]);
  2295. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2296. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
  2297. end;
  2298. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  2299. finish_entry;
  2300. end;
  2301. var
  2302. n: integer;
  2303. begin
  2304. case def.objecttype of
  2305. odt_cppclass,
  2306. odt_object:
  2307. begin
  2308. dostruct(DW_TAG_structure_type);
  2309. doparent(false);
  2310. end;
  2311. odt_interfacecom,
  2312. odt_interfacecorba,
  2313. odt_dispinterface:
  2314. begin
  2315. dostruct(DW_TAG_interface_type);
  2316. doparent(true);
  2317. end;
  2318. odt_class:
  2319. begin
  2320. { not sure if the implicit pointer is needed for tag_class (MWE)}
  2321. {
  2322. doimplicitpointer;
  2323. }
  2324. dostruct(DW_TAG_class_type);
  2325. doparent(false);
  2326. end;
  2327. else
  2328. internalerror(200609171);
  2329. end;
  2330. { add implemented interfaces }
  2331. if assigned(def.ImplementedInterfaces) then
  2332. for n := 0 to def.ImplementedInterfaces.count-1 do
  2333. begin
  2334. append_entry(DW_TAG_inheritance,false,[]);
  2335. append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef));
  2336. finish_entry;
  2337. end;
  2338. { add members }
  2339. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  2340. finish_children;
  2341. end;
  2342. procedure TDebugInfoDwarf3.appenddef_set(def: tsetdef);
  2343. begin
  2344. if assigned(def.typesym) then
  2345. append_entry(DW_TAG_set_type,false,[
  2346. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  2347. DW_AT_byte_size,DW_FORM_data2,def.size
  2348. ])
  2349. else
  2350. append_entry(DW_TAG_set_type,false,[
  2351. DW_AT_byte_size,DW_FORM_data2,def.size
  2352. ]);
  2353. if assigned(tsetdef(def).elementdef) then
  2354. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tsetdef(def).elementdef));
  2355. finish_entry;
  2356. end;
  2357. procedure TDebugInfoDwarf3.appenddef_unineddef(def: tundefineddef);
  2358. begin
  2359. { ??? can a undefined def have a typename ? }
  2360. if assigned(def.typesym) then
  2361. append_entry(DW_TAG_unspecified_type,false,[
  2362. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0
  2363. ])
  2364. else
  2365. append_entry(DW_TAG_unspecified_type,false,[
  2366. ]);
  2367. finish_entry;
  2368. end;
  2369. procedure TDebugInfoDwarf3.appenddef_variant(def: tvariantdef);
  2370. const
  2371. VARIANTS: array[1..27] of record Value: Word; Name: String end = (
  2372. (value:0; name:''),
  2373. (value:1; name:''),
  2374. (value:2; name:'VSMALLINT'),
  2375. (value:3; name:'VINTEGER'),
  2376. (value:4; name:'VSINGLE'),
  2377. (value:5; name:'VDOUBLE'),
  2378. (value:6; name:'VCURRENCY'),
  2379. (value:7; name:'VDATE'),
  2380. (value:8; name:'VOLESTR'),
  2381. (value:9; name:'VDISPATCH'),
  2382. (value:10; name:'VERROR'),
  2383. (value:11; name:'VBOOLEAN'),
  2384. (value:12; name:''),
  2385. (value:13; name:'VUNKNOWN'),
  2386. (value:14; name:''),
  2387. (value:16; name:'VSHORTINT'),
  2388. (value:17; name:'VBYTE'),
  2389. (value:18; name:'VWORD'),
  2390. (value:19; name:'VLONGWORD'),
  2391. (value:20; name:'VINT64'),
  2392. (value:21; name:'VQWORD'),
  2393. (value:36; name:'VRECORD'),
  2394. (value:$48; name:''),
  2395. (value:$100; name:'VSTRING'),
  2396. (value:$101; name:'VANY'),
  2397. (value:$2000; name:'VARRAY'),
  2398. (value:$4000; name:'VPOINTER')
  2399. );
  2400. var
  2401. fs: tfieldvarsym;
  2402. lbl: tasmlabel;
  2403. idx: integer;
  2404. begin
  2405. { it could be done with DW_TAG_variant for the union part (if that info was available)
  2406. now we do it manually for variants (MWE) }
  2407. { struct }
  2408. append_entry(DW_TAG_structure_type,true,[
  2409. DW_AT_name,DW_FORM_string,'Variant'#0,
  2410. DW_AT_byte_size,DW_FORM_udata,vardatadef.size
  2411. ]);
  2412. finish_entry;
  2413. append_entry(DW_TAG_variant_part,true,[
  2414. ]);
  2415. current_asmdata.getaddrlabel(lbl);
  2416. append_labelentry_ref(DW_AT_discr,lbl);
  2417. finish_entry;
  2418. { discriminant }
  2419. fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE'));
  2420. if (fs = nil) or (fs.typ <> fieldvarsym) then
  2421. internalerror(200609271);
  2422. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0));
  2423. appendsym_fieldvar(fs);
  2424. { variants }
  2425. for idx := Low(VARIANTS) to High(VARIANTS) do
  2426. begin
  2427. append_entry(DW_TAG_variant,true,[
  2428. DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value
  2429. ]);
  2430. finish_entry;
  2431. if VARIANTS[idx].name <> '' then
  2432. begin
  2433. fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name));
  2434. if (fs = nil) or (fs.typ <> fieldvarsym) then
  2435. internalerror(20060927200+idx);
  2436. appendsym_fieldvar(fs);
  2437. end;
  2438. finish_children; { variant }
  2439. end;
  2440. finish_children; { variant part }
  2441. finish_children; { struct }
  2442. end;
  2443. function TDebugInfoDwarf3.dwarf_version: Word;
  2444. begin
  2445. Result:=3;
  2446. end;
  2447. function TDebugInfoDwarf3.symname(sym: tsym): String;
  2448. begin
  2449. Result:=sym.realname;
  2450. end;
  2451. {****************************************************************************
  2452. ****************************************************************************}
  2453. const
  2454. dbg_dwarf2_info : tdbginfo =
  2455. (
  2456. id : dbg_dwarf2;
  2457. idtxt : 'DWARF2';
  2458. );
  2459. dbg_dwarf3_info : tdbginfo =
  2460. (
  2461. id : dbg_dwarf3;
  2462. idtxt : 'DWARF3';
  2463. );
  2464. initialization
  2465. RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2);
  2466. RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3);
  2467. end.