dbgllvm.pas 100 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524
  1. {
  2. Copyright (c) 2021-2022 by Jonas Maebe,
  3. member of the Free Pascal Compiler development team
  4. This units contains support for LLVM 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 LLVM debug info generation.
  20. LLVM debug information is stored as metadata in the LLVM bitcode, and is
  21. loosely based on DWARF (it also reuses some DWARF constants)
  22. }
  23. unit dbgllvm;
  24. {$i fpcdefs.inc}
  25. interface
  26. uses
  27. cclasses,globtype,
  28. cgbase,
  29. aasmbase,aasmtai,aasmdata,aasmcnst,aasmllvmmetadata,
  30. symbase,symconst,symtype,symdef,symsym,
  31. finput,
  32. DbgBase, dbgdwarfconst;
  33. type
  34. TLLVMMetaDefHashSetItem = record
  35. { HashSetItem.Data: LLVM metadata which other types reference when
  36. referring to this type (usually a typedef) }
  37. HashSetItem: THashSetItem;
  38. { in case of a class, the field layout (since a class itself is just a
  39. pointer }
  40. struct_metadef: tai_llvmspecialisedmetadatanode;
  41. { the metadata actually containing the type definition (usually
  42. referenced by HashSetItem.Data), filled in by appenddef_* }
  43. implmetadef: tai_llvmspecialisedmetadatanode;
  44. end;
  45. PLLVMMetaDefHashSetItem = ^TLLVMMetaDefHashSetItem;
  46. TLLVMMetaDefHashSet = class(THashSet)
  47. class function SizeOfItem: Integer; override;
  48. end;
  49. TDebugInfoLLVM = class(TDebugInfo)
  50. strict private
  51. type
  52. tmembercallbackinfo = record
  53. structnode: tai_llvmspecialisedmetadatanode;
  54. list: tasmlist;
  55. end;
  56. pmembercallbackinfo = ^tmembercallbackinfo;
  57. var
  58. { lookup table for def -> LLVMMeta info }
  59. fdefmeta: TLLVMMetaDefHashSet;
  60. { lookup table for file -> LLVMMeta info (DIFile) }
  61. ffilemeta: THashSet;
  62. { lookup table for line,column,scope -> LLVMMeta info (DILocation) }
  63. flocationmeta: THashSet;
  64. { lookup table for scope,file -> LLVMMeta info (DILexicalBlockFile, for include files) }
  65. flexicalblockfilemeta: THashSet;
  66. fcunode: tai_llvmspecialisedmetadatanode;
  67. fenums: tai_llvmunnamedmetadatanode;
  68. fretainedtypes: tai_llvmunnamedmetadatanode;
  69. function absolute_llvm_path(const s:tcmdstr):tcmdstr;
  70. protected
  71. vardatadef: trecorddef;
  72. procedure try_add_file_metaref(dinode: tai_llvmspecialisedmetadatanode; const fileinfo: tfileposinfo; includescope: boolean);
  73. function add_line_metanode(const fileinfo: tfileposinfo): tai_llvmspecialisedmetadatanode;
  74. function def_meta_impl(def: tdef) : tai_llvmspecialisedmetadatanode;
  75. function def_set_meta_impl(def: tdef; meta_impl: tai_llvmspecialisedmetadatanode): tai_llvmspecialisedmetadatanode;
  76. function def_meta_class_struct(def: tobjectdef) : tai_llvmbasemetadatanode;
  77. function def_meta_node(def: tdef): tai_llvmspecialisedmetadatanode;
  78. function def_meta_ref(def: tdef): tai_simpletypedconst;
  79. function file_getmetanode(moduleindex: tfileposmoduleindex; fileindex: tfileposfileindex): tai_llvmspecialisedmetadatanode;
  80. function filepos_getmetanode(const filepos: tfileposinfo; const functionfileinfo: tfileposinfo; const functionscope: tai_llvmspecialisedmetadatanode; nolineinfo: boolean): tai_llvmspecialisedmetadatanode;
  81. function get_def_metatai(def:tdef): PLLVMMetaDefHashSetItem;
  82. procedure appenddef_array_internal(list: TAsmList; fordef: tdef; eledef: tdef; lowrange, highrange: asizeint);
  83. function getabstractprocdeftypes(list: TAsmList; def:tabstractprocdef): tai_llvmbasemetadatanode;
  84. procedure afterappenddef(list: TAsmList; def: tdef); override;
  85. procedure appenddef_ord(list:TAsmList;def:torddef);override;
  86. procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
  87. procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
  88. procedure appenddef_array(list:TAsmList;def:tarraydef);override;
  89. procedure appenddef_record_named(list: TAsmList; fordef: tdef; def: trecorddef; const name: TSymStr);
  90. procedure appenddef_record(list:TAsmList;def:trecorddef);override;
  91. procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
  92. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  93. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  94. procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
  95. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  96. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  97. procedure appenddef_set(list:TAsmList;def:tsetdef); override;
  98. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  99. procedure appenddef_classref(list: TAsmList; def: tclassrefdef); override;
  100. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  101. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  102. function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  103. procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  104. procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: TSymStr; def: tdef; offset: pint(*; const flags: tdwarfvarsymflags*));
  105. { used for fields and properties mapped to fields }
  106. procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
  107. procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
  108. procedure beforeappendsym(list:TAsmList;sym:tsym);override;
  109. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  110. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  111. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  112. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  113. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  114. procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
  115. procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
  116. procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
  117. procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
  118. function symdebugname(sym:tsym): TSymStr;
  119. function symname(sym: tsym; manglename: boolean): TSymStr; virtual;
  120. procedure append_visibility(vis: tvisibility);
  121. procedure enum_membersyms_callback(p:TObject;arg:pointer);
  122. procedure ensuremetainit;
  123. procedure resetfornewmodule;
  124. public
  125. constructor Create;override;
  126. destructor Destroy;override;
  127. procedure insertmoduleinfo;override;
  128. procedure inserttypeinfo;override;
  129. procedure insertlineinfo(list:TAsmList);override;
  130. function dwarf_version: Word; virtual; abstract;
  131. end;
  132. (*
  133. { TDebugInfoDwarf2 }
  134. TDebugInfoDwarf2 = class(TDebugInfoDwarf)
  135. private
  136. protected
  137. procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean);
  138. procedure append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString);
  139. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  140. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  141. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  142. procedure appenddef_set(list:TAsmList;def:tsetdef); override;
  143. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  144. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  145. public
  146. function dwarf_version: Word; override;
  147. end;
  148. { TDebugInfoDwarf3 }
  149. TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
  150. private
  151. protected
  152. procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); override;
  153. procedure appenddef_array(list:TAsmList;def:tarraydef); override;
  154. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  155. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  156. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  157. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  158. procedure appenddef_set(list:TAsmList;def: tsetdef); override;
  159. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  160. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  161. function symdebugname(sym:tsym): String; override;
  162. public
  163. function dwarf_version: Word; override;
  164. end;
  165. *)
  166. implementation
  167. uses
  168. sysutils,cutils,cfileutl,constexp,
  169. version,globals,verbose,systems,
  170. cpubase,cpuinfo,paramgr,
  171. fmodule,
  172. defutil,symtable,symcpu,ppu,
  173. llvminfo,llvmbase,aasmllvm
  174. ;
  175. {
  176. TFileIndexItem = class(TFPHashObject)
  177. private
  178. ffilemeta: tai_llvmspecialisedmetadatanode;
  179. public
  180. constructor Create(AList:TFPHashObjectList; inputfile: TInputFile);
  181. property filemeta: tai_llvmspecialisedmetadatanode read ffilemeta;
  182. end;
  183. }
  184. {$push}
  185. {$scopedenums on}
  186. type
  187. TLLVMDIFlags = (
  188. DIFlagNone = 0,
  189. DIFlagPrivate = 1,
  190. DIFlagProtected = 2,
  191. DIFlagPublic = 3,
  192. DIFlagFwdDecl = 1 shl 2,
  193. DIFlagAppleBlock = 1 shl 3,
  194. DIFlagReservedBit4 = 1 shl 4,
  195. DIFlagVirtual = 1 shl 5,
  196. DIFlagArtificial = 1 shl 6,
  197. DIFlagExplicit = 1 shl 7,
  198. DIFlagPrototyped = 1 shl 8,
  199. DIFlagObjcClassComplete = 1 shl 9,
  200. DIFlagObjectPointer = 1 shl 10,
  201. DIFlagVector = 1 shl 11,
  202. DIFlagStaticMember = 1 shl 12,
  203. DIFlagLValueReference = 1 shl 13,
  204. DIFlagRValueReference = 1 shl 14,
  205. DIFlagReserved = 1 shl 15,
  206. DIFlagSingleInheritance = 1 shl 16,
  207. DIFlagMultipleInheritance = 1 shl 17,
  208. DIFlagVirtualInheritance = 1 shl 18,
  209. DIFlagIntroducedVirtual = 1 shl 19,
  210. DIFlagBitField = 1 shl 20,
  211. DIFlagNoReturn = 1 shl 21,
  212. DIFlagTypePassByValue = 1 shl 22,
  213. DIFlagTypePassByReference = 1 shl 23,
  214. DIFlagEnumClass = 1 shl 24,
  215. DIFlagThunk = 1 shl 25
  216. { introduced/renamed after LLVM 7.0, but nothing we need right now
  217. ,
  218. DIFlagNonTrivial,
  219. DIFlagBigEndian,
  220. DIFlagLittleEndian
  221. }
  222. );
  223. TLLVMDISPFlags = (
  224. DISPFlagVirtual = 1,
  225. DISPFlagPureVirtual = 2,
  226. DISPFlagLocalToUnit = 1 shl 2,
  227. DISPFlagDefinition = 1 shl 3,
  228. DISPFlagOptimized = 1 shl 4,
  229. DISPFlagPure = 1 shl 5,
  230. DISPFlagElemental = 1 shl 6,
  231. DISPFlagRecursive = 1 shl 7,
  232. DISPFlagMainSubprogram = 1 shl 8,
  233. DISPFlagDeleted = 1 shl 9,
  234. DISPFlagObjCDirect = 1 shl 11
  235. );
  236. {$pop}
  237. TLLVMLocationAtom = (
  238. DW_OP_LLVM_fragment = $1000, ///< Only used in LLVM metadata.
  239. DW_OP_LLVM_convert = $1001, ///< Only used in LLVM metadata.
  240. DW_OP_LLVM_tag_offset = $1002, ///< Only used in LLVM metadata.
  241. DW_OP_LLVM_entry_value = $1003, ///< Only used in LLVM metadata.
  242. DW_OP_LLVM_implicit_pointer = $1004, ///< Only used in LLVM metadata.
  243. DW_OP_LLVM_arg = $1005 ///< Only used in LLVM metadata.
  244. );
  245. {****************************************************************************
  246. TLLVMMetaDefHashSet
  247. ****************************************************************************}
  248. class function TLLVMMetaDefHashSet.SizeOfItem: Integer;
  249. begin
  250. Result:=sizeof(TLLVMMetaDefHashSetItem);
  251. end;
  252. {****************************************************************************
  253. TDebugInfoLLVM
  254. ****************************************************************************}
  255. function TDebugInfoLLVM.absolute_llvm_path(const s:tcmdstr):tcmdstr;
  256. begin
  257. { Remove trailing / and ./ prefixes and always use a / }
  258. result:=BsToSlash(ExcludeTrailingPathDelimiter(FixFileName(ExpandFileName(s))));
  259. end;
  260. function TDebugInfoLLVM.get_def_metatai(def:tdef): PLLVMMetaDefHashSetItem;
  261. var
  262. needstructdeflab: boolean;
  263. begin
  264. if def.dbg_state=dbg_state_unused then
  265. def.dbg_state:=dbg_state_used;
  266. { Need a new meta item? }
  267. result:=PLLVMMetaDefHashSetItem(fdefmeta.FindOrAdd(@def,sizeof(def)));
  268. { the other fields besides Data are not initialised }
  269. if not assigned(result^.HashSetItem.Data) then
  270. begin
  271. { will be turned into a pointerdef (in case of Objective-C types) or
  272. typedef later on. We only really need a typedef if this def has
  273. a typesym (to add the name), but it allows us to create a generic
  274. specialised metatype node that can represent any type. Otherwise
  275. we have to duplicate the logic here to determine whether it's a
  276. basic, derived or composite type.
  277. exception: procdefs because we cannot make typedefs for those}
  278. if def.typ<>procdef then
  279. begin
  280. result^.HashSetItem.Data:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
  281. if is_implicit_pointer_object_type(def) then
  282. result^.struct_metadef:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType)
  283. else
  284. result^.struct_metadef:=nil;
  285. result^.implmetadef:=nil;
  286. end
  287. else
  288. begin
  289. result^.HashSetItem.Data:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubprogram);
  290. result^.struct_metadef:=nil;
  291. result^.implmetadef:=nil;
  292. end;
  293. if def.dbg_state=dbg_state_used then
  294. deftowritelist.Add(def);
  295. defnumberlist.Add(def);
  296. end;
  297. end;
  298. procedure TDebugInfoLLVM.appenddef_array_internal(list: TAsmList; fordef: tdef; eledef: tdef; lowrange, highrange: asizeint);
  299. var
  300. dinode,
  301. subrangenode,
  302. exprnode: tai_llvmspecialisedmetadatanode;
  303. arrayrangenode: tai_llvmunnamedmetadatanode;
  304. begin
  305. { range of the array }
  306. subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
  307. { include length }
  308. subrangenode.addqword('lowerBound',lowRange);
  309. if highrange>=0 then
  310. subrangenode.addqword('count',qword(highRange)+1)
  311. else
  312. subrangenode.addint64('count',highRange+1);
  313. list.concat(subrangenode);
  314. { collection containing the one range }
  315. arrayrangenode:=tai_llvmunnamedmetadatanode.create;
  316. arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
  317. list.concat(arrayrangenode);
  318. { the array definition }
  319. dinode:=def_set_meta_impl(fordef,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  320. dinode.addqword('tag',ord(DW_TAG_array_type));
  321. dinode.addmetadatarefto('baseType',def_meta_node(eledef));
  322. dinode.addqword('size',eledef.size*(highrange-lowrange+1)*8);
  323. dinode.addmetadatarefto('elements',arrayrangenode);
  324. list.concat(dinode);
  325. end;
  326. function TDebugInfoLLVM.getabstractprocdeftypes(list: TAsmList; def: tabstractprocdef): tai_llvmbasemetadatanode;
  327. var
  328. types: tai_llvmunnamedmetadatanode;
  329. i: longint;
  330. begin
  331. types:=tai_llvmunnamedmetadatanode.create;
  332. list.concat(types);
  333. { we still need a DISubProgramType in this case, but not the list of types }
  334. if not(cs_debuginfo in current_settings.moduleswitches) then
  335. exit;
  336. if is_void(def.returndef) then
  337. types.addvalue(tai_simpletypedconst.create(llvm_metadatatype,nil))
  338. else
  339. types.addvalue(def_meta_ref(def.returndef));
  340. for i:=0 to def.paras.count-1 do
  341. begin
  342. types.addvalue(def_meta_ref(tparavarsym(def.paras[i]).vardef));
  343. end;
  344. result:=types;
  345. end;
  346. function TDebugInfoLLVM.def_meta_impl(def: tdef): tai_llvmspecialisedmetadatanode;
  347. begin
  348. result:=tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.implmetadef);
  349. end;
  350. function TDebugInfoLLVM.def_set_meta_impl(def: tdef; meta_impl: tai_llvmspecialisedmetadatanode): tai_llvmspecialisedmetadatanode;
  351. begin
  352. tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.implmetadef):=meta_impl;
  353. result:=meta_impl;
  354. end;
  355. function TDebugInfoLLVM.def_meta_class_struct(def: tobjectdef): tai_llvmbasemetadatanode;
  356. begin
  357. result:=tai_llvmbasemetadatanode(get_def_metatai(def)^.struct_metadef);
  358. end;
  359. function TDebugInfoLLVM.def_meta_node(def: tdef): tai_llvmspecialisedmetadatanode;
  360. begin
  361. result:=tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.HashSetItem.Data);
  362. end;
  363. function TDebugInfoLLVM.def_meta_ref(def: tdef): tai_simpletypedconst;
  364. begin
  365. result:=llvm_getmetadatareftypedconst(def_meta_node(def));
  366. end;
  367. constructor TDebugInfoLLVM.Create;
  368. begin
  369. inherited Create;
  370. fenums:=nil;
  371. fretainedtypes:=nil;
  372. fcunode:=nil;
  373. ffilemeta:=thashset.Create(100,true,false);
  374. flocationmeta:=thashset.Create(1000,true,false);
  375. flexicalblockfilemeta:=thashset.Create(100,true,false);
  376. fdefmeta:=TLLVMMetaDefHashSet.Create(10000,true,false);
  377. defnumberlist:=TFPObjectList.create(false);
  378. deftowritelist:=TFPObjectList.create(false);
  379. vardatadef:=nil;
  380. end;
  381. destructor TDebugInfoLLVM.Destroy;
  382. begin
  383. // don't free fenums/fretainedtypes, they get emitted in the assembler list
  384. ffilemeta.free;
  385. ffilemeta:=nil;
  386. flocationmeta.free;
  387. flocationmeta:=nil;
  388. flexicalblockfilemeta.free;
  389. flexicalblockfilemeta:=nil;
  390. fdefmeta.free;
  391. fdefmeta:=nil;
  392. defnumberlist.free;
  393. defnumberlist:=nil;
  394. deftowritelist.free;
  395. deftowritelist:=nil;
  396. fcunode.free;
  397. fcunode:=nil;
  398. inherited Destroy;
  399. end;
  400. procedure TDebugInfoLLVM.enum_membersyms_callback(p:TObject; arg: pointer);
  401. begin
  402. (*
  403. case tsym(p).typ of
  404. fieldvarsym:
  405. appendsym_fieldvar(pmembercallbackinfo(arg)^.list,pmembercallbackinfo(arg)^.structnode,tfieldvarsym(p));
  406. propertysym:
  407. appendsym_property(pmembercallbackinfo(arg)^.list,pmembercallbackinfo(arg)^.structnode,tpropertysym(p));
  408. constsym:
  409. appendsym_const_member(pmembercallbackinfo(arg)^.list,pmembercallbackinfo(arg)^.structnode,tconstsym(p),true);
  410. else
  411. ;
  412. end;
  413. *)
  414. end;
  415. procedure TDebugInfoLLVM.ensuremetainit;
  416. begin
  417. if not assigned(fenums) then
  418. begin
  419. fenums:=tai_llvmunnamedmetadatanode.create;
  420. fretainedtypes:=tai_llvmunnamedmetadatanode.create;
  421. fcunode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompileUnit);
  422. end;
  423. end;
  424. procedure TDebugInfoLLVM.resetfornewmodule;
  425. begin
  426. { for LLVM, we need to generate the procdef type info (or at least
  427. temporary references to it) already during the generation of the line
  428. info (all line info metadata needs a reference to its parent scope,
  429. the procdef). Since the line info is generated per procedure and
  430. the type info only at the end, we can't allocate the type info
  431. structures at the start of the type info generation like for other
  432. debug info producers. Instead, we have to initialise everything in the
  433. constructor, and then reset it at the end of the debug info pass
  434. (inserting the module info) }
  435. ffilemeta.Clear;
  436. flocationmeta.Clear;
  437. flexicalblockfilemeta.Clear;
  438. fdefmeta.Clear;
  439. defnumberlist.Clear;
  440. deftowritelist.Clear;
  441. fcunode:=nil;
  442. fenums:=nil;
  443. fretainedtypes:=nil;
  444. end;
  445. function TDebugInfoLLVM.file_getmetanode(moduleindex: tfileposmoduleindex; fileindex: tfileposfileindex): tai_llvmspecialisedmetadatanode;
  446. var
  447. infile: tinputfile;
  448. dirname: TSymStr;
  449. item: PHashSetItem;
  450. metaitem: tai_llvmspecialisedmetadatanode;
  451. modfileindex: packed record
  452. moduleindex: tfileposmoduleindex;
  453. fileindex: tfileposfileindex;
  454. end;
  455. begin
  456. modfileindex.moduleindex:=moduleindex;
  457. modfileindex.fileindex:=fileindex;
  458. item:=ffilemeta.FindOrAdd(@modfileindex,sizeof(modfileindex));
  459. if not assigned(item^.Data) then
  460. begin
  461. infile:=get_module(moduleindex).sourcefiles.get_file(fileindex);
  462. if not assigned(infile) then
  463. begin
  464. result:=nil;
  465. exit;
  466. end;
  467. if infile.path = '' then
  468. dirname:=absolute_llvm_path('.')
  469. else
  470. begin
  471. { add the canonical form here already to avoid problems with }
  472. { paths such as './' etc }
  473. dirname:=absolute_llvm_path(infile.path);
  474. end;
  475. if dirname='' then
  476. dirname:='.';
  477. metaitem:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIFile);
  478. metaitem.addstring('filename',infile.name);
  479. metaitem.addstring('directory',dirname);
  480. current_asmdata.AsmLists[al_dwarf_line].concat(metaitem);
  481. item^.Data:=metaitem;
  482. end;
  483. result:=tai_llvmspecialisedmetadatanode(item^.Data);
  484. end;
  485. function TDebugInfoLLVM.filepos_getmetanode(const filepos: tfileposinfo; const functionfileinfo: tfileposinfo; const functionscope: tai_llvmspecialisedmetadatanode; nolineinfo: boolean): tai_llvmspecialisedmetadatanode;
  486. var
  487. item: PHashSetItem;
  488. filemeta,
  489. locationscopemeta: tai_llvmspecialisedmetadatanode;
  490. lexicalblockkey: packed record
  491. scopemeta,
  492. filemeta: tai_llvmspecialisedmetadatanode;
  493. end;
  494. locationkey: packed record
  495. scope: tai_llvmspecialisedmetadatanode;
  496. line: tfileposline;
  497. column: tfileposcolumn;
  498. end;
  499. begin
  500. result:=nil;
  501. if (filepos.fileindex<>0) then
  502. filemeta:=file_getmetanode(filepos.moduleindex,filepos.fileindex)
  503. else
  504. filemeta:=file_getmetanode(functionfileinfo.moduleindex,functionfileinfo.fileindex);
  505. if not assigned(filemeta) then
  506. exit;
  507. if (filepos.fileindex<>0) and
  508. (filepos.fileindex<>functionfileinfo.fileindex) then
  509. begin
  510. lexicalblockkey.scopemeta:=functionscope;
  511. lexicalblockkey.filemeta:=filemeta;
  512. item:=flexicalblockfilemeta.FindOrAdd(@lexicalblockkey,sizeof(lexicalblockkey));
  513. if not assigned(item^.Data) then
  514. begin
  515. locationscopemeta:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILexicalBlockFile);
  516. locationscopemeta.addmetadatarefto('scope',functionscope);
  517. locationscopemeta.addmetadatarefto('file',filemeta);
  518. locationscopemeta.addint64('discriminator',0);
  519. current_asmdata.AsmLists[al_dwarf_line].concat(locationscopemeta);
  520. item^.Data:=locationscopemeta;
  521. end
  522. else
  523. locationscopemeta:=tai_llvmspecialisedmetadatanode(item^.Data);
  524. end
  525. else
  526. locationscopemeta:=functionscope;
  527. locationkey.scope:=locationscopemeta;
  528. if not nolineinfo then
  529. begin
  530. locationkey.line:=filepos.line;
  531. locationkey.column:=filepos.column;
  532. end
  533. else
  534. begin
  535. locationkey.line:=0;
  536. locationkey.column:=0;
  537. end;
  538. item:=flocationmeta.FindOrAdd(@locationkey,sizeof(locationkey));
  539. if not assigned(item^.Data) then
  540. begin
  541. result:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILocation);
  542. if not nolineinfo then
  543. begin
  544. result.addqword('line',filepos.line);
  545. result.addqword('column',filepos.column);
  546. end
  547. else
  548. result.addqword('line',0);
  549. result.addmetadatarefto('scope',locationscopemeta);
  550. current_asmdata.AsmLists[al_dwarf_line].concat(result);
  551. item^.Data:=result;
  552. end
  553. else
  554. result:=tai_llvmspecialisedmetadatanode(item^.Data);
  555. end;
  556. procedure TDebugInfoLLVM.try_add_file_metaref(dinode: tai_llvmspecialisedmetadatanode; const fileinfo: tfileposinfo; includescope: boolean);
  557. var
  558. filemeta: tai_llvmbasemetadatanode;
  559. begin
  560. filemeta:=file_getmetanode(fileinfo.moduleindex,fileinfo.fileindex);
  561. if assigned(filemeta) then
  562. begin
  563. if includescope then
  564. begin
  565. dinode.addmetadatarefto('scope',filemeta);
  566. end;
  567. dinode.addmetadatarefto('file',filemeta);
  568. dinode.addqword('line',fileinfo.line);
  569. end;
  570. end;
  571. function TDebugInfoLLVM.add_line_metanode(const fileinfo: tfileposinfo): tai_llvmspecialisedmetadatanode;
  572. var
  573. filemeta: tai_llvmbasemetadatanode;
  574. begin
  575. filemeta:=file_getmetanode(fileinfo.moduleindex,fileinfo.fileindex);
  576. if not assigned(filemeta) then
  577. internalerror(2022041701);
  578. result:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILocation);
  579. result.addqword('line',fileinfo.line);
  580. result.addqword('column',fileinfo.column);
  581. result.addmetadatarefto('scope',filemeta);
  582. current_asmdata.AsmLists[al_dwarf_line].concat(result);
  583. end;
  584. procedure TDebugInfoLLVM.appenddef_ord(list:TAsmList;def:torddef);
  585. var
  586. ordtype: tordtype;
  587. dinode: tai_llvmspecialisedmetadatanode;
  588. begin
  589. ordtype:=def.ordtype;
  590. if ordtype=customint then
  591. ordtype:=range_to_basetype(def.low,def.high);
  592. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIBasicType));
  593. case ordtype of
  594. s8bit,
  595. s16bit,
  596. s32bit,
  597. u8bit,
  598. u16bit,
  599. u32bit,
  600. u64bit,
  601. s64bit,
  602. u128bit,
  603. s128bit:
  604. begin
  605. dinode.addqword('size',def.size*8);
  606. if def.alignment<>def.size then
  607. dinode.addqword('align',def.alignment*8);
  608. { generate proper signed/unsigned info for types like 0..3 }
  609. { these are s8bit, but should be identified as unsigned }
  610. { because otherwise they are interpreted wrongly when used }
  611. { in a bitpacked record }
  612. if def.low<0 then
  613. dinode.addqword('encoding',ord(DW_ATE_signed))
  614. else
  615. dinode.addqword('encoding',ord(DW_ATE_unsigned));
  616. end;
  617. uvoid :
  618. begin
  619. { nothing, must be referenced as "null" in the using declaration }
  620. internalerror(2021111501);
  621. end;
  622. uchar,
  623. uwidechar :
  624. begin
  625. dinode.addqword('size',def.size*8);
  626. dinode.addint64('encoding',ord(DW_ATE_unsigned_char));
  627. end;
  628. pasbool1,
  629. pasbool8,
  630. bool8bit,
  631. pasbool16,
  632. bool16bit,
  633. pasbool32,
  634. bool32bit,
  635. pasbool64,
  636. bool64bit:
  637. begin
  638. dinode.addqword('size',def.size*8);
  639. dinode.addint64('encoding',ord(DW_ATE_boolean));
  640. end;
  641. scurrency:
  642. begin
  643. { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
  644. dinode.addqword('size',def.size*8);
  645. dinode.addint64('encoding',ord(DW_ATE_signed));
  646. end;
  647. customint:
  648. internalerror(2021111502);
  649. end;
  650. list.concat(dinode);
  651. end;
  652. procedure TDebugInfoLLVM.appenddef_float(list:TAsmList;def:tfloatdef);
  653. var
  654. dinode: tai_llvmspecialisedmetadatanode;
  655. begin
  656. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIBasicType));
  657. case def.floattype of
  658. s32real,
  659. s64real,
  660. s80real,
  661. sc80real,
  662. s128real:
  663. begin
  664. dinode.addqword('size',def.size*8);
  665. if def.alignment<>def.size then
  666. dinode.addqword('align',def.alignment*8);
  667. dinode.addint64('encoding',ord(DW_ATE_float));
  668. end;
  669. s64currency:
  670. begin
  671. { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
  672. dinode.addqword('size',def.size*8);
  673. dinode.addint64('encoding',ord(DW_ATE_signed));
  674. end;
  675. s64comp:
  676. begin
  677. { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
  678. dinode.addqword('size',def.size*8);
  679. dinode.addint64('encoding',ord(DW_ATE_signed));
  680. end;
  681. end;
  682. list.concat(dinode);
  683. end;
  684. procedure TDebugInfoLLVM.appenddef_enum(list:TAsmList;def:tenumdef);
  685. var
  686. hp : tenumsym;
  687. i : longint;
  688. dinode: tai_llvmspecialisedmetadatanode;
  689. enumelem: tai_llvmspecialisedmetadatanode;
  690. enumlist: tai_llvmunnamedmetadatanode;
  691. begin
  692. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  693. dinode.addqword('tag',ord(DW_TAG_enumeration_type));
  694. dinode.addqword('size',def.size*8);
  695. dinode.addstring('identifier',def.mangledparaname);
  696. { register in module's list of enums (to ensure the debug info gets
  697. emitted even if the enum is not used in the current module) }
  698. fenums.addvalue(llvm_getmetadatareftypedconst(dinode));
  699. enumlist:=tai_llvmunnamedmetadatanode.create;
  700. { add enum symbols }
  701. for i:=0 to def.symtable.SymList.Count-1 do
  702. begin
  703. hp:=tenumsym(def.symtable.SymList[i]);
  704. if hp.value<def.minval then
  705. continue
  706. else if hp.value>def.maxval then
  707. break;
  708. enumelem:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIEnumerator);
  709. enumelem.addstring('name',symname(hp, false));
  710. enumelem.addint64('value',hp.value);
  711. list.concat(enumelem);
  712. enumlist.addvalue(llvm_getmetadatareftypedconst(enumelem));
  713. end;
  714. if enumlist.valuecount<>0 then
  715. begin
  716. list.concat(enumlist);
  717. dinode.addmetadatarefto('elements',enumlist);
  718. end
  719. else
  720. begin
  721. enumlist.free;
  722. end;
  723. list.concat(dinode);
  724. end;
  725. procedure TDebugInfoLLVM.appenddef_array(list:TAsmList;def:tarraydef);
  726. var
  727. dinode,
  728. subrangenode,
  729. exprnode: tai_llvmspecialisedmetadatanode;
  730. arrayrangenode: tai_llvmunnamedmetadatanode;
  731. size : qword;
  732. nesteddef: tdef;
  733. power: longint;
  734. flags: TLLVMDIFlags;
  735. begin
  736. if is_dynamic_array(def) { and
  737. not(llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion]) } then
  738. begin
  739. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  740. dinode.addqword('tag',ord(DW_TAG_pointer_type));
  741. dinode.addmetadatarefto('baseType',def_meta_node(def.elementdef));
  742. dinode.addqword('size',def.size*8);
  743. list.concat(dinode);
  744. exit;
  745. end;
  746. { open arrays etc need to access the high parameter to define their range,
  747. which is not possible here since we need the parasym rather than the def }
  748. if is_open_array(def) then
  749. begin
  750. if llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion] then
  751. begin
  752. dinode:=def_meta_impl(def);
  753. { should be generated as part of the parasym }
  754. if not assigned(dinode) then
  755. internalerror(2021112002);
  756. end
  757. else
  758. begin
  759. { no idea about the size, generate an array of 1 element -- although it could be empty }
  760. appenddef_array_internal(list,def,def.elementdef,0,1);
  761. end;
  762. exit;
  763. end;
  764. if is_array_of_const(def) then
  765. begin
  766. { no idea about the size, generate an array of 1 element -- although it could be empty }
  767. appenddef_array_internal(list,def,def.elementdef,0,1);
  768. exit;
  769. end;
  770. if is_special_array(def)
  771. and not((llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion]) and
  772. is_dynamic_array(def)) then
  773. internalerror(2021121902);
  774. { todo: proper support for bitpacked arrays }
  775. if is_packed_array(def) and
  776. (((def.elementdef.packedbitsize mod 8)<>0) or
  777. not ispowerof2(def.elementdef.packedbitsize div 8,power)) then
  778. begin
  779. { for now just encode as an array of bytes }
  780. appenddef_array_internal(list,def,u8inttype,0,def.size-1);
  781. exit;
  782. end;
  783. { collection of all ranges of the array (to support multi-dimensional arrays) }
  784. arrayrangenode:=tai_llvmunnamedmetadatanode.create;
  785. list.concat(arrayrangenode);
  786. { range of the array }
  787. subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
  788. if is_dynamic_array(def) then
  789. begin
  790. exprnode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
  791. exprnode.addint64('',ord(DW_OP_push_object_address));
  792. exprnode.addint64('',ord(DW_OP_constu));
  793. exprnode.addint64('',ord(sizeof(pint)));
  794. exprnode.addint64('',ord(DW_OP_minus));
  795. exprnode.addint64('',ord(DW_OP_deref));
  796. list.concat(exprnode);
  797. subrangenode.addmetadatarefto('upperBound',exprnode);
  798. subrangenode.addint64('lowerBound',def.lowrange);
  799. end
  800. else
  801. begin
  802. subrangenode.addqword('count',def.highrange-def.lowrange+1);
  803. subrangenode.addint64('lowerBound',def.lowrange);
  804. end;
  805. list.concat(subrangenode);
  806. nesteddef:=def.elementdef;
  807. arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
  808. while (nesteddef.typ=arraydef) and
  809. not is_special_array(nesteddef) do
  810. begin
  811. subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
  812. subrangenode.addqword('count',tarraydef(nesteddef).highrange-tarraydef(nesteddef).lowrange+1);
  813. subrangenode.addint64('lowerBound',tarraydef(nesteddef).lowrange);
  814. list.concat(subrangenode);
  815. arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
  816. nesteddef:=def.elementdef;
  817. end;
  818. { the array definition }
  819. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  820. dinode.addqword('tag',ord(DW_TAG_array_type));
  821. dinode.addmetadatarefto('baseType',def_meta_node(nesteddef));
  822. dinode.addmetadatarefto('elements',arrayrangenode);
  823. if is_vector(def) then
  824. dinode.addqword('flags',ord(TLLVMDIFlags.DIFlagVector));
  825. if not is_dynamic_array(def) then
  826. dinode.addqword('size',def.size*8)
  827. else
  828. begin
  829. exprnode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
  830. exprnode.addqword('',ord(DW_OP_LLVM_implicit_pointer));
  831. list.concat(exprnode);
  832. dinode.addmetadatarefto('dataLocation',exprnode);
  833. end;
  834. list.concat(dinode);
  835. end;
  836. procedure TDebugInfoLLVM.appenddef_record(list:TAsmList;def:trecorddef);
  837. begin
  838. if assigned(def.objname) then
  839. appenddef_record_named(list,def,def,def.objname^)
  840. else
  841. appenddef_record_named(list,def,def,'');
  842. end;
  843. procedure TDebugInfoLLVM.appenddef_record_named(list:TAsmList; fordef: tdef; def:trecorddef; const name: TSymStr);
  844. var
  845. dinode: tai_llvmspecialisedmetadatanode;
  846. begin
  847. dinode:=def_set_meta_impl(fordef,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  848. dinode.addint64('tag',ord(DW_TAG_structure_type));
  849. if (name<>'') then
  850. dinode.addstring('name',name);
  851. dinode.addqword('size',def.size*8);
  852. list.concat(dinode);
  853. // def.symtable.symList.ForEachCall(@enum_membersyms_callback,dinode);
  854. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
  855. // finish_children;
  856. end;
  857. procedure TDebugInfoLLVM.appenddef_pointer(list:TAsmList;def:tpointerdef);
  858. var
  859. dinode: tai_llvmspecialisedmetadatanode;
  860. begin
  861. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  862. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  863. if not(is_voidpointer(def)) then
  864. dinode.addmetadatarefto('baseType',def_meta_node(def.pointeddef))
  865. else
  866. dinode.addmetadatarefto('baseType',nil);
  867. list.concat(dinode);
  868. end;
  869. procedure TDebugInfoLLVM.appenddef_formal(list: TAsmList; def: tformaldef);
  870. var
  871. dinode: tai_llvmspecialisedmetadatanode;
  872. begin
  873. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  874. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  875. dinode.addmetadatarefto('baseType',nil);
  876. list.concat(dinode);
  877. end;
  878. procedure TDebugInfoLLVM.appenddef_string(list:TAsmList;def:tstringdef);
  879. procedure addnormalstringdef(const name: TSymStr; lendef: tdef; maxlen: asizeuint);
  880. var
  881. dinode,
  882. subrangenode,
  883. exprnode: tai_llvmspecialisedmetadatanode;
  884. arrayrangenode: tai_aggregatetypedconst;
  885. { maxlen can be > high(int64) }
  886. slen : asizeuint;
  887. arr : tasmlabel;
  888. begin
  889. { fix length of openshortstring }
  890. slen:=aword(def.len);
  891. if (slen=0) or
  892. (slen>maxlen) then
  893. slen:=maxlen;
  894. appenddef_array_internal(list,def,cansichartype,0,slen);
  895. end;
  896. var
  897. dinode: tai_llvmspecialisedmetadatanode;
  898. begin
  899. case def.stringtype of
  900. st_shortstring:
  901. begin
  902. addnormalstringdef('ShortString',u8inttype,255);
  903. end;
  904. st_longstring:
  905. begin
  906. { a) we don't actually support variables of this type currently
  907. b) this type is only used as the type for constant strings
  908. > 255 characters
  909. c) in such a case, gdb will allocate and initialise enough
  910. memory to hold the maximum size for such a string
  911. -> don't use high(qword)/high(cardinal) as maximum, since that
  912. will cause exhausting the VM space, but some "reasonably high"
  913. number that should be enough for most constant strings
  914. }
  915. {$ifdef cpu64bitaddr}
  916. addnormalstringdef('LongString',u64inttype,qword(1024*1024));
  917. {$endif cpu64bitaddr}
  918. {$ifdef cpu32bitaddr}
  919. addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
  920. {$endif cpu32bitaddr}
  921. {$ifdef cpu16bitaddr}
  922. addnormalstringdef('LongString',u16inttype,cardinal(1024));
  923. {$endif cpu16bitaddr}
  924. end;
  925. st_ansistring:
  926. begin
  927. // Todo: dynamic length "array"
  928. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  929. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  930. dinode.addmetadatarefto('baseType',def_meta_node(cansichartype));
  931. list.concat(dinode);
  932. end;
  933. st_unicodestring,
  934. st_widestring:
  935. begin
  936. // Todo: dynamic length "array"
  937. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  938. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  939. dinode.addmetadatarefto('baseType',def_meta_node(cwidechartype));
  940. list.concat(dinode);
  941. end;
  942. end;
  943. end;
  944. procedure TDebugInfoLLVM.appenddef_procvar(list:TAsmList;def:tprocvardef);
  945. var
  946. dinode: tai_llvmspecialisedmetadatanode;
  947. begin
  948. { plain pointer for now }
  949. if def.is_addressonly then
  950. begin
  951. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  952. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  953. dinode.addmetadatarefto('baseType',nil);
  954. list.concat(dinode);
  955. end
  956. else
  957. begin
  958. appenddef_array_internal(list,def,voidcodepointertype,1,2);
  959. end;
  960. end;
  961. procedure TDebugInfoLLVM.appenddef_file(list: TAsmList; def: tfiledef);
  962. var
  963. dinode: tai_llvmspecialisedmetadatanode;
  964. begin
  965. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  966. dinode.addint64('tag',ord(DW_TAG_structure_type));
  967. if assigned(def.typesym) then
  968. dinode.addstring('name',symname(def.typesym, false));
  969. dinode.addqword('size',def.size*8);
  970. list.concat(dinode);
  971. end;
  972. procedure TDebugInfoLLVM.appenddef_object(list: TAsmList; def: tobjectdef);
  973. var
  974. dinode: tai_llvmspecialisedmetadatanode;
  975. begin
  976. if is_implicit_pointer_object_type(def) then
  977. begin
  978. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  979. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  980. dinode.addmetadatarefto('baseType',nil);
  981. end
  982. else
  983. begin
  984. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
  985. dinode.addint64('tag',ord(DW_TAG_structure_type));
  986. if assigned(def.typesym) then
  987. dinode.addstring('name',symname(def.typesym, false));
  988. dinode.addqword('size',def.size*8);
  989. end;
  990. list.concat(dinode);
  991. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
  992. end;
  993. procedure TDebugInfoLLVM.appenddef_set(list: TAsmList; def: tsetdef);
  994. begin
  995. appenddef_array_internal(list,def,u8inttype,0,def.size-1);
  996. end;
  997. procedure TDebugInfoLLVM.appenddef_undefined(list: TAsmList; def: tundefineddef);
  998. var
  999. dinode: tai_llvmspecialisedmetadatanode;
  1000. begin
  1001. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  1002. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  1003. dinode.addmetadatarefto('baseType',nil);
  1004. list.concat(dinode);
  1005. end;
  1006. procedure TDebugInfoLLVM.appenddef_classref(list: TAsmList; def: tclassrefdef);
  1007. var
  1008. dinode: tai_llvmspecialisedmetadatanode;
  1009. begin
  1010. dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
  1011. dinode.addint64('tag',ord(DW_TAG_pointer_type));
  1012. dinode.addmetadatarefto('baseType',nil);
  1013. list.concat(dinode);
  1014. end;
  1015. procedure TDebugInfoLLVM.appenddef_variant(list: TAsmList; def: tvariantdef);
  1016. begin
  1017. if assigned(vardatadef) then
  1018. appenddef_record_named(list,def,trecorddef(vardatadef),'Variant');
  1019. end;
  1020. procedure TDebugInfoLLVM.afterappenddef(list:TAsmList;def:tdef);
  1021. var
  1022. tempdinode,
  1023. refdinode,
  1024. impldinode: tai_llvmspecialisedmetadatanode;
  1025. begin
  1026. if def.typ=procdef then
  1027. exit;
  1028. refdinode:=def_meta_node(def);
  1029. if is_objc_class_or_protocol(def) then
  1030. begin
  1031. { for Objective-C classes, the named typedef must refer to the
  1032. struct itself, not to the pointer of the struct; Objective-C
  1033. classes are not implicit pointers in Objective-C itself, only
  1034. in FPC. So make the def label point to a pointer to the
  1035. typedef, which in turn refers to the actual struct (for Delphi-
  1036. style classes, the def points to the typedef, which refers to
  1037. a pointer to the actual struct) }
  1038. { implicit pointer }
  1039. tempdinode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
  1040. refdinode.addint64('tag',ord(DW_TAG_pointer_type));
  1041. refdinode.addmetadatarefto('baseType',tempdinode);
  1042. list.concat(refdinode);
  1043. { typedef }
  1044. refdinode:=tempdinode;
  1045. end;
  1046. refdinode.addint64('tag',ord(DW_TAG_typedef));
  1047. if assigned(def.typesym) and
  1048. not(df_generic in def.defoptions) then
  1049. begin
  1050. refdinode.addstring('name',symname(def.typesym,false));
  1051. try_add_file_metaref(refdinode,def.typesym.fileinfo,false);
  1052. end;
  1053. impldinode:=def_meta_impl(def);
  1054. if not assigned(impldinode) then
  1055. internalerror(2021120501);
  1056. refdinode.addmetadatarefto('baseType',impldinode);
  1057. list.concat(refdinode);
  1058. end;
  1059. procedure TDebugInfoLLVM.appendprocdef(list:TAsmList; def:tprocdef);
  1060. function getdispflags(is_definition: boolean): TSymStr;
  1061. begin
  1062. result:='';
  1063. if is_definition then
  1064. result:='DISPFlagDefinition';
  1065. if (([po_abstractmethod, po_virtualmethod, po_overridingmethod]*def.procoptions)<>[]) and
  1066. not is_objc_class_or_protocol(def.struct) and
  1067. not is_objectpascal_helper(def.struct) then
  1068. begin
  1069. if result<>'' then
  1070. result:=result+'|';
  1071. if not(po_abstractmethod in def.procoptions) then
  1072. result:=result+'DISPFlagVirtual'
  1073. else
  1074. result:=result+'DISPFlagPureVirtual';
  1075. end
  1076. else
  1077. begin
  1078. { this one will always be a definition, so no need to check
  1079. whether result is empty }
  1080. if def.proctypeoption=potype_proginit then
  1081. result:=result+'|DISPFlagMainSubprogram';
  1082. end;
  1083. end;
  1084. var
  1085. dinode,
  1086. ditypenode : tai_llvmspecialisedmetadatanode;
  1087. fileref : tai_simpletypedconst;
  1088. procdeftai : tai;
  1089. st : tsymtable;
  1090. prologfileinfo : pfileposinfo;
  1091. vmtoffset : pint;
  1092. dispflags : TSymStr;
  1093. in_currentunit : boolean;
  1094. begin
  1095. { only write debug info for procedures defined in the current module,
  1096. except in case of methods (clang-compatible)
  1097. }
  1098. in_currentunit:=def.in_currentunit;
  1099. if not in_currentunit and
  1100. not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1101. exit;
  1102. { happens for init procdef of units without init section }
  1103. if in_currentunit and
  1104. not assigned(def.procstarttai) then
  1105. exit;
  1106. { These don't contain a taillvmdecl, they are completely generated
  1107. in native assembly. If we want to add debug information to these,
  1108. we have to do it using the regular debug info generation }
  1109. if po_assembler in def.procoptions then
  1110. exit;
  1111. if df_generic in def.defoptions then
  1112. exit;
  1113. { Procdefs are not handled by the regular def writing code, so
  1114. dbg_state is not set/checked for them. Do it here. }
  1115. if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
  1116. exit;
  1117. defnumberlist.Add(def);
  1118. { we have to attach the debug info to the definition instruction of the
  1119. proc }
  1120. prologfileinfo:=nil;
  1121. procdeftai:=def.procstarttai;
  1122. if in_currentunit then
  1123. begin
  1124. if not assigned(procdeftai) or
  1125. (procdeftai.typ<>ait_llvmdecl) or
  1126. (taillvmdecl(procdeftai).def<>def) then
  1127. internalerror(2022022010);
  1128. end;
  1129. def.dbg_state:=dbg_state_writing;
  1130. { difference compared to other kinds of defs: the DISubProgram gets
  1131. created directly in get_def_metatai because a typedef for a
  1132. DISubProgram does not make sense and is not supported by LLVM ->
  1133. don't set the implementation of the metadata def here and just use
  1134. the regular node }
  1135. dinode:=def_meta_node(def);
  1136. taillvmdecl(procdeftai).addinsmetadata(tai_llvmmetadatareferenceoperand.createreferenceto('dbg',dinode));
  1137. dinode.addstring('name',symdebugname(def.procsym));
  1138. try_add_file_metaref(dinode,def.fileinfo,true);
  1139. if assigned(prologfileinfo) then
  1140. dinode.addint64('scopeLine',prologfileinfo^.line);
  1141. dispflags:=getdispflags(in_currentunit);
  1142. if dispflags<>'' then
  1143. dinode.addenum('spFlags',dispflags);
  1144. dinode.addmetadatarefto('unit',fcunode);
  1145. ditypenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubroutineType);
  1146. ditypenode.addmetadatarefto('types',getabstractprocdeftypes(list,def));
  1147. list.concat(ditypenode);
  1148. dinode.addmetadatarefto('type',ditypenode);
  1149. list.concat(dinode);
  1150. if not(cs_debuginfo in current_settings.moduleswitches) then
  1151. begin
  1152. def.dbg_state:=dbg_state_written;
  1153. exit;
  1154. end;
  1155. (*
  1156. if assigned(def.parast) then
  1157. begin
  1158. { First insert self, because gdb uses the fact whether or not the
  1159. first parameter of a method is artificial to distinguish static
  1160. from regular methods. }
  1161. { fortunately, self is the always the first parameter in the
  1162. paralist, since it has the lowest paranr. Note that this is not
  1163. true for Objective-C, but those methods are detected in
  1164. another way (by reading the ObjC run time information) }
  1165. write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras);
  1166. end;
  1167. { local type defs and vars should not be written
  1168. inside the main proc }
  1169. if in_currentunit and
  1170. assigned(def.localst) and
  1171. (def.localst.symtabletype=localsymtable) then
  1172. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1173. { last write the types from this procdef }
  1174. if assigned(def.parast) then
  1175. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
  1176. { only try to write the localst if the routine is implemented here }
  1177. if in_currentunit and
  1178. assigned(def.localst) and
  1179. (def.localst.symtabletype=localsymtable) then
  1180. begin
  1181. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1182. { Write nested procedures -- disabled, see scope check at the
  1183. beginning; currently, these are still written in the global
  1184. scope. }
  1185. // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1186. end;
  1187. finish_children;
  1188. *)
  1189. def.dbg_state:=dbg_state_written;
  1190. end;
  1191. function TDebugInfoLLVM.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  1192. (*
  1193. var
  1194. elesize : pint;
  1195. currdef : tdef;
  1196. indirection: boolean;
  1197. *)
  1198. begin
  1199. result:=false;
  1200. (*
  1201. if not assigned(symlist) then
  1202. exit;
  1203. sym:=nil;
  1204. offset:=0;
  1205. currdef:=nil;
  1206. indirection:=false;
  1207. repeat
  1208. case symlist^.sltype of
  1209. sl_load:
  1210. begin
  1211. if assigned(sym) then
  1212. internalerror(2009031203);
  1213. if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
  1214. { can't handle... }
  1215. exit;
  1216. sym:=tabstractvarsym(symlist^.sym);
  1217. currdef:=tabstractvarsym(sym).vardef;
  1218. if ((sym.typ=paravarsym) and
  1219. paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then
  1220. indirection:=true;
  1221. end;
  1222. sl_subscript:
  1223. begin
  1224. if not assigned(currdef) then
  1225. internalerror(2009031301);
  1226. if (symlist^.sym.typ<>fieldvarsym) then
  1227. internalerror(2009031202);
  1228. { can't handle offsets with indirections yet }
  1229. if indirection then
  1230. exit;
  1231. if is_packed_record_or_object(currdef) then
  1232. begin
  1233. { can't calculate the address of a non-byte aligned field }
  1234. if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then
  1235. exit;
  1236. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8)
  1237. end
  1238. else
  1239. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset);
  1240. currdef:=tfieldvarsym(symlist^.sym).vardef;
  1241. end;
  1242. sl_absolutetype,
  1243. sl_typeconv:
  1244. begin
  1245. currdef:=symlist^.def;
  1246. { ignore, these don't change the address }
  1247. end;
  1248. sl_vec:
  1249. begin
  1250. if not assigned(currdef) or
  1251. (currdef.typ<>arraydef) then
  1252. internalerror(2009031201);
  1253. { can't handle offsets with indirections yet }
  1254. if indirection then
  1255. exit;
  1256. if not is_packed_array(currdef) then
  1257. elesize:=tarraydef(currdef).elesize
  1258. else
  1259. begin
  1260. elesize:=tarraydef(currdef).elepackedbitsize;
  1261. { can't calculate the address of a non-byte aligned element }
  1262. if (elesize mod 8)<>0 then
  1263. exit;
  1264. elesize:=elesize div 8;
  1265. end;
  1266. inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
  1267. currdef:=tarraydef(currdef).elementdef;
  1268. end;
  1269. else
  1270. internalerror(2009031403);
  1271. end;
  1272. symlist:=symlist^.next;
  1273. until not assigned(symlist);
  1274. if not assigned(sym) then
  1275. internalerror(2009031205);
  1276. result:=true;
  1277. *)
  1278. end;
  1279. procedure TDebugInfoLLVM.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  1280. begin
  1281. // appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]);
  1282. end;
  1283. procedure TDebugInfoLLVM.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: TSymStr; def: tdef; offset: pint(*; const flags: tdwarfvarsymflags*));
  1284. (*
  1285. var
  1286. templist : TAsmList;
  1287. blocksize,size_of_int : longint;
  1288. tag : tdwarf_tag;
  1289. has_high_reg : boolean;
  1290. dreg,dreghigh : shortint;
  1291. {$ifdef i8086}
  1292. has_segment_sym_name : boolean=false;
  1293. segment_sym_name : TSymStr='';
  1294. segment_reg: TRegister=NR_NO;
  1295. {$endif i8086}
  1296. *)
  1297. begin
  1298. (*
  1299. if vo_is_external in sym.varoptions then
  1300. exit;
  1301. blocksize:=0;
  1302. dreghigh:=0;
  1303. { There is no space allocated for not referenced locals }
  1304. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  1305. exit;
  1306. templist:=TAsmList.create;
  1307. case sym.localloc.loc of
  1308. LOC_REGISTER,
  1309. LOC_CREGISTER,
  1310. LOC_MMREGISTER,
  1311. LOC_CMMREGISTER,
  1312. LOC_FPUREGISTER,
  1313. LOC_CFPUREGISTER :
  1314. begin
  1315. { dwarf_reg_no_error might return -1
  1316. in case the register variable has been optimized out }
  1317. dreg:=dwarf_reg_no_error(sym.localloc.register);
  1318. has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO);
  1319. if has_high_reg then
  1320. dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi);
  1321. if dreghigh=-1 then
  1322. has_high_reg:=false;
  1323. if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  1324. (sym.typ=paravarsym) and
  1325. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1326. not(vo_has_local_copy in sym.varoptions) and
  1327. not is_open_string(sym.vardef) and (dreg>=0) then
  1328. begin
  1329. templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
  1330. templist.concat(tai_const.create_uleb128bit(dreg));
  1331. templist.concat(tai_const.create_sleb128bit(0));
  1332. blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(0);
  1333. end
  1334. else
  1335. begin
  1336. if has_high_reg then
  1337. begin
  1338. templist.concat(tai_comment.create(strpnew('high:low reg pair variable')));
  1339. size_of_int:=sizeof(aint);
  1340. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1341. templist.concat(tai_const.create_uleb128bit(dreg));
  1342. blocksize:=1+Lengthuleb128(dreg);
  1343. templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
  1344. templist.concat(tai_const.create_uleb128bit(size_of_int));
  1345. blocksize:=blocksize+1+Lengthuleb128(size_of_int);
  1346. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1347. templist.concat(tai_const.create_uleb128bit(dreghigh));
  1348. blocksize:=blocksize+1+Lengthuleb128(dreghigh);
  1349. templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
  1350. templist.concat(tai_const.create_uleb128bit(size_of_int));
  1351. blocksize:=blocksize+1+Lengthuleb128(size_of_int);
  1352. end
  1353. else if (dreg>=0) then
  1354. begin
  1355. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1356. templist.concat(tai_const.create_uleb128bit(dreg));
  1357. blocksize:=1+Lengthuleb128(dreg);
  1358. end;
  1359. end;
  1360. end;
  1361. else
  1362. begin
  1363. case sym.typ of
  1364. staticvarsym:
  1365. begin
  1366. if vo_is_thread_var in sym.varoptions then
  1367. begin
  1368. if tf_section_threadvars in target_info.flags then
  1369. begin
  1370. case sizeof(puint) of
  1371. 2:
  1372. templist.concat(tai_const.create_8bit(ord(DW_OP_const2u)));
  1373. 4:
  1374. templist.concat(tai_const.create_8bit(ord(DW_OP_const4u)));
  1375. 8:
  1376. templist.concat(tai_const.create_8bit(ord(DW_OP_const8u)));
  1377. else
  1378. Internalerror(2019100501);
  1379. end;
  1380. {$push}
  1381. {$warn 6018 off} { Unreachable code due to compile time evaluation }
  1382. templist.concat(tai_const.Create_type_name(aitconst_dtpoff,sym.mangledname,0));
  1383. { so far, aitconst_dtpoff is solely 32 bit }
  1384. if (sizeof(puint)=8) and (target_info.endian=endian_little) then
  1385. templist.concat(tai_const.create_32bit(0));
  1386. templist.concat(tai_const.create_8bit(ord(DW_OP_GNU_push_tls_address)));
  1387. if (sizeof(puint)=8) and (target_info.endian=endian_big) then
  1388. templist.concat(tai_const.create_32bit(0));
  1389. {$pop}
  1390. blocksize:=2+sizeof(puint);
  1391. end
  1392. else
  1393. begin
  1394. { TODO: !!! FIXME: dwarf for thread vars !!!}
  1395. { This is only a minimal change to at least be able to get a value
  1396. in only one thread is present PM 2014-11-21, like for stabs format }
  1397. templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
  1398. templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,
  1399. offset+sizeof(pint)));
  1400. blocksize:=1+sizeof(puint);
  1401. end;
  1402. end
  1403. else
  1404. begin
  1405. templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
  1406. templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset));
  1407. blocksize:=1+sizeof(puint);
  1408. {$ifdef i8086}
  1409. segment_sym_name:=sym.mangledname;
  1410. has_segment_sym_name:=true;
  1411. {$endif i8086}
  1412. end;
  1413. end;
  1414. paravarsym,
  1415. localvarsym:
  1416. begin
  1417. { Happens when writing debug info for paras of procdefs not
  1418. implemented in the current module. Can't add a general check
  1419. for LOC_INVALID above, because staticvarsyms may also have it.
  1420. }
  1421. if sym.localloc.loc<> LOC_INVALID then
  1422. begin
  1423. if is_fbreg(sym.localloc.reference.base) then
  1424. begin
  1425. templist.concat(tai_const.create_8bit(ord(DW_OP_fbreg)));
  1426. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  1427. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
  1428. end
  1429. else
  1430. begin
  1431. dreg:=dwarf_reg(sym.localloc.reference.base);
  1432. if dreg<=31 then
  1433. begin
  1434. templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  1435. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  1436. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
  1437. end
  1438. else
  1439. begin
  1440. templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
  1441. templist.concat(tai_const.create_uleb128bit(dreg));
  1442. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  1443. blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(sym.localloc.reference.offset+offset);
  1444. end;
  1445. end;
  1446. {$ifdef i8086}
  1447. segment_reg:=sym.localloc.reference.segment;
  1448. {$endif i8086}
  1449. {$ifndef gdb_supports_DW_AT_variable_parameter}
  1450. { Parameters which are passed by reference. (var and the like)
  1451. Hide the reference-pointer and dereference the pointer
  1452. in the DW_AT_location block.
  1453. }
  1454. if (sym.typ=paravarsym) and
  1455. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1456. not(vo_has_local_copy in sym.varoptions) and
  1457. not is_open_string(sym.vardef) then
  1458. begin
  1459. templist.concat(tai_const.create_8bit(ord(DW_OP_deref)));
  1460. inc(blocksize);
  1461. end
  1462. {$endif not gdb_supports_DW_AT_variable_parameter}
  1463. end;
  1464. end
  1465. else
  1466. internalerror(200601288);
  1467. end;
  1468. end;
  1469. end;
  1470. { function results must not be added to the parameter list,
  1471. as they are not part of the signature of the function
  1472. (gdb automatically adds them according to the ABI specifications
  1473. when calling the function)
  1474. }
  1475. if (sym.typ=paravarsym) and
  1476. not(dvf_force_local_var in flags) and
  1477. not(vo_is_funcret in sym.varoptions) then
  1478. tag:=DW_TAG_formal_parameter
  1479. else
  1480. tag:=DW_TAG_variable;
  1481. { must be parasym of externally implemented procdef, but
  1482. the parasymtable can con also contain e.g. absolutevarsyms
  1483. -> check symtabletype}
  1484. if (sym.owner.symtabletype=parasymtable) and
  1485. (sym.localloc.loc=LOC_INVALID) then
  1486. begin
  1487. if (sym.owner.symtabletype<>parasymtable) then
  1488. internalerror(2009101001);
  1489. append_entry(tag,false,[
  1490. DW_AT_name,DW_FORM_string,name+#0
  1491. {
  1492. DW_AT_decl_file,DW_FORM_data1,0,
  1493. DW_AT_decl_line,DW_FORM_data1,
  1494. }
  1495. ])
  1496. end
  1497. else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
  1498. LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  1499. ((sym.owner.symtabletype = globalsymtable) or
  1500. (sp_static in sym.symoptions) or
  1501. (vo_is_public in sym.varoptions)) then
  1502. append_entry(tag,false,[
  1503. DW_AT_name,DW_FORM_string,name+#0,
  1504. {
  1505. DW_AT_decl_file,DW_FORM_data1,0,
  1506. DW_AT_decl_line,DW_FORM_data1,
  1507. }
  1508. DW_AT_external,DW_FORM_flag,true,
  1509. { data continues below }
  1510. DW_AT_location,DW_FORM_block1,blocksize
  1511. ])
  1512. {$ifdef gdb_supports_DW_AT_variable_parameter}
  1513. else if (sym.typ=paravarsym) and
  1514. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1515. not(vo_has_local_copy in sym.varoptions) and
  1516. not is_open_string(sym.vardef) then
  1517. append_entry(tag,false,[
  1518. DW_AT_name,DW_FORM_string,name+#0,
  1519. DW_AT_variable_parameter,DW_FORM_flag,true,
  1520. {
  1521. DW_AT_decl_file,DW_FORM_data1,0,
  1522. DW_AT_decl_line,DW_FORM_data1,
  1523. }
  1524. { data continues below }
  1525. DW_AT_location,DW_FORM_block1,blocksize
  1526. ])
  1527. {$endif gdb_supports_DW_AT_variable_parameter}
  1528. else
  1529. append_entry(tag,false,[
  1530. DW_AT_name,DW_FORM_string,name+#0,
  1531. {
  1532. DW_AT_decl_file,DW_FORM_data1,0,
  1533. DW_AT_decl_line,DW_FORM_data1,
  1534. }
  1535. { data continues below }
  1536. DW_AT_location,DW_FORM_block1,blocksize
  1537. ]);
  1538. { append block data }
  1539. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1540. { Mark self as artificial for methods, because gdb uses the fact
  1541. whether or not the first parameter of a method is artificial to
  1542. distinguish regular from static methods (since there are no
  1543. no vo_is_self parameters for static methods, we don't have to check
  1544. that). }
  1545. if (vo_is_self in sym.varoptions) then
  1546. append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
  1547. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1548. {$ifdef i8086}
  1549. if has_segment_sym_name then
  1550. append_seg_name(segment_sym_name)
  1551. else if segment_reg<>NR_NO then
  1552. append_seg_reg(segment_reg);
  1553. {$endif i8086}
  1554. templist.free;
  1555. finish_entry;
  1556. *)
  1557. end;
  1558. procedure TDebugInfoLLVM.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  1559. begin
  1560. appendsym_var(list,sym);
  1561. end;
  1562. procedure TDebugInfoLLVM.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  1563. begin
  1564. appendsym_var(list,sym);
  1565. end;
  1566. procedure TDebugInfoLLVM.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  1567. begin
  1568. appendsym_var(list,sym);
  1569. end;
  1570. procedure TDebugInfoLLVM.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  1571. begin
  1572. appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0);
  1573. end;
  1574. procedure TDebugInfoLLVM.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
  1575. var
  1576. bitoffset,
  1577. fieldoffset,
  1578. fieldnatsize: asizeint;
  1579. begin
  1580. (*
  1581. if (sp_static in sym.symoptions) or
  1582. (sym.visibility=vis_hidden) then
  1583. exit;
  1584. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
  1585. { only ordinals are bitpacked }
  1586. not is_ordinal(sym.vardef) then
  1587. begin
  1588. { other kinds of fields can however also appear in a bitpacked }
  1589. { record, and then their offset is also specified in bits rather }
  1590. { than in bytes }
  1591. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
  1592. fieldoffset:=sym.fieldoffset
  1593. else
  1594. fieldoffset:=sym.fieldoffset div 8;
  1595. inc(fieldoffset,offset);
  1596. append_entry(DW_TAG_member,false,[
  1597. DW_AT_name,DW_FORM_string,name+#0,
  1598. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  1599. ]);
  1600. end
  1601. else
  1602. begin
  1603. if (sym.vardef.packedbitsize > 255) then
  1604. internalerror(2007061201);
  1605. { we don't bitpack according to the ABI, but as close as }
  1606. { possible, i.e., equivalent to gcc's }
  1607. { __attribute__((__packed__)), which is also what gpc }
  1608. { does. }
  1609. fieldnatsize:=max(sizeof(pint),sym.vardef.size);
  1610. fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
  1611. inc(fieldoffset,offset);
  1612. bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
  1613. if (target_info.endian=endian_little) then
  1614. bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
  1615. append_entry(DW_TAG_member,false,[
  1616. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  1617. { gcc also generates both a bit and byte size attribute }
  1618. { we don't support ordinals >= 256 bits }
  1619. DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
  1620. { nor >= 256 bits (not yet, anyway, see IE above) }
  1621. DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
  1622. { data1 and data2 are unsigned, bitoffset can also be negative }
  1623. DW_AT_bit_offset,DW_FORM_data4,bitoffset,
  1624. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  1625. ]);
  1626. end;
  1627. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1628. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
  1629. if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1630. append_visibility(sym.visibility);
  1631. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1632. finish_entry;
  1633. *)
  1634. end;
  1635. procedure TDebugInfoLLVM.appendsym_const(list:TAsmList;sym:tconstsym);
  1636. begin
  1637. appendsym_const_member(list,sym,false);
  1638. end;
  1639. procedure TDebugInfoLLVM.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
  1640. var
  1641. i,
  1642. size: aint;
  1643. usedef: tdef;
  1644. begin
  1645. (*
  1646. { These are default values of parameters. These should be encoded
  1647. via DW_AT_default_value, not as a separate sym. Moreover, their
  1648. type is not available when writing the debug info for external
  1649. procedures.
  1650. }
  1651. if (sym.owner.symtabletype=parasymtable) then
  1652. exit;
  1653. if ismember then
  1654. append_entry(DW_TAG_member,false,[
  1655. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  1656. { The DW_AT_declaration tag is invalid according to the DWARF specifications.
  1657. But gcc adds this to static const members and gdb checks
  1658. for this flag. So we have to set it also.
  1659. }
  1660. DW_AT_declaration,DW_FORM_flag,true,
  1661. DW_AT_external,DW_FORM_flag,true
  1662. ])
  1663. else
  1664. append_entry(DW_TAG_variable,false,[
  1665. DW_AT_name,DW_FORM_string,symname(sym, false)+#0
  1666. ]);
  1667. { for string constants, constdef isn't set because they have no real type }
  1668. case sym.consttyp of
  1669. conststring:
  1670. begin
  1671. { if DW_FORM_string is used below one day, this usedef should
  1672. probably become nil }
  1673. { note: < 255 instead of <= 255 because we have to store the
  1674. entire length of the string as well, and 256 does not fit in
  1675. a byte }
  1676. if (sym.value.len<255) then
  1677. usedef:=cshortstringtype
  1678. else
  1679. usedef:=clongstringtype;
  1680. end;
  1681. constresourcestring,
  1682. constwstring:
  1683. usedef:=nil;
  1684. else
  1685. usedef:=sym.constdef;
  1686. end;
  1687. if assigned(usedef) then
  1688. append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef));
  1689. AddConstToAbbrev(ord(DW_AT_const_value));
  1690. case sym.consttyp of
  1691. conststring:
  1692. begin
  1693. { DW_FORM_string isn't supported yet by the Pascal value printer
  1694. -> create a string using raw bytes }
  1695. if (sym.value.len<255) then
  1696. begin
  1697. AddConstToAbbrev(ord(DW_FORM_block1));
  1698. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len+1));
  1699. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len));
  1700. end
  1701. else
  1702. begin
  1703. AddConstToAbbrev(ord(DW_FORM_block));
  1704. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizesinttype.size));
  1705. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_sizeint_unaligned(sym.value.len));
  1706. end;
  1707. i:=0;
  1708. size:=sym.value.len;
  1709. while(i<size) do
  1710. begin
  1711. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
  1712. inc(i);
  1713. end;
  1714. end;
  1715. constguid,
  1716. constset:
  1717. begin
  1718. AddConstToAbbrev(ord(DW_FORM_block1));
  1719. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(usedef.size));
  1720. i:=0;
  1721. size:=sym.constdef.size;
  1722. while (i<size) do
  1723. begin
  1724. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
  1725. inc(i);
  1726. end;
  1727. end;
  1728. constwstring,
  1729. constresourcestring:
  1730. begin
  1731. { write dummy for now }
  1732. AddConstToAbbrev(ord(DW_FORM_string));
  1733. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
  1734. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  1735. end;
  1736. constord:
  1737. begin
  1738. if (sym.value.valueord<0) then
  1739. begin
  1740. AddConstToAbbrev(ord(DW_FORM_sdata));
  1741. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
  1742. end
  1743. else
  1744. begin
  1745. AddConstToAbbrev(ord(DW_FORM_udata));
  1746. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.valueord.uvalue));
  1747. end;
  1748. end;
  1749. constnil:
  1750. begin
  1751. {$ifdef cpu64bitaddr}
  1752. AddConstToAbbrev(ord(DW_FORM_data8));
  1753. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(0));
  1754. {$else cpu64bitaddr}
  1755. AddConstToAbbrev(ord(DW_FORM_data4));
  1756. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(0));
  1757. {$endif cpu64bitaddr}
  1758. end;
  1759. constpointer:
  1760. begin
  1761. {$ifdef cpu64bitaddr}
  1762. AddConstToAbbrev(ord(DW_FORM_data8));
  1763. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(int64(sym.value.valueordptr)));
  1764. {$else cpu64bitaddr}
  1765. AddConstToAbbrev(ord(DW_FORM_data4));
  1766. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint(sym.value.valueordptr)));
  1767. {$endif cpu64bitaddr}
  1768. end;
  1769. constreal:
  1770. begin
  1771. AddConstToAbbrev(ord(DW_FORM_block1));
  1772. case tfloatdef(sym.constdef).floattype of
  1773. s32real:
  1774. begin
  1775. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
  1776. current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^));
  1777. end;
  1778. s64real:
  1779. begin
  1780. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  1781. current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^));
  1782. end;
  1783. s64comp,
  1784. s64currency:
  1785. begin
  1786. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  1787. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(trunc(pbestreal(sym.value.valueptr)^)));
  1788. end;
  1789. s80real,
  1790. sc80real:
  1791. begin
  1792. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
  1793. current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size));
  1794. end;
  1795. else
  1796. internalerror(200601291);
  1797. end;
  1798. end;
  1799. else
  1800. internalerror(200601292);
  1801. end;
  1802. finish_entry;
  1803. *)
  1804. end;
  1805. procedure TDebugInfoLLVM.appendsym_label(list:TAsmList;sym: tlabelsym);
  1806. begin
  1807. { ignore label syms for now, the problem is that a label sym
  1808. can have more than one label associated e.g. in case of
  1809. an inline procedure expansion }
  1810. end;
  1811. procedure TDebugInfoLLVM.appendsym_property(list:TAsmList;sym: tpropertysym);
  1812. var
  1813. symlist: ppropaccesslistitem;
  1814. tosym: tabstractvarsym;
  1815. offset: pint;
  1816. begin
  1817. (*
  1818. if assigned(sym.propaccesslist[palt_read]) and
  1819. not assigned(sym.propaccesslist[palt_read].procdef) then
  1820. symlist:=sym.propaccesslist[palt_read].firstsym
  1821. else
  1822. { can't handle }
  1823. exit;
  1824. if not get_symlist_sym_offset(symlist,tosym,offset) then
  1825. exit;
  1826. if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1827. begin
  1828. if (tosym.typ=fieldvarsym) then
  1829. internalerror(2009031404);
  1830. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[])
  1831. end
  1832. else
  1833. appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset)
  1834. *)
  1835. end;
  1836. function TDebugInfoLLVM.symdebugname(sym: tsym): TSymStr;
  1837. begin
  1838. result:=sym.RealName;
  1839. if (result<>'') and
  1840. (result[1]='$') then
  1841. delete(result,1,1);
  1842. end;
  1843. procedure TDebugInfoLLVM.appendsym_type(list:TAsmList;sym: ttypesym);
  1844. begin
  1845. { just queue the def if needed, beforeappenddef will
  1846. emit the typedef if necessary }
  1847. get_def_metatai(sym.typedef);
  1848. {
  1849. if FindUnitSymtable(sym.Owner).iscurrentunit then
  1850. fretainedtypes.addvalue(def_meta_ref(sym.typedef));
  1851. }
  1852. end;
  1853. procedure TDebugInfoLLVM.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  1854. (*
  1855. var
  1856. templist : TAsmList;
  1857. blocksize : longint;
  1858. symlist : ppropaccesslistitem;
  1859. tosym: tabstractvarsym;
  1860. offset: pint;
  1861. flags: tdwarfvarsymflags;
  1862. *)
  1863. begin
  1864. (*
  1865. templist:=TAsmList.create;
  1866. case tabsolutevarsym(sym).abstyp of
  1867. toaddr :
  1868. begin
  1869. { MWE: replaced ifdef i368 }
  1870. {
  1871. if target_cpu = cpu_i386 then
  1872. begin
  1873. { in theory, we could write a DW_AT_segment entry here for sym.absseg,
  1874. however I doubt that gdb supports this (FK) }
  1875. end;
  1876. }
  1877. templist.concat(tai_const.create_8bit(3));
  1878. {$ifdef avr}
  1879. // Add $800000 to indicate that the address is in memory space
  1880. templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset + $800000, aitconst_ptr_unaligned));
  1881. {$else}
  1882. templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset));
  1883. {$endif}
  1884. blocksize:=1+sizeof(puint);
  1885. end;
  1886. toasm :
  1887. begin
  1888. templist.concat(tai_const.create_8bit(3));
  1889. templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0));
  1890. blocksize:=1+sizeof(puint);
  1891. end;
  1892. tovar:
  1893. begin
  1894. symlist:=tabsolutevarsym(sym).ref.firstsym;
  1895. if get_symlist_sym_offset(symlist,tosym,offset) then
  1896. begin
  1897. if (tosym.typ=fieldvarsym) then
  1898. internalerror(2009031402);
  1899. flags:=[];
  1900. if (sym.owner.symtabletype=localsymtable) then
  1901. include(flags,dvf_force_local_var);
  1902. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags);
  1903. end;
  1904. templist.free;
  1905. exit;
  1906. end;
  1907. end;
  1908. append_entry(DW_TAG_variable,false,[
  1909. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  1910. {
  1911. DW_AT_decl_file,DW_FORM_data1,0,
  1912. DW_AT_decl_line,DW_FORM_data1,
  1913. }
  1914. DW_AT_external,DW_FORM_flag,true,
  1915. { data continues below }
  1916. DW_AT_location,DW_FORM_block1,blocksize
  1917. ]);
  1918. { append block data }
  1919. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1920. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  1921. templist.free;
  1922. finish_entry;
  1923. *)
  1924. end;
  1925. procedure TDebugInfoLLVM.beforeappendsym(list:TAsmList;sym:tsym);
  1926. begin
  1927. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true))));
  1928. end;
  1929. procedure TDebugInfoLLVM.insertmoduleinfo;
  1930. var
  1931. culist: tai_llvmnamedmetadatanode;
  1932. dwarfversionflag: tai_llvmbasemetadatanode;
  1933. lang: tdwarf_source_language;
  1934. objcruntimeversion: longint;
  1935. begin
  1936. if (ds_dwarf_cpp in current_settings.debugswitches) then
  1937. lang:=DW_LANG_C_plus_plus
  1938. else
  1939. lang:=DW_LANG_Pascal83;
  1940. { debug info header }
  1941. fcunode.addint64('language',ord(lang));
  1942. fcunode.addmetadatarefto('file',file_getmetanode(current_filepos.moduleindex,current_filepos.fileindex));
  1943. fcunode.addstring('producer','Free Pascal Compiler '+full_version_string);
  1944. fcunode.addboolean('isOptimized',cs_opt_level2 in current_settings.optimizerswitches);
  1945. if target_info.system in systems_objc_supported then
  1946. begin
  1947. if ([m_objectivec1,m_objectivec2]*current_settings.modeswitches)<>[] then
  1948. if target_info.system in systems_objc_nfabi then
  1949. objcruntimeversion:=2
  1950. else
  1951. objcruntimeversion:=1
  1952. else
  1953. objcruntimeversion:=0;
  1954. fcunode.addint64('runtimeVersion',objcruntimeversion);
  1955. end;
  1956. if cs_debuginfo in current_settings.moduleswitches then
  1957. fcunode.addenum('emissionKind','FullDebug')
  1958. else
  1959. fcunode.addenum('emissionKind','LineTablesOnly');
  1960. if fenums.valuecount<>0 then
  1961. begin
  1962. fcunode.addmetadatarefto('enums',fenums);
  1963. current_asmdata.AsmLists[al_dwarf_info].Concat(fenums);
  1964. end
  1965. else
  1966. begin
  1967. fcunode.addmetadatarefto('enums',nil);
  1968. fenums.free;
  1969. fenums:=nil;
  1970. end;
  1971. if fretainedtypes.valuecount<>0 then
  1972. begin
  1973. fcunode.addmetadatarefto('retainedTypes',fretainedtypes);
  1974. current_asmdata.AsmLists[al_dwarf_info].Concat(fretainedtypes);
  1975. end
  1976. else
  1977. begin
  1978. fcunode.addmetadatarefto('retainedTypes',nil);
  1979. fretainedtypes.free;
  1980. fretainedtypes:=nil;
  1981. end;
  1982. if target_info.system in systems_darwin then
  1983. fcunode.addenum('nameTableKind','GNU');
  1984. current_asmdata.AsmLists[al_dwarf_info].Concat(fcunode);
  1985. culist:=tai_llvmnamedmetadatanode.create('llvm.dbg.cu');
  1986. current_asmdata.AsmLists[al_dwarf_info].Concat(culist);
  1987. culist.addvalue(llvm_getmetadatareftypedconst(fcunode));
  1988. resetfornewmodule;
  1989. end;
  1990. procedure TDebugInfoLLVM.inserttypeinfo;
  1991. var
  1992. storefilepos : tfileposinfo;
  1993. i : longint;
  1994. (*
  1995. lenstartlabel,arangestartlabel: tasmlabel;
  1996. *)
  1997. def: tdef;
  1998. (*
  1999. dbgname: string;
  2000. *)
  2001. vardatatype: ttypesym;
  2002. (*
  2003. bind: tasmsymbind;
  2004. *)
  2005. begin
  2006. (*
  2007. // FIXME
  2008. include(current_module.moduleflags,mf_has_dwarf_debuginfo);
  2009. storefilepos:=current_filepos;
  2010. current_filepos:=current_module.mainfilepos;
  2011. if assigned(fdefmeta) then
  2012. internalerror(2015100301);
  2013. { one item per def, plus some extra space in case of nested types,
  2014. externally used types etc (it will grow further if necessary) }
  2015. i:=current_module.localsymtable.DefList.count*4;
  2016. if assigned(current_module.globalsymtable) then
  2017. inc(i,current_module.globalsymtable.DefList.count*2);
  2018. fdefmeta:=TLLVMMetaDefHashSet.Create(i,true,false);
  2019. defnumberlist:=TFPObjectList.create(false);
  2020. deftowritelist:=TFPObjectList.create(false);
  2021. { not exported (FK)
  2022. FILEREC
  2023. TEXTREC
  2024. }
  2025. *)
  2026. vardatatype:=try_search_system_type('TVARDATA');
  2027. if assigned(vardatatype) then
  2028. vardatadef:=trecorddef(vardatatype.typedef);
  2029. (*
  2030. current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
  2031. { size }
  2032. if use_64bit_headers then
  2033. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
  2034. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
  2035. lenstartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_info0',AB_LOCAL,AT_METADATA,voidpointertype)));
  2036. current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
  2037. { version }
  2038. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(dwarf_version));
  2039. { abbrev table (=relative from section start)}
  2040. if not(tf_dwarf_relative_addresses in target_info.flags) then
  2041. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,
  2042. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)))
  2043. else
  2044. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
  2045. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0',AB_LOCAL,AT_METADATA,voidpointertype),
  2046. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)));
  2047. { address size }
  2048. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint)));
  2049. { first manadatory compilation unit TAG }
  2050. append_entry(DW_TAG_compile_unit,true,[
  2051. DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path+current_module.sourcefiles.get_file(1).name)+#0,
  2052. DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
  2053. DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0,
  2054. DW_AT_language,DW_FORM_data1,lang,
  2055. DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
  2056. {$ifdef i8086}
  2057. case current_settings.x86memorymodel of
  2058. mm_tiny,
  2059. mm_small:
  2060. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_small]);
  2061. mm_medium:
  2062. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_medium]);
  2063. mm_compact:
  2064. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_compact]);
  2065. mm_large:
  2066. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_large]);
  2067. mm_huge:
  2068. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_huge]);
  2069. end;
  2070. {$endif i8086}
  2071. { reference to line info section }
  2072. if not(tf_dwarf_relative_addresses in target_info.flags) then
  2073. append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype))
  2074. else
  2075. append_labelentry_dataptr_rel(DW_AT_stmt_list,
  2076. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_linesection0',AB_LOCAL,AT_METADATA,voidpointertype),
  2077. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype));
  2078. if (m_objectivec1 in current_settings.modeswitches) then
  2079. append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]);
  2080. if target_info.system in systems_wasm then
  2081. begin
  2082. append_attribute(DW_AT_low_pc,DW_FORM_data4,[0]);
  2083. { todo: append DW_AT_ranges }
  2084. end
  2085. else
  2086. begin
  2087. dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
  2088. if (target_info.system in systems_darwin) then
  2089. begin
  2090. bind:=AB_LOCAL;
  2091. dbgname:='L'+dbgname;
  2092. end
  2093. else
  2094. bind:=AB_GLOBAL;
  2095. append_labelentry(DW_AT_low_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
  2096. dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
  2097. if (target_info.system in systems_darwin) then
  2098. dbgname:='L'+dbgname;
  2099. append_labelentry(DW_AT_high_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
  2100. end;
  2101. finish_entry;
  2102. { write all global/local variables. This will flag all required tdefs }
  2103. if assigned(current_module.globalsymtable) then
  2104. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2105. if assigned(current_module.localsymtable) then
  2106. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2107. *)
  2108. { write all procedures and methods. This will flag all required tdefs }
  2109. if assigned(current_module.globalsymtable) then
  2110. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2111. if assigned(current_module.localsymtable) then
  2112. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2113. { reset unit type info flag }
  2114. reset_unit_type_info;
  2115. { write used types from the used units }
  2116. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  2117. { last write the types from this unit }
  2118. if assigned(current_module.globalsymtable) then
  2119. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  2120. if assigned(current_module.localsymtable) then
  2121. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  2122. { write defs not written yet }
  2123. write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]);
  2124. (*
  2125. { close compilation unit entry }
  2126. finish_children;
  2127. { end of debug info table }
  2128. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_METADATA,0,voidpointertype));
  2129. { end of abbrev table }
  2130. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  2131. if not(target_info.system in systems_darwin) then
  2132. begin
  2133. { end of aranges table }
  2134. {$ifdef i8086}
  2135. { 32-bit offset }
  2136. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
  2137. { 16-bit segment }
  2138. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
  2139. { 32-bit length }
  2140. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
  2141. {$else i8086}
  2142. { offset }
  2143. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
  2144. { length }
  2145. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
  2146. {$endif i8086}
  2147. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_symbol.createname(target_asm.labelprefix+'earanges0',AT_METADATA,0,voidpointertype));
  2148. end;
  2149. *)
  2150. { reset all def debug states }
  2151. for i:=0 to defnumberlist.count-1 do
  2152. begin
  2153. def := tdef(defnumberlist[i]);
  2154. if assigned(def) then
  2155. def.dbg_state:=dbg_state_unused;
  2156. end;
  2157. (*
  2158. fdefmeta.free;
  2159. fdefmeta:=nil;
  2160. defnumberlist.free;
  2161. defnumberlist:=nil;
  2162. deftowritelist.free;
  2163. deftowritelist:=nil;
  2164. current_filepos:=storefilepos;
  2165. *)
  2166. end;
  2167. function TDebugInfoLLVM.symname(sym: tsym; manglename: boolean): TSymStr;
  2168. begin
  2169. if (sym.typ=paravarsym) and
  2170. (vo_is_self in tparavarsym(sym).varoptions) then
  2171. { We use 'this' for regular methods because that's what gdb triggers
  2172. on to automatically search fields. Don't do this for class methods,
  2173. because search class fields is not supported, and gdb 7.0+ fails
  2174. in this case because "this" is not a record in that case (it's a
  2175. pointer to a vmt) }
  2176. if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and
  2177. not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
  2178. result:='this'
  2179. else
  2180. result:='self'
  2181. else if (sym.typ=typesym) and
  2182. is_objc_class_or_protocol(ttypesym(sym).typedef) then
  2183. result:=tobjectdef(ttypesym(sym).typedef).objextname^
  2184. else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
  2185. (sym.typ=procsym) and
  2186. (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
  2187. begin
  2188. result:=tprocsym(sym).owner.name^+'__';
  2189. if manglename then
  2190. result := result + sym.name
  2191. else
  2192. result := result + symdebugname(sym);
  2193. end
  2194. else
  2195. begin
  2196. if manglename then
  2197. result := sym.name
  2198. else
  2199. result := symdebugname(sym);
  2200. end;
  2201. end;
  2202. procedure TDebugInfoLLVM.append_visibility(vis: tvisibility);
  2203. begin
  2204. (*
  2205. case vis of
  2206. vis_hidden,
  2207. vis_private,
  2208. vis_strictprivate:
  2209. append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]);
  2210. vis_protected,
  2211. vis_strictprotected:
  2212. append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]);
  2213. vis_published,
  2214. vis_public:
  2215. { default };
  2216. vis_none:
  2217. internalerror(2019050720);
  2218. end;
  2219. *)
  2220. end;
  2221. procedure TDebugInfoLLVM.insertlineinfo(list:TAsmList);
  2222. var
  2223. hp: tai;
  2224. functionscope,
  2225. positionmeta: tai_llvmspecialisedmetadatanode;
  2226. procdeffileindex: tfileposfileindex;
  2227. nolineinfolevel : longint;
  2228. begin
  2229. ensuremetainit;
  2230. hp:=tai(list.first);
  2231. while assigned(hp) and
  2232. ((hp.typ<>ait_llvmdecl) or
  2233. (taillvmdecl(hp).def.typ<>procdef)) do
  2234. begin
  2235. hp:=tai(hp.next);
  2236. end;
  2237. if not assigned(hp) then
  2238. exit;
  2239. procdeffileindex:=tprocdef(taillvmdecl(hp).def).fileinfo.fileindex;
  2240. { might trigger for certain kinds of internally generated code }
  2241. if procdeffileindex=0 then
  2242. exit;
  2243. functionscope:=def_meta_node(taillvmdecl(hp).def);
  2244. nolineinfolevel:=0;
  2245. hp:=tai(hp.next);
  2246. while assigned(hp) do
  2247. begin
  2248. case hp.typ of
  2249. ait_marker:
  2250. begin
  2251. case tai_marker(hp).kind of
  2252. mark_NoLineInfoStart:
  2253. inc(nolineinfolevel);
  2254. mark_NoLineInfoEnd:
  2255. dec(nolineinfolevel);
  2256. else
  2257. ;
  2258. end;
  2259. end;
  2260. else
  2261. ;
  2262. end;
  2263. if (hp.typ=ait_llvmins) and
  2264. ((nolineinfolevel=0) or
  2265. (taillvm(hp).llvmopcode=la_call)) then
  2266. begin
  2267. positionmeta:=nil;
  2268. { valid file -> add info }
  2269. if (tailineinfo(hp).fileinfo.fileindex<>0) then
  2270. begin
  2271. positionmeta:=filepos_getmetanode(tailineinfo(hp).fileinfo,procdeffileinfo,functionscope,nolineinfolevel<>0);
  2272. end
  2273. else if taillvm(hp).llvmopcode=la_call then
  2274. begin
  2275. positionmeta:=filepos_getmetanode(tailineinfo(hp).fileinfo,procdeffileinfo,functionscope,true);
  2276. end;
  2277. if assigned(positionmeta) then
  2278. taillvm(hp).addinsmetadata(tai_llvmmetadatareferenceoperand.createreferenceto('dbg',positionmeta));
  2279. end;
  2280. hp:=tai(hp.next);
  2281. end;
  2282. end;
  2283. {****************************************************************************
  2284. ****************************************************************************}
  2285. const
  2286. dbg_llvm_info : tdbginfo =
  2287. (
  2288. id : dbg_llvm;
  2289. idtxt : 'LLVM';
  2290. );
  2291. initialization
  2292. RegisterDebugInfo(dbg_llvm_info,TDebugInfoLLVM);
  2293. end.