12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957 |
- {
- Copyright (c) 2021-2022 by Jonas Maebe,
- member of the Free Pascal Compiler development team
- This units contains support for LLVM debug info generation
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- {
- This units contains support for LLVM debug info generation.
- LLVM debug information is stored as metadata in the LLVM bitcode, and is
- loosely based on DWARF (it also reuses some DWARF constants)
- }
- unit dbgllvm;
- {$i fpcdefs.inc}
- interface
- uses
- cclasses,globtype,
- cgbase,
- aasmbase,aasmtai,aasmdata,aasmcnst,aasmllvm,aasmllvmmetadata,
- symbase,symconst,symtype,symdef,symsym,
- finput,
- DbgBase, dbgdwarfconst;
- type
- TLLVMMetaDefHashSetItem = record
- { HashSetItem.Data: LLVM metadata which other types reference when
- referring to this type (usually a typedef) }
- HashSetItem: THashSetItem;
- { in case of a class, the field layout (since a class itself is just a
- pointer }
- struct_metadef: tai_llvmspecialisedmetadatanode;
- { the metadata actually containing the type definition (usually
- referenced by HashSetItem.Data), filled in by appenddef_* }
- implmetadef: tai_llvmspecialisedmetadatanode;
- end;
- PLLVMMetaDefHashSetItem = ^TLLVMMetaDefHashSetItem;
- TLLVMMetaDefHashSet = class(THashSet)
- class function SizeOfItem: Integer; override;
- end;
- TDebugInfoLLVM = class(TDebugInfo)
- strict private
- var
- { lookup table for def -> LLVMMeta info }
- fdefmeta: TLLVMMetaDefHashSet;
- { lookup table for file -> LLVMMeta info (DIFile) }
- ffilemeta: THashSet;
- { lookup table for line,column,scope -> LLVMMeta info (DILocation) }
- flocationmeta: THashSet;
- { lookup table for scope,file -> LLVMMeta info (DILexicalBlockFile, for include files) }
- flexicalblockfilemeta: THashSet;
- { lookup table for tstaticvarsym -> taillvmdecl }
- fstaticvarsymdecl: THashSet;
- { lookup table for local/paravarsym -> metadata }
- flocalvarsymmeta: THashSet;
- fcunode: tai_llvmspecialisedmetadatanode;
- fenums: tai_llvmunnamedmetadatanode;
- fretainedtypes: tai_llvmunnamedmetadatanode;
- fglobals: tai_llvmunnamedmetadatanode;
- { reusable empty expression node }
- femptyexpression,
- { reusable deref node }
- fderefexpression : tai_llvmspecialisedmetadatanode;
- fllvm_dbg_addr_pd: tprocdef;
- function absolute_llvm_path(const s:tcmdstr):tcmdstr;
- protected
- vardatadef: trecorddef;
- procedure try_add_file_metaref(dinode: tai_llvmspecialisedmetadatanode; const fileinfo: tfileposinfo; includescope: boolean);
- function add_line_metanode(const fileinfo: tfileposinfo): tai_llvmspecialisedmetadatanode;
- function def_meta_impl(def: tdef) : tai_llvmspecialisedmetadatanode;
- function def_set_meta_impl(def: tdef; meta_impl: tai_llvmspecialisedmetadatanode): tai_llvmspecialisedmetadatanode;
- function def_meta_class_struct(def: tobjectdef) : tai_llvmspecialisedmetadatanode;
- function def_meta_node(def: tdef): tai_llvmspecialisedmetadatanode;
- function def_meta_ref(def: tdef): tai_simpletypedconst;
- function file_getmetanode(moduleindex: tfileposmoduleindex; fileindex: tfileposfileindex): tai_llvmspecialisedmetadatanode;
- function filepos_getmetanode(const filepos: tfileposinfo; const functionfileinfo: tfileposinfo; const functionscope: tai_llvmspecialisedmetadatanode; nolineinfo: boolean): tai_llvmspecialisedmetadatanode;
- function get_def_metatai(def:tdef): PLLVMMetaDefHashSetItem;
- procedure staticvarsym_set_decl(sym: tsym; decl: taillvmdecl);
- function staticvarsym_get_decl(sym: tsym): taillvmdecl;
- function localvarsym_get_meta(sym: tsym; out is_new: boolean): tai_llvmspecialisedmetadatanode;
- procedure appenddef_array_internal(list: TAsmList; fordef: tdef; eledef: tdef; lowrange, highrange: asizeint);
- function getabstractprocdeftypes(list: TAsmList; def:tabstractprocdef): tai_llvmbasemetadatanode;
- procedure afterappenddef(list: TAsmList; def: tdef); override;
- procedure appenddef_ord(list:TAsmList;def:torddef);override;
- procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
- procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
- procedure appenddef_array(list:TAsmList;def:tarraydef);override;
- procedure appenddef_record_named(list: TAsmList; fordef: tdef; def: trecorddef; const name: TSymStr);
- procedure appenddef_struct_named(list: TAsmList; def: tabstractrecorddef; structdi: tai_llvmspecialisedmetadatanode; initialfieldlist: tai_llvmunnamedmetadatanode; const name: TSymStr);
- procedure appenddef_struct_fields(list: TAsmlist; def: tabstractrecorddef; defdinode: tai_llvmspecialisedmetadatanode; initialfieldlist: tai_llvmunnamedmetadatanode; cappedsize: asizeuint);
- procedure appenddef_record(list:TAsmList;def:trecorddef);override;
- procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
- procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
- procedure appenddef_string(list:TAsmList;def:tstringdef);override;
- procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
- procedure appenddef_file(list:TAsmList;def:tfiledef); override;
- procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
- procedure appenddef_set(list:TAsmList;def:tsetdef); override;
- procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
- procedure appenddef_classref(list: TAsmList; def: tclassrefdef); override;
- procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
- procedure appendprocdef(list:TAsmList;def:tprocdef);override;
- procedure adddefinitionlocal(dinode: tai_llvmspecialisedmetadatanode; definition, local, usedispflags: boolean; out dispFlags: tsymstr);
- function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
- procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
- procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: TSymStr; def: tdef; offset: pint(*; const flags: tdwarfvarsymflags*));
- { used for fields and properties mapped to fields }
- procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
- procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
- procedure beforeappendsym(list:TAsmList;sym:tsym);override;
- procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
- procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
- procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
- procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
- procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
- procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
- procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
- procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
- procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
- function symdebugname(sym:tsym): TSymStr;
- function symname(sym: tsym; manglename: boolean): TSymStr; virtual;
- function visibilitydiflag(vis: tvisibility): TSymStr;
- procedure ensuremetainit;
- procedure resetfornewmodule;
- procedure collectglobalsyms;
- procedure updatelocalvardbginfo(hp: taillvm; pd: tprocdef; functionscope: tai_llvmspecialisedmetadatanode);
- public
- constructor Create;override;
- destructor Destroy;override;
- procedure insertmoduleinfo;override;
- procedure inserttypeinfo;override;
- procedure insertlineinfo(list:TAsmList);override;
- function dwarf_version: Word; virtual; abstract;
- end;
- implementation
- uses
- sysutils,cutils,cfileutl,constexp,
- version,globals,verbose,systems,
- cpubase,cpuinfo,paramgr,
- fmodule,
- defutil,symtable,symcpu,ppu,
- llvminfo,llvmbase
- ;
- {$push}
- {$scopedenums on}
- type
- TLLVMDIFlags = (
- DIFlagNone = 0,
- DIFlagPrivate = 1,
- DIFlagProtected = 2,
- DIFlagPublic = 3,
- DIFlagFwdDecl = 1 shl 2,
- DIFlagAppleBlock = 1 shl 3,
- DIFlagReservedBit4 = 1 shl 4,
- { virtual inheritance at the C++ struct level, not at method level; use the SPFlag for that virtual methods) }
- DIFlagVirtual = 1 shl 5,
- DIFlagArtificial = 1 shl 6,
- DIFlagExplicit = 1 shl 7,
- DIFlagPrototyped = 1 shl 8,
- DIFlagObjcClassComplete = 1 shl 9,
- DIFlagObjectPointer = 1 shl 10,
- DIFlagVector = 1 shl 11,
- DIFlagStaticMember = 1 shl 12,
- DIFlagLValueReference = 1 shl 13,
- DIFlagRValueReference = 1 shl 14,
- DIFlagReserved = 1 shl 15,
- DIFlagSingleInheritance = 1 shl 16,
- DIFlagMultipleInheritance = 1 shl 17,
- DIFlagVirtualInheritance = 1 shl 18,
- DIFlagIntroducedVirtual = 1 shl 19,
- DIFlagBitField = 1 shl 20,
- DIFlagNoReturn = 1 shl 21,
- { at the type level, DWARF 5 DW_CC_pass_by_value }
- DIFlagTypePassByValue = 1 shl 22,
- { at the type level, DWARF 5 DW_CC_pass_by_reference }
- DIFlagTypePassByReference = 1 shl 23,
- DIFlagEnumClass = 1 shl 24,
- DIFlagThunk = 1 shl 25,
- { moved to DISPFlags in LLVM 8.0 }
- DIFlagMainSubprogram_Deprecated = 1 shl 21
- { introduced/renamed after LLVM 7.0, but nothing we need right now
- ,
- DIFlagNonTrivial,
- DIFlagBigEndian,
- DIFlagLittleEndian
- }
- );
- TLLVMDISPFlags = (
- DISPFlagVirtual = 1,
- DISPFlagPureVirtual = 2,
- DISPFlagLocalToUnit = 1 shl 2,
- DISPFlagDefinition = 1 shl 3,
- DISPFlagOptimized = 1 shl 4,
- DISPFlagPure = 1 shl 5,
- DISPFlagElemental = 1 shl 6,
- DISPFlagRecursive = 1 shl 7,
- DISPFlagMainSubprogram = 1 shl 8,
- DISPFlagDeleted = 1 shl 9,
- DISPFlagObjCDirect = 1 shl 11
- );
- {$pop}
- TLLVMLocationAtom = (
- DW_OP_LLVM_fragment = $1000, ///< Only used in LLVM metadata.
- DW_OP_LLVM_convert = $1001, ///< Only used in LLVM metadata.
- DW_OP_LLVM_tag_offset = $1002, ///< Only used in LLVM metadata.
- DW_OP_LLVM_entry_value = $1003, ///< Only used in LLVM metadata.
- DW_OP_LLVM_implicit_pointer = $1004, ///< Only used in LLVM metadata.
- DW_OP_LLVM_arg = $1005 ///< Only used in LLVM metadata.
- );
- {****************************************************************************
- TLLVMMetaDefHashSet
- ****************************************************************************}
- class function TLLVMMetaDefHashSet.SizeOfItem: Integer;
- begin
- Result:=sizeof(TLLVMMetaDefHashSetItem);
- end;
- {****************************************************************************
- TDebugInfoLLVM
- ****************************************************************************}
- function TDebugInfoLLVM.absolute_llvm_path(const s:tcmdstr):tcmdstr;
- begin
- { Remove trailing / and ./ prefixes and always use a / }
- result:=BsToSlash(ExcludeTrailingPathDelimiter(FixFileName(ExpandFileName(s))));
- end;
- function TDebugInfoLLVM.get_def_metatai(def:tdef): PLLVMMetaDefHashSetItem;
- var
- needstructdeflab: boolean;
- begin
- if def.dbg_state=dbg_state_unused then
- def.dbg_state:=dbg_state_used;
- { Need a new meta item? }
- result:=PLLVMMetaDefHashSetItem(fdefmeta.FindOrAdd(@def,sizeof(def)));
- { the other fields besides Data are not initialised }
- if not assigned(result^.HashSetItem.Data) then
- begin
- { will be turned into a pointerdef (in case of Objective-C types) or
- typedef later on. We only really need a typedef if this def has
- a typesym (to add the name), but it allows us to create a generic
- specialised metatype node that can represent any type. Otherwise
- we have to duplicate the logic here to determine whether it's a
- basic, derived or composite type.
- exception: procdefs because we cannot make typedefs for those}
- if def.typ<>procdef then
- begin
- result^.HashSetItem.Data:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
- if is_implicit_pointer_object_type(def) then
- result^.struct_metadef:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType)
- else
- result^.struct_metadef:=nil;
- result^.implmetadef:=nil;
- end
- else
- begin
- result^.HashSetItem.Data:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubprogram);
- result^.struct_metadef:=nil;
- result^.implmetadef:=nil;
- end;
- if def.dbg_state=dbg_state_used then
- deftowritelist.Add(def);
- defnumberlist.Add(def);
- end;
- end;
- procedure TDebugInfoLLVM.staticvarsym_set_decl(sym: tsym; decl: taillvmdecl);
- var
- entry: PHashSetItem;
- begin
- entry:=fstaticvarsymdecl.FindOrAdd(@sym,sizeof(sym));
- if assigned(entry^.Data) then
- internalerror(2022051701);
- entry^.Data:=decl;
- end;
- function TDebugInfoLLVM.staticvarsym_get_decl(sym: tsym): taillvmdecl;
- var
- entry: PHashSetItem;
- begin
- result:=nil;
- entry:=fstaticvarsymdecl.Find(@sym,sizeof(sym));
- if assigned(entry) then
- result:=taillvmdecl(entry^.Data);
- end;
- function TDebugInfoLLVM.localvarsym_get_meta(sym: tsym; out is_new: boolean): tai_llvmspecialisedmetadatanode;
- var
- entry: PHashSetItem;
- begin
- entry:=fstaticvarsymdecl.FindOrAdd(@sym,sizeof(sym));
- if not assigned(entry^.Data) then
- begin
- result:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILocalVariable);
- current_asmdata.AsmLists[al_dwarf_info].concat(result);
- entry^.Data:=result;
- is_new:=true;
- exit;
- end;
- is_new:=false;
- result:=tai_llvmspecialisedmetadatanode(entry^.Data);
- end;
- procedure TDebugInfoLLVM.appenddef_array_internal(list: TAsmList; fordef: tdef; eledef: tdef; lowrange, highrange: asizeint);
- var
- dinode,
- subrangenode,
- exprnode: tai_llvmspecialisedmetadatanode;
- arrayrangenode: tai_llvmunnamedmetadatanode;
- begin
- { range of the array }
- subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
- { include length }
- subrangenode.addqword('lowerBound',lowRange);
- if highrange>=0 then
- subrangenode.addqword('count',qword(highRange)+1)
- else
- subrangenode.addint64('count',highRange+1);
- list.concat(subrangenode);
- { collection containing the one range }
- arrayrangenode:=tai_llvmunnamedmetadatanode.create;
- arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
- list.concat(arrayrangenode);
- { the array definition }
- dinode:=def_set_meta_impl(fordef,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_array_type');
- dinode.addmetadatarefto('baseType',def_meta_node(eledef));
- dinode.addqword('size',eledef.size*(highrange-lowrange+1)*8);
- dinode.addmetadatarefto('elements',arrayrangenode);
- list.concat(dinode);
- end;
- function TDebugInfoLLVM.getabstractprocdeftypes(list: TAsmList; def: tabstractprocdef): tai_llvmbasemetadatanode;
- var
- types: tai_llvmunnamedmetadatanode;
- i: longint;
- begin
- types:=tai_llvmunnamedmetadatanode.create;
- list.concat(types);
- { we still need a DISubProgramType in this case, but not the list of types }
- if not(cs_debuginfo in current_settings.moduleswitches) then
- exit;
- if is_void(def.returndef) then
- types.addvalue(tai_simpletypedconst.create(llvm_metadatatype,nil))
- else
- types.addvalue(def_meta_ref(def.returndef));
- for i:=0 to def.paras.count-1 do
- begin
- types.addvalue(def_meta_ref(tparavarsym(def.paras[i]).vardef));
- end;
- result:=types;
- end;
- function TDebugInfoLLVM.def_meta_impl(def: tdef): tai_llvmspecialisedmetadatanode;
- begin
- result:=tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.implmetadef);
- end;
- function TDebugInfoLLVM.def_set_meta_impl(def: tdef; meta_impl: tai_llvmspecialisedmetadatanode): tai_llvmspecialisedmetadatanode;
- begin
- tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.implmetadef):=meta_impl;
- result:=meta_impl;
- end;
- function TDebugInfoLLVM.def_meta_class_struct(def: tobjectdef): tai_llvmspecialisedmetadatanode;
- begin
- result:=tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.struct_metadef);
- end;
- function TDebugInfoLLVM.def_meta_node(def: tdef): tai_llvmspecialisedmetadatanode;
- begin
- if not is_void(def) then
- result:=tai_llvmspecialisedmetadatanode(get_def_metatai(def)^.HashSetItem.Data)
- else
- result:=nil;
- end;
- function TDebugInfoLLVM.def_meta_ref(def: tdef): tai_simpletypedconst;
- begin
- result:=llvm_getmetadatareftypedconst(def_meta_node(def));
- end;
- constructor TDebugInfoLLVM.Create;
- begin
- inherited Create;
- fenums:=nil;
- fretainedtypes:=nil;
- fglobals:=nil;
- femptyexpression:=nil;
- fderefexpression:=nil;
- fcunode:=nil;
- ffilemeta:=thashset.Create(10000,true,false);
- flocationmeta:=thashset.Create(10000,true,false);
- flexicalblockfilemeta:=thashset.Create(100,true,false);
- fdefmeta:=TLLVMMetaDefHashSet.Create(10000,true,false);
- fstaticvarsymdecl:=thashset.create(10000,true,false);
- defnumberlist:=TFPObjectList.create(false);
- deftowritelist:=TFPObjectList.create(false);
- vardatadef:=nil;
- end;
- destructor TDebugInfoLLVM.Destroy;
- begin
- // don't free fenums/fretainedtypes/fglobals, they get emitted in the assembler list
- ffilemeta.free;
- ffilemeta:=nil;
- flocationmeta.free;
- flocationmeta:=nil;
- flexicalblockfilemeta.free;
- flexicalblockfilemeta:=nil;
- fdefmeta.free;
- fdefmeta:=nil;
- fstaticvarsymdecl.free;
- fstaticvarsymdecl:=nil;
- flocalvarsymmeta.free;
- flocalvarsymmeta:=nil;
- defnumberlist.free;
- defnumberlist:=nil;
- deftowritelist.free;
- deftowritelist:=nil;
- fcunode.free;
- fcunode:=nil;
- inherited Destroy;
- end;
- procedure TDebugInfoLLVM.ensuremetainit;
- begin
- if not assigned(fllvm_dbg_addr_pd) then
- fllvm_dbg_addr_pd:=search_system_proc('llvm_dbg_addr');
- if not assigned(fenums) then
- begin
- fenums:=tai_llvmunnamedmetadatanode.create;
- fretainedtypes:=tai_llvmunnamedmetadatanode.create;
- fglobals:=tai_llvmunnamedmetadatanode.create;
- femptyexpression:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
- fderefexpression:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
- fderefexpression.addenum('','DW_OP_deref');
- fcunode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompileUnit);
- end;
- end;
- procedure TDebugInfoLLVM.resetfornewmodule;
- var
- i: longint;
- begin
- { for LLVM, we need to generate the procdef type info (or at least
- temporary references to it) already during the generation of the line
- info (all line info metadata needs a reference to its parent scope,
- the procdef). Since the line info is generated per procedure and
- the type info only at the end, we can't allocate the type info
- structures at the start of the type info generation like for other
- debug info producers. Instead, we have to initialise everything in the
- constructor, and then reset it at the end of the debug info pass
- (inserting the module info) }
- ffilemeta.Clear;
- flocationmeta.Clear;
- flexicalblockfilemeta.Clear;
- fdefmeta.free;
- fstaticvarsymdecl.Clear;
- { one item per def, plus some extra space in case of nested types,
- externally used types etc (it will grow further if necessary) }
- i:=current_module.localsymtable.DefList.count*4;
- if assigned(current_module.globalsymtable) then
- inc(i,current_module.globalsymtable.DefList.count*2);
- fdefmeta:=TLLVMMetaDefHashSet.Create(i,true,false);
- defnumberlist.Clear;
- deftowritelist.Clear;
- fcunode:=nil;
- fenums:=nil;
- fretainedtypes:=nil;
- fglobals:=nil;
- femptyexpression:=nil;
- fderefexpression:=nil;
- end;
- procedure TDebugInfoLLVM.collectglobalsyms;
- var
- i: TAsmListType;
- hp: tai;
- begin
- for i in globaldataasmlisttypes do
- begin
- if not assigned(current_asmdata.AsmLists[i]) then
- continue;
- hp:=tai(current_asmdata.AsmLists[i].First);
- while assigned(hp) do
- begin
- if (hp.typ=ait_llvmdecl) and
- assigned(taillvmdecl(hp).sym) then
- staticvarsym_set_decl(taillvmdecl(hp).sym,taillvmdecl(hp));
- hp:=tai(hp.next);
- end;
- end;
- end;
- procedure TDebugInfoLLVM.updatelocalvardbginfo(hp: taillvm; pd: tprocdef; functionscope: tai_llvmspecialisedmetadatanode);
- var
- opindex, callparaindex: longint;
- paras: tfplist;
- sympara,
- exprpara: pllvmcallpara;
- sym: tabstractnormalvarsym;
- dilocalvar: tai_llvmspecialisedmetadatanode;
- isnewlocalvardi,
- deref: boolean;
- begin
- { not really clean since hardcoding the structure of the call
- instruction's procdef encoding, but quick }
- if (hp.oper[taillvm.callpdopernr]^.def.typ<>pointerdef) or
- (tpointerdef(hp.oper[taillvm.callpdopernr]^.def).pointeddef<>fllvm_dbg_addr_pd) then
- exit;
- deref:=false;
- sympara:=hp.getcallpara(1);
- exprpara:=hp.getcallpara(2);
- if sympara^.val.typ<>top_local then
- internalerror(2022052613);
- sym:=tabstractnormalvarsym(sympara^.val.localsym);
- dilocalvar:=localvarsym_get_meta(sym,isnewlocalvardi);
- sympara^.loadtai(llvm_getmetadatareftypedconst(dilocalvar));
- if isnewlocalvardi then
- begin
- dilocalvar.addstring('name',symname(sym,false));
- if sym.typ=paravarsym then
- begin
- dilocalvar.addint64('arg',tparavarsym(sym).paranr);
- if paramanager.push_addr_param(sym.varspez,sym.vardef,pd.proccalloption) then
- deref:=true;
- end;
- dilocalvar.addmetadatarefto('scope',functionscope);
- try_add_file_metaref(dilocalvar,sym.fileinfo,false);
- dilocalvar.addmetadatarefto('type',def_meta_node(sym.vardef));
- if vo_is_self in sym.varoptions then
- dilocalvar.addenum('flags','DIFlagArtificial');
- end
- else
- begin
- if (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,pd.proccalloption) then
- deref:=true;
- end;
- if not deref then
- exprpara^.loadtai(llvm_getmetadatareftypedconst(femptyexpression))
- else
- exprpara^.loadtai(llvm_getmetadatareftypedconst(fderefexpression));
- end;
- function TDebugInfoLLVM.file_getmetanode(moduleindex: tfileposmoduleindex; fileindex: tfileposfileindex): tai_llvmspecialisedmetadatanode;
- var
- infile: tinputfile;
- dirname: TSymStr;
- item: PHashSetItem;
- metaitem: tai_llvmspecialisedmetadatanode;
- modfileindex: packed record
- moduleindex: tfileposmoduleindex;
- fileindex: tfileposfileindex;
- end;
- begin
- modfileindex.moduleindex:=moduleindex;
- modfileindex.fileindex:=fileindex;
- item:=ffilemeta.FindOrAdd(@modfileindex,sizeof(modfileindex));
- if not assigned(item^.Data) then
- begin
- infile:=get_module(moduleindex).sourcefiles.get_file(fileindex);
- if not assigned(infile) then
- begin
- result:=nil;
- exit;
- end;
- if infile.path = '' then
- dirname:=absolute_llvm_path('.')
- else
- begin
- { add the canonical form here already to avoid problems with }
- { paths such as './' etc }
- dirname:=absolute_llvm_path(infile.path);
- end;
- if dirname='' then
- dirname:='.';
- metaitem:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIFile);
- metaitem.addstring('filename',infile.name);
- metaitem.addstring('directory',dirname);
- current_asmdata.AsmLists[al_dwarf_line].concat(metaitem);
- item^.Data:=metaitem;
- end;
- result:=tai_llvmspecialisedmetadatanode(item^.Data);
- end;
- function TDebugInfoLLVM.filepos_getmetanode(const filepos: tfileposinfo; const functionfileinfo: tfileposinfo; const functionscope: tai_llvmspecialisedmetadatanode; nolineinfo: boolean): tai_llvmspecialisedmetadatanode;
- var
- item: PHashSetItem;
- filemeta,
- locationscopemeta: tai_llvmspecialisedmetadatanode;
- lexicalblockkey: packed record
- scopemeta,
- filemeta: tai_llvmspecialisedmetadatanode;
- end;
- locationkey: packed record
- scope: tai_llvmspecialisedmetadatanode;
- line: tfileposline;
- column: tfileposcolumn;
- end;
- begin
- result:=nil;
- if (filepos.fileindex<>0) then
- filemeta:=file_getmetanode(filepos.moduleindex,filepos.fileindex)
- else
- filemeta:=file_getmetanode(functionfileinfo.moduleindex,functionfileinfo.fileindex);
- if not assigned(filemeta) then
- exit;
- if (filepos.fileindex<>0) and
- (filepos.fileindex<>functionfileinfo.fileindex) then
- begin
- lexicalblockkey.scopemeta:=functionscope;
- lexicalblockkey.filemeta:=filemeta;
- item:=flexicalblockfilemeta.FindOrAdd(@lexicalblockkey,sizeof(lexicalblockkey));
- if not assigned(item^.Data) then
- begin
- locationscopemeta:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILexicalBlockFile);
- locationscopemeta.addmetadatarefto('scope',functionscope);
- locationscopemeta.addmetadatarefto('file',filemeta);
- locationscopemeta.addint64('discriminator',0);
- current_asmdata.AsmLists[al_dwarf_line].concat(locationscopemeta);
- item^.Data:=locationscopemeta;
- end
- else
- locationscopemeta:=tai_llvmspecialisedmetadatanode(item^.Data);
- end
- else
- locationscopemeta:=functionscope;
- locationkey.scope:=locationscopemeta;
- if not nolineinfo then
- begin
- locationkey.line:=filepos.line;
- locationkey.column:=filepos.column;
- end
- else
- begin
- locationkey.line:=0;
- locationkey.column:=0;
- end;
- item:=flocationmeta.FindOrAdd(@locationkey,sizeof(locationkey));
- if not assigned(item^.Data) then
- begin
- result:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILocation);
- if not nolineinfo then
- begin
- result.addqword('line',filepos.line);
- result.addqword('column',filepos.column);
- end
- else
- result.addqword('line',0);
- result.addmetadatarefto('scope',locationscopemeta);
- current_asmdata.AsmLists[al_dwarf_line].concat(result);
- item^.Data:=result;
- end
- else
- result:=tai_llvmspecialisedmetadatanode(item^.Data);
- end;
- procedure TDebugInfoLLVM.try_add_file_metaref(dinode: tai_llvmspecialisedmetadatanode; const fileinfo: tfileposinfo; includescope: boolean);
- var
- filemeta: tai_llvmbasemetadatanode;
- begin
- filemeta:=file_getmetanode(fileinfo.moduleindex,fileinfo.fileindex);
- if assigned(filemeta) then
- begin
- if includescope then
- begin
- dinode.addmetadatarefto('scope',filemeta);
- end;
- dinode.addmetadatarefto('file',filemeta);
- dinode.addqword('line',fileinfo.line);
- end;
- end;
- function TDebugInfoLLVM.add_line_metanode(const fileinfo: tfileposinfo): tai_llvmspecialisedmetadatanode;
- var
- filemeta: tai_llvmbasemetadatanode;
- begin
- filemeta:=file_getmetanode(fileinfo.moduleindex,fileinfo.fileindex);
- if not assigned(filemeta) then
- internalerror(2022041701);
- result:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DILocation);
- result.addqword('line',fileinfo.line);
- result.addqword('column',fileinfo.column);
- result.addmetadatarefto('scope',filemeta);
- current_asmdata.AsmLists[al_dwarf_line].concat(result);
- end;
- procedure TDebugInfoLLVM.appenddef_ord(list:TAsmList;def:torddef);
- var
- ordtype: tordtype;
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- { nothing, must be referenced as "null" in the using declaration }
- if is_void(def) then
- exit;
- ordtype:=def.ordtype;
- if ordtype=customint then
- ordtype:=range_to_basetype(def.low,def.high);
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIBasicType));
- case ordtype of
- s8bit,
- s16bit,
- s32bit,
- u8bit,
- u16bit,
- u32bit,
- u64bit,
- s64bit,
- u128bit,
- s128bit:
- begin
- dinode.addqword('size',def.size*8);
- if def.alignment<>def.size then
- dinode.addqword('align',def.alignment*8);
- { generate proper signed/unsigned info for types like 0..3 }
- { these are s8bit, but should be identified as unsigned }
- { because otherwise they are interpreted wrongly when used }
- { in a bitpacked record }
- if def.low<0 then
- dinode.addenum('encoding','DW_ATE_signed')
- else
- dinode.addenum('encoding','DW_ATE_unsigned');
- end;
- uvoid :
- begin
- { checked above }
- end;
- uchar,
- uwidechar :
- begin
- dinode.addqword('size',def.size*8);
- dinode.addenum('encoding','DW_ATE_unsigned_char');
- end;
- pasbool1,
- pasbool8,
- bool8bit,
- pasbool16,
- bool16bit,
- pasbool32,
- bool32bit,
- pasbool64,
- bool64bit:
- begin
- dinode.addqword('size',def.size*8);
- dinode.addenum('encoding','DW_ATE_boolean');
- end;
- scurrency:
- begin
- { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
- dinode.addqword('size',def.size*8);
- dinode.addenum('encoding','DW_ATE_signed');
- end;
- customint:
- internalerror(2021111502);
- end;
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_float(list:TAsmList;def:tfloatdef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIBasicType));
- case def.floattype of
- s32real,
- s64real,
- s80real,
- sc80real,
- s128real:
- begin
- dinode.addqword('size',def.size*8);
- if def.alignment<>def.size then
- dinode.addqword('align',def.alignment*8);
- dinode.addenum('encoding','DW_ATE_float');
- end;
- s64currency:
- begin
- { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
- dinode.addqword('size',def.size*8);
- dinode.addenum('encoding','DW_ATE_signed');
- end;
- s64comp:
- begin
- { we should use DW_ATE_signed_fixed, however it isn't supported yet by LLVM }
- dinode.addqword('size',def.size*8);
- dinode.addenum('encoding','DW_ATE_signed');
- end;
- end;
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_enum(list:TAsmList;def:tenumdef);
- var
- hp : tenumsym;
- i : longint;
- dinode: tai_llvmspecialisedmetadatanode;
- enumelem: tai_llvmspecialisedmetadatanode;
- enumlist: tai_llvmunnamedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_enumeration_type');
- dinode.addqword('size',def.size*8);
- dinode.addstring('identifier',def.mangledparaname);
- { register in module's list of enums (to ensure the debug info gets
- emitted even if the enum is not used in the current module) }
- fenums.addvalue(llvm_getmetadatareftypedconst(dinode));
- enumlist:=tai_llvmunnamedmetadatanode.create;
- { add enum symbols }
- for i:=0 to def.symtable.SymList.Count-1 do
- begin
- hp:=tenumsym(def.symtable.SymList[i]);
- if hp.value<def.minval then
- continue
- else if hp.value>def.maxval then
- break;
- enumelem:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIEnumerator);
- enumelem.addstring('name',symname(hp, false));
- enumelem.addint64('value',hp.value);
- list.concat(enumelem);
- enumlist.addvalue(llvm_getmetadatareftypedconst(enumelem));
- end;
- if enumlist.valuecount<>0 then
- begin
- list.concat(enumlist);
- dinode.addmetadatarefto('elements',enumlist);
- end
- else
- begin
- enumlist.free;
- end;
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_array(list:TAsmList;def:tarraydef);
- var
- dinode,
- subrangenode,
- exprnode: tai_llvmspecialisedmetadatanode;
- arrayrangenode: tai_llvmunnamedmetadatanode;
- size : qword;
- nesteddef: tdef;
- power: longint;
- flags: TLLVMDIFlags;
- begin
- if is_dynamic_array(def) { and
- not(llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion]) } then
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',def_meta_node(def.elementdef));
- dinode.addqword('size',def.size*8);
- list.concat(dinode);
- exit;
- end;
- { open arrays etc need to access the high parameter to define their range,
- which is not possible here since we need the parasym rather than the def }
- if is_open_array(def) then
- begin
- (*
- if llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion] then
- begin
- dinode:=def_meta_impl(def);
- { should be generated as part of the parasym }
- if not assigned(dinode) then
- internalerror(2021112002);
- end
- else *)
- begin
- { no idea about the size, generate an array of 1 element -- although it could be empty }
- appenddef_array_internal(list,def,def.elementdef,0,1);
- end;
- exit;
- end;
- if is_array_of_const(def) then
- begin
- { no idea about the size, generate an array of 1 element -- although it could be empty }
- appenddef_array_internal(list,def,def.elementdef,0,1);
- exit;
- end;
- if is_special_array(def)
- and not((llvmflag_array_datalocation in llvmversion_properties[current_settings.llvmversion]) and
- is_dynamic_array(def)) then
- internalerror(2021121902);
- { todo: proper support for bitpacked arrays }
- if is_packed_array(def) and
- (((def.elementdef.packedbitsize mod 8)<>0) or
- not ispowerof2(def.elementdef.packedbitsize div 8,power)) then
- begin
- { for now just encode as an array of bytes }
- appenddef_array_internal(list,def,u8inttype,0,def.size-1);
- exit;
- end;
- { collection of all ranges of the array (to support multi-dimensional arrays) }
- arrayrangenode:=tai_llvmunnamedmetadatanode.create;
- list.concat(arrayrangenode);
- { range of the array }
- subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
- if is_dynamic_array(def) then
- begin
- exprnode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
- exprnode.addenum('','DW_OP_push_object_address');
- exprnode.addenum('','DW_OP_constu');
- exprnode.addint64('',ord(sizeof(pint)));
- exprnode.addenum('','DW_OP_minus');
- exprnode.addenum('','DW_OP_deref');
- list.concat(exprnode);
- subrangenode.addmetadatarefto('upperBound',exprnode);
- subrangenode.addint64('lowerBound',def.lowrange);
- end
- else
- begin
- subrangenode.addqword('count',def.highrange-def.lowrange+1);
- subrangenode.addint64('lowerBound',def.lowrange);
- end;
- list.concat(subrangenode);
- nesteddef:=def.elementdef;
- arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
- while (nesteddef.typ=arraydef) and
- not is_special_array(nesteddef) do
- begin
- subrangenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubrange);
- subrangenode.addqword('count',tarraydef(nesteddef).highrange-tarraydef(nesteddef).lowrange+1);
- subrangenode.addint64('lowerBound',tarraydef(nesteddef).lowrange);
- list.concat(subrangenode);
- arrayrangenode.addvalue(llvm_getmetadatareftypedconst(subrangenode));
- nesteddef:=tarraydef(nesteddef).elementdef;
- end;
- { the array definition }
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_array_type');
- dinode.addmetadatarefto('baseType',def_meta_node(nesteddef));
- dinode.addmetadatarefto('elements',arrayrangenode);
- if is_vector(def) then
- dinode.addenum('flags','DIFlagVector');
- if not is_dynamic_array(def) then
- {$ifdef cpu64bitalu}
- if def.size>=(qword(1) shl 61) then
- { LLVM internally "only" supports sizes up to 1 shl 61, because they
- store all sizes in bits in a qword; the rationale is that there
- is no hardware supporting a full 64 bit address space either }
- dinode.addqword('size',((qword(1) shl 61) - 1)*8)
- else
- {$endif def cpu64bitalu}
- dinode.addqword('size',def.size*8)
- else
- begin
- exprnode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIExpression);
- exprnode.addenum('','DW_OP_LLVM_implicit_pointer');
- list.concat(exprnode);
- dinode.addmetadatarefto('dataLocation',exprnode);
- end;
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_record(list:TAsmList;def:trecorddef);
- begin
- if assigned(def.objname) then
- appenddef_record_named(list,def,def,def.objname^)
- else
- appenddef_record_named(list,def,def,'');
- end;
- procedure TDebugInfoLLVM.appenddef_record_named(list:TAsmList; fordef: tdef; def:trecorddef; const name: TSymStr);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(fordef,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- list.concat(dinode);
- dinode.addenum('tag','DW_TAG_structure_type');
- appenddef_struct_named(list,def,dinode,tai_llvmunnamedmetadatanode.create,name);
- end;
- procedure TDebugInfoLLVM.appenddef_struct_named(list: TAsmList; def: tabstractrecorddef; structdi: tai_llvmspecialisedmetadatanode; initialfieldlist: tai_llvmunnamedmetadatanode; const name: TSymStr);
- var
- cappedsize: asizeuint;
- begin
- if (name<>'') then
- structdi.addstring('name',name);
- if assigned(def.typesym) then
- try_add_file_metaref(structdi,def.typesym.fileinfo,false);
- if is_packed_record_or_object(def) then
- cappedsize:=tabstractrecordsymtable(def.symtable).datasize
- {$ifdef cpu64bitalu}
- else if def.size>=(qword(1) shl 61) then
- { LLVM internally "only" supports sizes up to 1 shl 61, because they
- store all sizes in bits in a qword; the rationale is that there
- is no hardware supporting a full 64 bit address space either }
- cappedsize:=((qword(1) shl 61) - 1)*8
- {$endif def cpu64bitalu}
- else
- cappedsize:=tabstractrecordsymtable(def.symtable).datasize*8;
- structdi.addqword('size',cappedsize);
- appenddef_struct_fields(list,def,structdi,initialfieldlist,cappedsize);
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
- end;
- procedure TDebugInfoLLVM.appenddef_struct_fields(list: TAsmlist; def: tabstractrecorddef; defdinode: tai_llvmspecialisedmetadatanode; initialfieldlist: tai_llvmunnamedmetadatanode; cappedsize: asizeuint);
- { returns whether we need to create a nested struct in the variant to hold
- multiple successive fields, or whether the next field starts at the
- same offset as the current one. I.e., it returns false for
- case byte of
- 0: (b: byte);
- 1: (l: longint);
- end
- but true for
- case byte of
- 0: (b1,b2: byte);
- end
- and
- case byte of
- 0: (b1: byte;
- case byte of 0:
- b2: byte;
- )
- end
- }
- function variantfieldstartsnewstruct(field: tfieldvarsym; recst: tabstractrecordsymtable; fieldidx: longint): boolean;
- var
- nextfield: tfieldvarsym;
- begin
- result:=false;
- inc(fieldidx);
- if fieldidx>=recst.symlist.count then
- exit;
- { can't have properties or procedures between to start fields of the
- same variant }
- if tsym(recst.symlist[fieldidx]).typ<>fieldvarsym then
- exit;
- nextfield:=tfieldvarsym(recst.symlist[fieldidx]);
- if nextfield.fieldoffset=field.fieldoffset then
- exit;
- result:=true;
- end;
- type
- tvariantinfo = record
- startfield: tfieldvarsym;
- uniondi: tai_llvmspecialisedmetadatanode;
- variantfieldlist: tai_llvmunnamedmetadatanode;
- curvariantstructfieldlist: tai_llvmunnamedmetadatanode;
- end;
- pvariantinfo = ^tvariantinfo;
- function bitoffsetfromvariantstart(field: tfieldvarsym; variantinfolist: tfplist; totalbitsize: ASizeUInt): qword;
- var
- variantstartfield: tfieldvarsym;
- begin
- if not assigned(variantinfolist) then
- begin
- result:=field.bitoffset;
- exit;
- end;
- result:=0;
- if vo_is_first_field in field.varoptions then
- exit;
- variantstartfield:=pvariantinfo(variantinfolist[variantinfolist.count-1])^.startfield;
- { variant fields always start on a byte boundary, so no need for
- rounding/truncating }
- result:=field.bitoffset-variantstartfield.bitoffset;
- end;
- var
- variantinfolist: tfplist;
- variantinfo: pvariantinfo;
- recst: tabstractrecordsymtable;
- scope,
- fielddi,
- uniondi,
- structdi: tai_llvmspecialisedmetadatanode;
- fieldlist: tai_llvmunnamedmetadatanode;
- i, varindex: longint;
- field: tfieldvarsym;
- bitoffset: asizeuint;
- bpackedrecst,
- classorobject: boolean;
- begin
- recst:=tabstractrecordsymtable(def.symtable);
- bpackedrecst:=recst.fieldalignment=bit_alignment;
- scope:=defdinode;
- variantinfolist:=nil;
- classorobject:=is_class_or_interface_or_object(def);
- fieldlist:=initialfieldlist;
- list.concat(fieldlist);
- defdinode.addmetadatarefto('elements',fieldlist);
- for i:=0 to recst.symlist.count-1 do
- begin
- if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
- continue;
- field:=tfieldvarsym(recst.symlist[i]);
- if (sp_static in field.symoptions) then
- exit;
- { start of a new variant part? }
- if vo_is_first_field in field.varoptions then
- begin
- if not assigned(variantinfolist) then
- begin
- variantinfolist:=tfplist.create;
- end;
- varindex:=variantinfolist.count-1;
- if (varindex=-1) or
- (pvariantinfo(variantinfolist[varindex])^.startfield.fieldoffset<field.fieldoffset) then
- begin
- { more deeply nested variant }
- uniondi:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType);
- fielddi:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
- fielddi.addenum('tag','DW_TAG_member');
- fielddi.addmetadatarefto('scope',scope);
- try_add_file_metaref(fielddi,field.fileinfo,false);
- fielddi.addmetadatarefto('baseType',uniondi);
- fielddi.addint64('size',cappedsize-min(field.bitoffset,cappedsize));
- bitoffset:=bitoffsetfromvariantstart(field,variantinfolist,cappedsize);
- if bitoffset<>0 then
- fielddi.addqword('offset',bitoffset);
- list.concat(fielddi);
- fieldlist.addvalue(llvm_getmetadatareftypedconst(fielddi));
- list.concat(uniondi);
- uniondi.addenum('tag','DW_TAG_union_type');
- uniondi.addmetadatarefto('scope',scope);
- try_add_file_metaref(uniondi,field.fileinfo,false);
- { the size of this variant part is the total size of the
- record minus the start of this field; not 100% correct
- in case of multiple parallel nested variants, but not
- really important since it's all padding anyway }
- uniondi.addint64('size',cappedsize-min(field.bitoffset,cappedsize));
- fieldlist:=tai_llvmunnamedmetadatanode.create;
- list.concat(fieldlist);
- uniondi.addmetadatarefto('elements',fieldlist);
- scope:=uniondi;
- new(variantinfo);
- variantinfo^.startfield:=field;
- variantinfo^.uniondi:=uniondi;
- variantinfo^.variantfieldlist:=fieldlist;
- variantinfo^.curvariantstructfieldlist:=nil;
- variantinfolist.Add(variantinfo);
- inc(varindex);
- end
- else
- begin
- {finalise more deeply nested variants }
- while (varindex>=0) and
- (pvariantinfo(variantinfolist[varindex])^.startfield.fieldoffset>field.fieldoffset) do
- begin
- dispose(pvariantinfo(variantinfolist[varindex]));
- dec(varindex);
- end;
- if (varindex<0) then
- internalerror(2022060610);
- variantinfo:=pvariantinfo(variantinfolist[varindex]);
- if variantinfo^.startfield.fieldoffset<>field.fieldoffset then
- internalerror(2022060611);
- { a variant part is always the last part -> end of previous
- struct, if any}
- variantinfo^.curvariantstructfieldlist:=nil;
- fieldlist:=variantinfo^.variantfieldlist;
- scope:=variantinfo^.uniondi;
- { variant at the same level as a previous one }
- variantinfolist.count:=varindex+1;
- end;
- if not variantfieldstartsnewstruct(field,recst,i) then
- begin
- variantinfo^.curvariantstructfieldlist:=nil;
- fieldlist:=variantinfo^.variantfieldlist;
- scope:=variantinfo^.uniondi;
- end
- else
- begin
- structdi:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType);
- list.concat(structdi);
- structdi.addenum('tag','DW_TAG_structure_type');
- structdi.addmetadatarefto('scope',variantinfo^.uniondi);
- structdi.addint64('size',cappedsize-min(field.bitoffset,cappedsize));
- variantinfo^.curvariantstructfieldlist:=tai_llvmunnamedmetadatanode.create;
- list.concat(variantinfo^.curvariantstructfieldlist);
- structdi.addmetadatarefto('elements',variantinfo^.curvariantstructfieldlist);
- fieldlist.addvalue(llvm_getmetadatareftypedconst(structdi));
- fieldlist:=variantinfo^.curvariantstructfieldlist;
- scope:=structdi;
- end;
- end;
- fielddi:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
- fielddi.addenum('tag','DW_TAG_member');
- fielddi.addstring('name',symname(field,false));
- fielddi.addmetadatarefto('scope',scope);
- try_add_file_metaref(fielddi,field.fileinfo,false);
- { the vmt field's type is voidpointerdef, because when it gets
- inserted we can't build the vmt's def yet }
- if classorobject and
- (field=tobjectdef(def).vmt_field) then
- fielddi.addmetadatarefto('baseType',def_meta_node(cpointerdef.getreusable(tobjectdef(def).vmt_def)))
- else
- fielddi.addmetadatarefto('baseType',def_meta_node(field.vardef));
- if bpackedrecst and
- is_ordinal(field.vardef) then
- fielddi.addqword('size',field.getpackedbitsize)
- else
- fielddi.addqword('size',min(asizeuint(field.getsize)*8,cappedsize));
- bitoffset:=bitoffsetfromvariantstart(field,variantinfolist,cappedsize);
- if bitoffset<>0 then
- fielddi.addqword('offset',bitoffset);
- { currently only vmt }
- if field.visibility=vis_hidden then
- fielddi.addenum('flags','DIFlagArtificial');
- fieldlist.addvalue(llvm_getmetadatareftypedconst(fielddi));
- list.concat(fielddi);
- end;
- if assigned(variantinfolist) then
- begin
- for i:=0 to variantinfolist.count-1 do
- begin
- dispose(pvariantinfo(variantinfolist[i]));
- end;
- end;
- variantinfolist.free;
- end;
- procedure TDebugInfoLLVM.appenddef_pointer(list:TAsmList;def:tpointerdef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- if not(is_voidpointer(def)) then
- dinode.addmetadatarefto('baseType',def_meta_node(def.pointeddef))
- else
- dinode.addmetadatarefto('baseType',nil);
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_formal(list: TAsmList; def: tformaldef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',nil);
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_string(list:TAsmList;def:tstringdef);
- procedure addnormalstringdef(const name: TSymStr; lendef: tdef; maxlen: asizeuint);
- var
- dinode,
- subrangenode,
- exprnode: tai_llvmspecialisedmetadatanode;
- arrayrangenode: tai_aggregatetypedconst;
- { maxlen can be > high(int64) }
- slen : asizeuint;
- arr : tasmlabel;
- begin
- { fix length of openshortstring }
- slen:=aword(def.len);
- if (slen=0) or
- (slen>maxlen) then
- slen:=maxlen;
- appenddef_array_internal(list,def,cansichartype,0,slen);
- end;
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- case def.stringtype of
- st_shortstring:
- begin
- addnormalstringdef('ShortString',u8inttype,255);
- end;
- st_longstring:
- begin
- { a) we don't actually support variables of this type currently
- b) this type is only used as the type for constant strings
- > 255 characters
- c) in such a case, gdb will allocate and initialise enough
- memory to hold the maximum size for such a string
- -> don't use high(qword)/high(cardinal) as maximum, since that
- will cause exhausting the VM space, but some "reasonably high"
- number that should be enough for most constant strings
- }
- {$ifdef cpu64bitaddr}
- addnormalstringdef('LongString',u64inttype,qword(1024*1024));
- {$endif cpu64bitaddr}
- {$ifdef cpu32bitaddr}
- addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
- {$endif cpu32bitaddr}
- {$ifdef cpu16bitaddr}
- addnormalstringdef('LongString',u16inttype,cardinal(1024));
- {$endif cpu16bitaddr}
- end;
- st_ansistring:
- begin
- // Todo: dynamic length "array"
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',def_meta_node(cansichartype));
- list.concat(dinode);
- end;
- st_unicodestring,
- st_widestring:
- begin
- // Todo: dynamic length "array"
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',def_meta_node(cwidechartype));
- list.concat(dinode);
- end;
- end;
- end;
- procedure TDebugInfoLLVM.appenddef_procvar(list:TAsmList;def:tprocvardef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- { plain pointer for now }
- if def.is_addressonly then
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',nil);
- list.concat(dinode);
- end
- else
- begin
- appenddef_array_internal(list,def,voidcodepointertype,1,2);
- end;
- end;
- procedure TDebugInfoLLVM.appenddef_file(list: TAsmList; def: tfiledef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_structure_type');
- if assigned(def.typesym) then
- dinode.addstring('name',symname(def.typesym, false));
- dinode.addqword('size',def.size*8);
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_object(list: TAsmList; def: tobjectdef);
- var
- dinode,
- structdi,
- inheritancedi: tai_llvmspecialisedmetadatanode;
- fields: tai_llvmunnamedmetadatanode;
- begin
- inheritancedi:=nil;
- fields:=tai_llvmunnamedmetadatanode.create;
- if assigned(def.childof) then
- begin
- inheritancedi:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
- list.concat(inheritancedi);
- inheritancedi.addenum('tag','DW_TAG_inheritance');
- if is_implicit_pointer_object_type(def) then
- inheritancedi.addmetadatarefto('baseType',def_meta_class_struct(def.childof))
- else
- inheritancedi.addmetadatarefto('baseType',def_meta_node(def.childof));
- { Pascal only has public inheritance }
- if def.objecttype<>odt_cppclass then
- inheritancedi.addenum('flags','DIFlagPublic');
- fields.addvalue(llvm_getmetadatareftypedconst(inheritancedi));
- end;
- if is_implicit_pointer_object_type(def) then
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- structdi:=def_meta_class_struct(def);
- list.concat(structdi);
- structdi.addenum('tag','DW_TAG_class_type');
- appenddef_struct_named(list,def,structdi,fields,def.objname^);
- { implicit pointer }
- dinode.addmetadatarefto('baseType',structdi);
- end
- else case def.objecttype of
- odt_cppclass,
- odt_object:
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_class_type');
- appenddef_struct_named(list,def,dinode,fields,def.objname^);
- end;
- odt_objcclass:
- begin
- { Objective-C class: same as regular class, except for
- a) Apple-specific tag that identifies it as an Objective-C class
- b) use extname^ instead of objname
- }
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DICompositeType));
- dinode.addenum('tag','DW_TAG_class_type');
- dinode.addenum('runtimeLang','DW_LANG_ObjC');
- appenddef_struct_named(list,def,dinode,fields,def.objextname^);
- end;
- odt_objcprotocol:
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',nil);
- end;
- else
- internalerror(2022060710);
- end;
- list.concat(dinode);
- if assigned(inheritancedi) then
- inheritancedi.addmetadatarefto('scope',dinode);
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
- end;
- procedure TDebugInfoLLVM.appenddef_set(list: TAsmList; def: tsetdef);
- begin
- appenddef_array_internal(list,def,u8inttype,0,def.size-1);
- end;
- procedure TDebugInfoLLVM.appenddef_undefined(list: TAsmList; def: tundefineddef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',nil);
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_classref(list: TAsmList; def: tclassrefdef);
- var
- dinode: tai_llvmspecialisedmetadatanode;
- begin
- dinode:=def_set_meta_impl(def,tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType));
- dinode.addenum('tag','DW_TAG_pointer_type');
- dinode.addmetadatarefto('baseType',nil);
- list.concat(dinode);
- end;
- procedure TDebugInfoLLVM.appenddef_variant(list: TAsmList; def: tvariantdef);
- begin
- if assigned(vardatadef) then
- appenddef_record_named(list,def,trecorddef(vardatadef),'Variant');
- end;
- procedure TDebugInfoLLVM.afterappenddef(list:TAsmList;def:tdef);
- var
- tempdinode,
- refdinode,
- impldinode: tai_llvmspecialisedmetadatanode;
- begin
- if def.typ=procdef then
- exit;
- if is_void(def) then
- exit;
- refdinode:=def_meta_node(def);
- if is_objc_class_or_protocol(def) then
- begin
- { for Objective-C classes, the named typedef must refer to the
- struct itself, not to the pointer of the struct; Objective-C
- classes are not implicit pointers in Objective-C itself, only
- in FPC. So make the def label point to a pointer to the
- typedef, which in turn refers to the actual struct (for Delphi-
- style classes, the def points to the typedef, which refers to
- a pointer to the actual struct) }
- { implicit pointer }
- tempdinode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIDerivedType);
- refdinode.addenum('tag','DW_TAG_pointer_type');
- refdinode.addmetadatarefto('baseType',tempdinode);
- list.concat(refdinode);
- { typedef }
- refdinode:=tempdinode;
- end;
- refdinode.addenum('tag','DW_TAG_typedef');
- if assigned(def.typesym) and
- not(df_generic in def.defoptions) then
- begin
- refdinode.addstring('name',symname(def.typesym,false));
- try_add_file_metaref(refdinode,def.typesym.fileinfo,false);
- end;
- impldinode:=def_meta_impl(def);
- if not assigned(impldinode) then
- internalerror(2021120501);
- refdinode.addmetadatarefto('baseType',impldinode);
- list.concat(refdinode);
- end;
- procedure TDebugInfoLLVM.appendprocdef(list:TAsmList; def:tprocdef);
- procedure adddispflags(dinode: tai_llvmspecialisedmetadatanode; is_definition, is_virtual: boolean);
- var
- dispflags: TSymStr;
- islocal: boolean;
- begin
- islocal:=
- not((po_global in def.procoptions) and
- (def.parast.symtablelevel<=normal_function_level));
- adddefinitionlocal(dinode,is_definition,islocal,not(llvmflag_NoDISPFlags in llvmversion_properties[current_settings.llvmversion]),dispflags);
- if llvmflag_NoDISPFlags in llvmversion_properties[current_settings.llvmversion] then
- begin
- if is_virtual then
- begin
- if not(po_abstractmethod in def.procoptions) then
- dinode.addenum('virtuality','DW_VIRTUALITY_virtual')
- else
- dinode.addenum('virtuality','DW_VIRTUALITY_pure_virtual');
- end;
- exit;
- end;
- if is_virtual then
- begin
- if dispflags<>'' then
- dispflags:=dispflags+'|';
- if not(po_abstractmethod in def.procoptions) then
- dispflags:=dispflags+'DISPFlagVirtual'
- else
- dispflags:=dispflags+'DISPFlagPureVirtual';
- end
- else
- begin
- { this one will always be a definition, so no need to check
- whether result is empty }
- if not(llvmflag_NoDISPFlagMainSubprogram in llvmversion_properties[current_settings.llvmversion]) and
- (def.proctypeoption=potype_proginit) then
- dispflags:=dispflags+'|DISPFlagMainSubprogram';
- end;
- if dispflags<>'' then
- dinode.addenum('spFlags',dispflags);
- end;
- procedure adddiflags(dinode: tai_llvmspecialisedmetadatanode; is_definition: boolean);
- var
- diflags: TSymStr;
- begin
- if (llvmflag_NoDISPFlagMainSubprogram in llvmversion_properties[current_settings.llvmversion]) and
- (def.proctypeoption=potype_proginit) then
- diflags:='DIFlagMainSubprogram'
- else if def.owner.symtabletype in [objectsymtable,recordsymtable] then
- diflags:=visibilitydiflag(def.visibility)
- else
- diflags:='';
- if diflags<>'' then
- dinode.addenum('flags',diflags);
- end;
- var
- dinode,
- ditypenode : tai_llvmspecialisedmetadatanode;
- fileref : tai_simpletypedconst;
- procdeftai : tai;
- st : tsymtable;
- vmtoffset : pint;
- flags : TSymStr;
- in_currentunit,
- is_virtual : boolean;
- begin
- { only write debug info for procedures defined in the current module,
- except in case of methods (clang-compatible)
- }
- in_currentunit:=def.in_currentunit;
- if not in_currentunit and
- not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
- exit;
- { happens for init procdef of units without init section }
- if in_currentunit and
- not assigned(def.procstarttai) then
- exit;
- { These don't contain a taillvmdecl, they are completely generated
- in native assembly. If we want to add debug information to these,
- we have to do it using the regular debug info generation }
- if po_assembler in def.procoptions then
- exit;
- if df_generic in def.defoptions then
- exit;
- { Procdefs are not handled by the regular def writing code, so
- dbg_state is not set/checked for them. Do it here. }
- if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
- exit;
- defnumberlist.Add(def);
- def.dbg_state:=dbg_state_writing;
- { difference compared to other kinds of defs: the DISubProgram gets
- created directly in get_def_metatai because a typedef for a
- DISubProgram does not make sense and is not supported by LLVM ->
- don't set the implementation of the metadata def here and just use
- the regular node }
- dinode:=def_meta_node(def);
- list.concat(dinode);
- { we have to attach the debug info to the definition instruction of the
- proc }
- procdeftai:=nil;
- if in_currentunit then
- begin
- procdeftai:=def.procstarttai;
- if (procdeftai.typ<>ait_llvmdecl) or
- (taillvmdecl(procdeftai).def<>def) then
- internalerror(2022022010);
- taillvmdecl(procdeftai).addinsmetadata(tai_llvmmetadatareferenceoperand.createreferenceto('dbg',dinode));
- end;
- dinode.addstring('name',symdebugname(def.procsym));
- if assigned(def.struct) and
- not is_objc_class_or_protocol(def.struct) then
- begin
- if is_implicit_pointer_object_type(def.struct) then
- dinode.addmetadatarefto('scope',def_meta_class_struct(tobjectdef(def.struct)))
- else
- dinode.addmetadatarefto('scope',def_meta_node(def.struct));
- try_add_file_metaref(dinode,def.fileinfo,false);
- end
- else
- try_add_file_metaref(dinode,def.fileinfo,true);
- if not(cs_debuginfo in current_settings.moduleswitches) then
- begin
- def.dbg_state:=dbg_state_written;
- exit;
- end;
- is_virtual:=
- (([po_abstractmethod, po_virtualmethod, po_overridingmethod]*def.procoptions)<>[]) and
- not is_objc_class_or_protocol(def.struct) and
- not is_objectpascal_helper(def.struct);
- adddispflags(dinode,in_currentunit,is_virtual);
- if is_virtual then
- begin
- { the sizeof(pint) is a bit iffy, since vmtmethodoffset() calculates
- using a combination of voidcodepointer.size, voidpointer.size, and
- sizeof(pint). But that's what the debugger will use }
- dinode.addint64('virtualIndex',tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber) div sizeof(pint));
- {$ifdef extdebug}
- if (tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber) mod sizeof(pint))<>0 then
- internalerror(2022043001);
- {$endif}
- end;
- adddiflags(dinode,in_currentunit);
- dinode.addmetadatarefto('unit',fcunode);
- ditypenode:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DISubroutineType);
- ditypenode.addmetadatarefto('types',getabstractprocdeftypes(list,def));
- list.concat(ditypenode);
- dinode.addmetadatarefto('type',ditypenode);
- (*
- if assigned(def.parast) then
- begin
- { First insert self, because gdb uses the fact whether or not the
- first parameter of a method is artificial to distinguish static
- from regular methods. }
- { fortunately, self is the always the first parameter in the
- paralist, since it has the lowest paranr. Note that this is not
- true for Objective-C, but those methods are detected in
- another way (by reading the ObjC run time information) }
- write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras);
- end;
- { local type defs and vars should not be written
- inside the main proc }
- if in_currentunit and
- assigned(def.localst) and
- (def.localst.symtabletype=localsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
- { last write the types from this procdef }
- if assigned(def.parast) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
- { only try to write the localst if the routine is implemented here }
- if in_currentunit and
- assigned(def.localst) and
- (def.localst.symtabletype=localsymtable) then
- begin
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
- { Write nested procedures -- disabled, see scope check at the
- beginning; currently, these are still written in the global
- scope. }
- // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst);
- end;
- finish_children;
- *)
- def.dbg_state:=dbg_state_written;
- end;
- procedure TDebugInfoLLVM.adddefinitionlocal(dinode: tai_llvmspecialisedmetadatanode; definition, local, usedispflags: boolean; out dispFlags: tsymstr);
- begin
- dispflags:='';
- if not usedispflags then
- begin
- dinode.addboolean('isDefinition',definition);
- if definition then
- begin
- dinode.addboolean('isLocal',local);
- end;
- exit;
- end;
- if definition then
- begin
- dispflags:='DISPFlagDefinition';
- if local then
- dispflags:=dispflags+'|DISPFlagLocalToUnit';
- end;
- end;
- function TDebugInfoLLVM.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
- (*
- var
- elesize : pint;
- currdef : tdef;
- indirection: boolean;
- *)
- begin
- result:=false;
- (*
- if not assigned(symlist) then
- exit;
- sym:=nil;
- offset:=0;
- currdef:=nil;
- indirection:=false;
- repeat
- case symlist^.sltype of
- sl_load:
- begin
- if assigned(sym) then
- internalerror(2009031203);
- if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
- { can't handle... }
- exit;
- sym:=tabstractvarsym(symlist^.sym);
- currdef:=tabstractvarsym(sym).vardef;
- if ((sym.typ=paravarsym) and
- paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then
- indirection:=true;
- end;
- sl_subscript:
- begin
- if not assigned(currdef) then
- internalerror(2009031301);
- if (symlist^.sym.typ<>fieldvarsym) then
- internalerror(2009031202);
- { can't handle offsets with indirections yet }
- if indirection then
- exit;
- if is_packed_record_or_object(currdef) then
- begin
- { can't calculate the address of a non-byte aligned field }
- if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then
- exit;
- inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8)
- end
- else
- inc(offset,tfieldvarsym(symlist^.sym).fieldoffset);
- currdef:=tfieldvarsym(symlist^.sym).vardef;
- end;
- sl_absolutetype,
- sl_typeconv:
- begin
- currdef:=symlist^.def;
- { ignore, these don't change the address }
- end;
- sl_vec:
- begin
- if not assigned(currdef) or
- (currdef.typ<>arraydef) then
- internalerror(2009031201);
- { can't handle offsets with indirections yet }
- if indirection then
- exit;
- if not is_packed_array(currdef) then
- elesize:=tarraydef(currdef).elesize
- else
- begin
- elesize:=tarraydef(currdef).elepackedbitsize;
- { can't calculate the address of a non-byte aligned element }
- if (elesize mod 8)<>0 then
- exit;
- elesize:=elesize div 8;
- end;
- inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
- currdef:=tarraydef(currdef).elementdef;
- end;
- else
- internalerror(2009031403);
- end;
- symlist:=symlist^.next;
- until not assigned(symlist);
- if not assigned(sym) then
- internalerror(2009031205);
- result:=true;
- *)
- end;
- procedure TDebugInfoLLVM.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
- begin
- // appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]);
- end;
- procedure TDebugInfoLLVM.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: TSymStr; def: tdef; offset: pint(*; const flags: tdwarfvarsymflags*));
- (*
- var
- templist : TAsmList;
- blocksize,size_of_int : longint;
- tag : tdwarf_tag;
- has_high_reg : boolean;
- dreg,dreghigh : shortint;
- {$ifdef i8086}
- has_segment_sym_name : boolean=false;
- segment_sym_name : TSymStr='';
- segment_reg: TRegister=NR_NO;
- {$endif i8086}
- *)
- begin
- (*
- if vo_is_external in sym.varoptions then
- exit;
- blocksize:=0;
- dreghigh:=0;
- { There is no space allocated for not referenced locals }
- if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
- exit;
- templist:=TAsmList.create;
- case sym.localloc.loc of
- LOC_REGISTER,
- LOC_CREGISTER,
- LOC_MMREGISTER,
- LOC_CMMREGISTER,
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER :
- begin
- { dwarf_reg_no_error might return -1
- in case the register variable has been optimized out }
- dreg:=dwarf_reg_no_error(sym.localloc.register);
- has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO);
- if has_high_reg then
- dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi);
- if dreghigh=-1 then
- has_high_reg:=false;
- if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and
- (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) and (dreg>=0) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- templist.concat(tai_const.create_sleb128bit(0));
- blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(0);
- end
- else
- begin
- if has_high_reg then
- begin
- templist.concat(tai_comment.create(strpnew('high:low reg pair variable')));
- size_of_int:=sizeof(aint);
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
- templist.concat(tai_const.create_uleb128bit(size_of_int));
- blocksize:=blocksize+1+Lengthuleb128(size_of_int);
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreghigh));
- blocksize:=blocksize+1+Lengthuleb128(dreghigh);
- templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
- templist.concat(tai_const.create_uleb128bit(size_of_int));
- blocksize:=blocksize+1+Lengthuleb128(size_of_int);
- end
- else if (dreg>=0) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- end;
- end;
- end;
- else
- begin
- case sym.typ of
- staticvarsym:
- begin
- if vo_is_thread_var in sym.varoptions then
- begin
- if tf_section_threadvars in target_info.flags then
- begin
- case sizeof(puint) of
- 2:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const2u)));
- 4:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const4u)));
- 8:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const8u)));
- else
- Internalerror(2019100501);
- end;
- {$push}
- {$warn 6018 off} { Unreachable code due to compile time evaluation }
- templist.concat(tai_const.Create_type_name(aitconst_dtpoff,sym.mangledname,0));
- { so far, aitconst_dtpoff is solely 32 bit }
- if (sizeof(puint)=8) and (target_info.endian=endian_little) then
- templist.concat(tai_const.create_32bit(0));
- templist.concat(tai_const.create_8bit(ord(DW_OP_GNU_push_tls_address)));
- if (sizeof(puint)=8) and (target_info.endian=endian_big) then
- templist.concat(tai_const.create_32bit(0));
- {$pop}
- blocksize:=2+sizeof(puint);
- end
- else
- begin
- { TODO: !!! FIXME: dwarf for thread vars !!!}
- { This is only a minimal change to at least be able to get a value
- in only one thread is present PM 2014-11-21, like for stabs format }
- templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
- templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,
- offset+sizeof(pint)));
- blocksize:=1+sizeof(puint);
- end;
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
- templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset));
- blocksize:=1+sizeof(puint);
- {$ifdef i8086}
- segment_sym_name:=sym.mangledname;
- has_segment_sym_name:=true;
- {$endif i8086}
- end;
- end;
- paravarsym,
- localvarsym:
- begin
- { Happens when writing debug info for paras of procdefs not
- implemented in the current module. Can't add a general check
- for LOC_INVALID above, because staticvarsyms may also have it.
- }
- if sym.localloc.loc<> LOC_INVALID then
- begin
- if is_fbreg(sym.localloc.reference.base) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_fbreg)));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
- end
- else
- begin
- dreg:=dwarf_reg(sym.localloc.reference.base);
- if dreg<=31 then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(sym.localloc.reference.offset+offset);
- end;
- end;
- {$ifdef i8086}
- segment_reg:=sym.localloc.reference.segment;
- {$endif i8086}
- {$ifndef gdb_supports_DW_AT_variable_parameter}
- { Parameters which are passed by reference. (var and the like)
- Hide the reference-pointer and dereference the pointer
- in the DW_AT_location block.
- }
- if (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_deref)));
- inc(blocksize);
- end
- {$endif not gdb_supports_DW_AT_variable_parameter}
- end;
- end
- else
- internalerror(200601288);
- end;
- end;
- end;
- { function results must not be added to the parameter list,
- as they are not part of the signature of the function
- (gdb automatically adds them according to the ABI specifications
- when calling the function)
- }
- if (sym.typ=paravarsym) and
- not(dvf_force_local_var in flags) and
- not(vo_is_funcret in sym.varoptions) then
- tag:=DW_TAG_formal_parameter
- else
- tag:=DW_TAG_variable;
- { must be parasym of externally implemented procdef, but
- the parasymtable can con also contain e.g. absolutevarsyms
- -> check symtabletype}
- if (sym.owner.symtabletype=parasymtable) and
- (sym.localloc.loc=LOC_INVALID) then
- begin
- if (sym.owner.symtabletype<>parasymtable) then
- internalerror(2009101001);
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- ])
- end
- else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
- LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
- ((sym.owner.symtabletype = globalsymtable) or
- (sp_static in sym.symoptions) or
- (vo_is_public in sym.varoptions)) then
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- DW_AT_external,DW_FORM_flag,true,
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ])
- {$ifdef gdb_supports_DW_AT_variable_parameter}
- else if (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) then
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_variable_parameter,DW_FORM_flag,true,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ])
- {$endif gdb_supports_DW_AT_variable_parameter}
- else
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ]);
- { append block data }
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- { Mark self as artificial for methods, because gdb uses the fact
- whether or not the first parameter of a method is artificial to
- distinguish regular from static methods (since there are no
- no vo_is_self parameters for static methods, we don't have to check
- that). }
- if (vo_is_self in sym.varoptions) then
- append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
- {$ifdef i8086}
- if has_segment_sym_name then
- append_seg_name(segment_sym_name)
- else if segment_reg<>NR_NO then
- append_seg_reg(segment_reg);
- {$endif i8086}
- templist.free;
- finish_entry;
- *)
- end;
- procedure TDebugInfoLLVM.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
- var
- decl: taillvmdecl;
- globalvarexpression, globalvar: tai_llvmspecialisedmetadatanode;
- dispflags: tsymstr;
- islocal: boolean;
- begin
- decl:=staticvarsym_get_decl(sym);
- if not assigned(decl) then
- begin
- list.concat(tai_comment.create(strpnew('no declaration found for '+sym.mangledname)));
- exit;
- end;
- globalvar:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIGlobalVariable);
- list.concat(globalvar);
- globalvarexpression:=tai_llvmspecialisedmetadatanode.create(tspecialisedmetadatanodekind.DIGlobalVariableExpression);
- globalvarexpression.addmetadatarefto('var',globalvar);
- globalvarexpression.addmetadatarefto('expr',femptyexpression);
- list.concat(globalvarexpression);
- fglobals.addvalue(llvm_getmetadatareftypedconst(globalvarexpression));
- decl.addinsmetadata(tai_llvmmetadatareferenceoperand.createreferenceto('dbg',globalvarexpression));
- globalvar.addstring('name',symname(sym,false));
- if not assigned(sym.owner.defowner) then
- globalvar.addmetadatarefto('scope',fcunode)
- else
- globalvar.addmetadatarefto('scope',def_meta_node(tdef(sym.owner.defowner)));
- try_add_file_metaref(globalvar,sym.fileinfo,false);
- globalvar.addmetadatarefto('type',def_meta_node(sym.vardef));
- islocal:=not(
- ((sym.owner.symtabletype = globalsymtable) or
- (sp_static in sym.symoptions) or
- (vo_is_public in sym.varoptions))
- );
- adddefinitionlocal(globalvar,not(vo_is_external in sym.varoptions),islocal,false,dispflags);
- if dispflags<>'' then
- globalvar.addenum('spFlags',dispflags);
- end;
- procedure TDebugInfoLLVM.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
- begin
- // appendsym_var(list,sym);
- end;
- procedure TDebugInfoLLVM.appendsym_paravar(list:TAsmList;sym:tparavarsym);
- begin
- // appendsym_var(list,sym);
- end;
- procedure TDebugInfoLLVM.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
- begin
- appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0);
- end;
- procedure TDebugInfoLLVM.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
- var
- bitoffset,
- fieldoffset,
- fieldnatsize: asizeint;
- begin
- (*
- if (sp_static in sym.symoptions) or
- (sym.visibility=vis_hidden) then
- exit;
- if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
- { only ordinals are bitpacked }
- not is_ordinal(sym.vardef) then
- begin
- { other kinds of fields can however also appear in a bitpacked }
- { record, and then their offset is also specified in bits rather }
- { than in bytes }
- if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
- fieldoffset:=sym.fieldoffset
- else
- fieldoffset:=sym.fieldoffset div 8;
- inc(fieldoffset,offset);
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
- ]);
- end
- else
- begin
- if (sym.vardef.packedbitsize > 255) then
- internalerror(2007061201);
- { we don't bitpack according to the ABI, but as close as }
- { possible, i.e., equivalent to gcc's }
- { __attribute__((__packed__)), which is also what gpc }
- { does. }
- fieldnatsize:=max(sizeof(pint),sym.vardef.size);
- fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
- inc(fieldoffset,offset);
- bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
- if (target_info.endian=endian_little) then
- bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- { gcc also generates both a bit and byte size attribute }
- { we don't support ordinals >= 256 bits }
- DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
- { nor >= 256 bits (not yet, anyway, see IE above) }
- DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
- { data1 and data2 are unsigned, bitoffset can also be negative }
- DW_AT_bit_offset,DW_FORM_data4,bitoffset,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
- ]);
- end;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
- if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
- append_visibility(sym.visibility);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
- finish_entry;
- *)
- end;
- procedure TDebugInfoLLVM.appendsym_const(list:TAsmList;sym:tconstsym);
- begin
- appendsym_const_member(list,sym,false);
- end;
- procedure TDebugInfoLLVM.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
- var
- i,
- size: aint;
- usedef: tdef;
- begin
- (*
- { These are default values of parameters. These should be encoded
- via DW_AT_default_value, not as a separate sym. Moreover, their
- type is not available when writing the debug info for external
- procedures.
- }
- if (sym.owner.symtabletype=parasymtable) then
- exit;
- if ismember then
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- { The DW_AT_declaration tag is invalid according to the DWARF specifications.
- But gcc adds this to static const members and gdb checks
- for this flag. So we have to set it also.
- }
- DW_AT_declaration,DW_FORM_flag,true,
- DW_AT_external,DW_FORM_flag,true
- ])
- else
- append_entry(DW_TAG_variable,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0
- ]);
- { for string constants, constdef isn't set because they have no real type }
- case sym.consttyp of
- conststring:
- begin
- { if DW_FORM_string is used below one day, this usedef should
- probably become nil }
- { note: < 255 instead of <= 255 because we have to store the
- entire length of the string as well, and 256 does not fit in
- a byte }
- if (sym.value.len<255) then
- usedef:=cshortstringtype
- else
- usedef:=clongstringtype;
- end;
- constresourcestring,
- constwstring:
- usedef:=nil;
- else
- usedef:=sym.constdef;
- end;
- if assigned(usedef) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef));
- AddConstToAbbrev(ord(DW_AT_const_value));
- case sym.consttyp of
- conststring:
- begin
- { DW_FORM_string isn't supported yet by the Pascal value printer
- -> create a string using raw bytes }
- if (sym.value.len<255) then
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len+1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len));
- end
- else
- begin
- AddConstToAbbrev(ord(DW_FORM_block));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizesinttype.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_sizeint_unaligned(sym.value.len));
- end;
- i:=0;
- size:=sym.value.len;
- while(i<size) do
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
- inc(i);
- end;
- end;
- constguid,
- constset:
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(usedef.size));
- i:=0;
- size:=sym.constdef.size;
- while (i<size) do
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
- inc(i);
- end;
- end;
- constwstring,
- constresourcestring:
- begin
- { write dummy for now }
- AddConstToAbbrev(ord(DW_FORM_string));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
- end;
- constord:
- begin
- if (sym.value.valueord<0) then
- begin
- AddConstToAbbrev(ord(DW_FORM_sdata));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
- end
- else
- begin
- AddConstToAbbrev(ord(DW_FORM_udata));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.valueord.uvalue));
- end;
- end;
- constnil:
- begin
- {$ifdef cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(0));
- {$else cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(0));
- {$endif cpu64bitaddr}
- end;
- constpointer:
- begin
- {$ifdef cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(int64(sym.value.valueordptr)));
- {$else cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint(sym.value.valueordptr)));
- {$endif cpu64bitaddr}
- end;
- constreal:
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- case tfloatdef(sym.constdef).floattype of
- s32real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^));
- end;
- s64real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^));
- end;
- s64comp,
- s64currency:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(trunc(pbestreal(sym.value.valueptr)^)));
- end;
- s80real,
- sc80real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size));
- end;
- else
- internalerror(200601291);
- end;
- end;
- else
- internalerror(200601292);
- end;
- finish_entry;
- *)
- end;
- procedure TDebugInfoLLVM.appendsym_label(list:TAsmList;sym: tlabelsym);
- begin
- { ignore label syms for now, the problem is that a label sym
- can have more than one label associated e.g. in case of
- an inline procedure expansion }
- end;
- procedure TDebugInfoLLVM.appendsym_property(list:TAsmList;sym: tpropertysym);
- var
- symlist: ppropaccesslistitem;
- tosym: tabstractvarsym;
- offset: pint;
- begin
- (*
- if assigned(sym.propaccesslist[palt_read]) and
- not assigned(sym.propaccesslist[palt_read].procdef) then
- symlist:=sym.propaccesslist[palt_read].firstsym
- else
- { can't handle }
- exit;
- if not get_symlist_sym_offset(symlist,tosym,offset) then
- exit;
- if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- if (tosym.typ=fieldvarsym) then
- internalerror(2009031404);
- appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[])
- end
- else
- appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset)
- *)
- end;
- function TDebugInfoLLVM.symdebugname(sym: tsym): TSymStr;
- begin
- if ds_dwarf_cpp in current_settings.debugswitches then
- begin
- if sym.visibility=vis_hidden then
- result:=copy(sym.RealName,length('$hidden')+1,length(sym.RealName))
- else
- begin
- result:=sym.RealName;
- if (result<>'') and
- (result[1]='$') then
- delete(result,1,1);
- end
- end
- else if sym.visibility=vis_hidden then
- result:=copy(sym.name,length('hidden')+1,length(sym.name))
- else
- result:=sym.name
- end;
- procedure TDebugInfoLLVM.appendsym_type(list:TAsmList;sym: ttypesym);
- begin
- { just queue the def if needed, beforeappenddef will
- emit the typedef if necessary }
- get_def_metatai(sym.typedef);
- {
- if FindUnitSymtable(sym.Owner).iscurrentunit then
- fretainedtypes.addvalue(def_meta_ref(sym.typedef));
- }
- end;
- procedure TDebugInfoLLVM.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
- (*
- var
- templist : TAsmList;
- blocksize : longint;
- symlist : ppropaccesslistitem;
- tosym: tabstractvarsym;
- offset: pint;
- flags: tdwarfvarsymflags;
- *)
- begin
- (*
- templist:=TAsmList.create;
- case tabsolutevarsym(sym).abstyp of
- toaddr :
- begin
- { MWE: replaced ifdef i368 }
- {
- if target_cpu = cpu_i386 then
- begin
- { in theory, we could write a DW_AT_segment entry here for sym.absseg,
- however I doubt that gdb supports this (FK) }
- end;
- }
- templist.concat(tai_const.create_8bit(3));
- {$ifdef avr}
- // Add $800000 to indicate that the address is in memory space
- templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset + $800000, aitconst_ptr_unaligned));
- {$else}
- templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset));
- {$endif}
- blocksize:=1+sizeof(puint);
- end;
- toasm :
- begin
- templist.concat(tai_const.create_8bit(3));
- templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0));
- blocksize:=1+sizeof(puint);
- end;
- tovar:
- begin
- symlist:=tabsolutevarsym(sym).ref.firstsym;
- if get_symlist_sym_offset(symlist,tosym,offset) then
- begin
- if (tosym.typ=fieldvarsym) then
- internalerror(2009031402);
- flags:=[];
- if (sym.owner.symtabletype=localsymtable) then
- include(flags,dvf_force_local_var);
- appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags);
- end;
- templist.free;
- exit;
- end;
- end;
- append_entry(DW_TAG_variable,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- DW_AT_external,DW_FORM_flag,true,
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ]);
- { append block data }
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
- templist.free;
- finish_entry;
- *)
- end;
- procedure TDebugInfoLLVM.beforeappendsym(list:TAsmList;sym:tsym);
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true))));
- end;
- procedure TDebugInfoLLVM.insertmoduleinfo;
- var
- culist: tai_llvmnamedmetadatanode;
- dwarfversionflag: tai_llvmbasemetadatanode;
- objcruntimeversion: longint;
- begin
- ensuremetainit;
- { debug info header }
- if ds_dwarf_cpp in current_settings.debugswitches then
- fcunode.addenum('language','DW_LANG_C_plus_plus')
- else
- fcunode.addenum('language','DW_LANG_Pascal83');
- fcunode.addmetadatarefto('file',file_getmetanode(current_filepos.moduleindex,current_filepos.fileindex));
- fcunode.addstring('producer','Free Pascal Compiler '+full_version_string);
- fcunode.addboolean('isOptimized',cs_opt_level2 in current_settings.optimizerswitches);
- if target_info.system in systems_objc_supported then
- begin
- if ([m_objectivec1,m_objectivec2]*current_settings.modeswitches)<>[] then
- if target_info.system in systems_objc_nfabi then
- objcruntimeversion:=2
- else
- objcruntimeversion:=1
- else
- objcruntimeversion:=0;
- fcunode.addint64('runtimeVersion',objcruntimeversion);
- end;
- if cs_debuginfo in current_settings.moduleswitches then
- fcunode.addenum('emissionKind','FullDebug')
- else
- fcunode.addenum('emissionKind','LineTablesOnly');
- if fenums.valuecount<>0 then
- begin
- fcunode.addmetadatarefto('enums',fenums);
- current_asmdata.AsmLists[al_dwarf_info].Concat(fenums);
- end
- else
- begin
- fcunode.addmetadatarefto('enums',nil);
- fenums.free;
- end;
- fenums:=nil;
- if fretainedtypes.valuecount<>0 then
- begin
- fcunode.addmetadatarefto('retainedTypes',fretainedtypes);
- current_asmdata.AsmLists[al_dwarf_info].Concat(fretainedtypes);
- end
- else
- begin
- fcunode.addmetadatarefto('retainedTypes',nil);
- fretainedtypes.free;
- end;
- fretainedtypes:=nil;
- if fglobals.valuecount<>0 then
- begin
- fcunode.addmetadatarefto('globals',fglobals);
- current_asmdata.AsmLists[al_dwarf_info].Concat(fglobals);
- end
- else
- begin
- fcunode.addmetadatarefto('globals',nil);
- fglobals.free;
- end;
- fglobals:=nil;
- current_asmdata.AsmLists[al_dwarf_info].Concat(femptyexpression);
- femptyexpression:=nil;
- current_asmdata.AsmLists[al_dwarf_info].Concat(fderefexpression);
- fderefexpression:=nil;
- if target_info.system in systems_darwin then
- fcunode.addenum('nameTableKind','GNU');
- current_asmdata.AsmLists[al_dwarf_info].Concat(fcunode);
- culist:=tai_llvmnamedmetadatanode.create('llvm.dbg.cu');
- current_asmdata.AsmLists[al_dwarf_info].Concat(culist);
- culist.addvalue(llvm_getmetadatareftypedconst(fcunode));
- resetfornewmodule;
- end;
- procedure TDebugInfoLLVM.inserttypeinfo;
- var
- storefilepos : tfileposinfo;
- i : longint;
- def: tdef;
- vardatatype: ttypesym;
- begin
- ensuremetainit;
- storefilepos:=current_filepos;
- current_filepos:=current_module.mainfilepos;
- vardatatype:=try_search_system_type('TVARDATA');
- if assigned(vardatatype) then
- vardatadef:=trecorddef(vardatatype.typedef);
- collectglobalsyms;
- { write all global/local variables. This will flag all required tdefs }
- if assigned(current_module.globalsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { write all procedures and methods. This will flag all required tdefs }
- if assigned(current_module.globalsymtable) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { reset unit type info flag }
- reset_unit_type_info;
- { write used types from the used units }
- write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
- { last write the types from this unit }
- if assigned(current_module.globalsymtable) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { write defs not written yet }
- write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]);
- { reset all def debug states for LLVMTypeInfo (which also uses this
- field, to track for which types type info has been inserted already }
- for i:=0 to defnumberlist.count-1 do
- begin
- def := tdef(defnumberlist[i]);
- if assigned(def) then
- def.dbg_state:=dbg_state_unused;
- end;
- current_filepos:=storefilepos;
- end;
- function TDebugInfoLLVM.symname(sym: tsym; manglename: boolean): TSymStr;
- begin
- if (sym.typ=paravarsym) and
- (vo_is_self in tparavarsym(sym).varoptions) then
- { We use 'this' for regular methods because that's what gdb triggers
- on to automatically search fields. Don't do this for class methods,
- because search class fields is not supported, and gdb 7.0+ fails
- in this case because "this" is not a record in that case (it's a
- pointer to a vmt) }
- if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and
- not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
- result:='this'
- else
- result:='self'
- else if (sym.typ=typesym) and
- is_objc_class_or_protocol(ttypesym(sym).typedef) then
- result:=tobjectdef(ttypesym(sym).typedef).objextname^
- else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
- (sym.typ=procsym) and
- (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- result:=tprocsym(sym).owner.name^+'__';
- if manglename then
- result := result + sym.name
- else
- result := result + symdebugname(sym);
- end
- else
- begin
- if manglename then
- result := sym.name
- else
- result := symdebugname(sym);
- end;
- end;
- function TDebugInfoLLVM.visibilitydiflag(vis: tvisibility): TSymStr;
- begin
- case vis of
- vis_hidden,
- vis_private,
- vis_strictprivate:
- result:='DIFlagPrivate';
- vis_protected,
- vis_strictprotected:
- result:='DIFlagProtected';
- vis_published,
- vis_public:
- result:='DIFlagPublic';
- vis_none:
- internalerror(2022050101);
- end;
- end;
- procedure TDebugInfoLLVM.insertlineinfo(list:TAsmList);
- var
- hp: tai;
- functionscope,
- positionmeta: tai_llvmspecialisedmetadatanode;
- pd: tprocdef;
- procdeffileinfo: tfileposinfo;
- nolineinfolevel : longint;
- firstline: boolean;
- begin
- ensuremetainit;
- hp:=tai(list.first);
- while assigned(hp) and
- ((hp.typ<>ait_llvmdecl) or
- (taillvmdecl(hp).def.typ<>procdef)) do
- begin
- hp:=tai(hp.next);
- end;
- if not assigned(hp) then
- exit;
- pd:=tprocdef(taillvmdecl(hp).def);
- procdeffileinfo:=pd.fileinfo;
- { might trigger for certain kinds of internally generated code }
- if procdeffileinfo.fileindex=0 then
- exit;
- flocalvarsymmeta.free;
- flocalvarsymmeta:=THashSet.Create((pd.localst.SymList.count+pd.parast.SymList.count)*4+1,true,false);
- functionscope:=def_meta_node(pd);
- nolineinfolevel:=0;
- hp:=tai(hp.next);
- firstline:=true;
- while assigned(hp) do
- begin
- case hp.typ of
- ait_marker:
- begin
- case tai_marker(hp).kind of
- mark_NoLineInfoStart:
- inc(nolineinfolevel);
- mark_NoLineInfoEnd:
- dec(nolineinfolevel);
- else
- ;
- end;
- end;
- else
- ;
- end;
- if (hp.typ=ait_llvmins) and
- ((nolineinfolevel=0) or
- (taillvm(hp).llvmopcode=la_call)) then
- begin
- positionmeta:=nil;
- { valid file -> add info }
- if (tailineinfo(hp).fileinfo.fileindex<>0) then
- begin
- if firstline and
- (nolineinfolevel=0) then
- begin
- functionscope.addint64('scopeLine',tailineinfo(hp).fileinfo.line);
- firstline:=false;
- end;
- positionmeta:=filepos_getmetanode(tailineinfo(hp).fileinfo,procdeffileinfo,functionscope,nolineinfolevel<>0);
- end
- { LLVM requires line info for call instructions that may
- potentially be inlined }
- else if taillvm(hp).llvmopcode=la_call then
- begin
- positionmeta:=filepos_getmetanode(tailineinfo(hp).fileinfo,procdeffileinfo,functionscope,true);
- end;
- if assigned(positionmeta) then
- taillvm(hp).addinsmetadata(tai_llvmmetadatareferenceoperand.createreferenceto('dbg',positionmeta));
- if (cs_debuginfo in current_settings.moduleswitches) and
- (taillvm(hp).llvmopcode=la_call) then
- updatelocalvardbginfo(taillvm(hp),pd,functionscope);
- end;
- hp:=tai(hp.next);
- end;
- end;
- {****************************************************************************
- ****************************************************************************}
- const
- dbg_llvm_info : tdbginfo =
- (
- id : dbg_llvm;
- idtxt : 'LLVM';
- );
- initialization
- RegisterDebugInfo(dbg_llvm_info,TDebugInfoLLVM);
- end.
|