dbgdwarf.pas 116 KB

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