dbgdwarf.pas 119 KB

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