dbgdwarf.pas 94 KB

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