1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977 |
- {
- 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_declare_pd: tprocdef;
- 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_kind: tspecialisedmetadatanodekind): 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;
- 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: 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,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
- if assigned(def.typesym) then
- result:=get_def_metatai(def)^.implmetadef
- else
- result:=def_meta_node(def);
- end;
- function TDebugInfoLLVM.def_set_meta_impl(def: tdef; meta_kind: tspecialisedmetadatanodekind): tai_llvmspecialisedmetadatanode;
- begin
- if assigned(def.typesym) then
- begin
- result:=tai_llvmspecialisedmetadatanode.create(meta_kind);
- get_def_metatai(def)^.implmetadef:=result
- end
- else
- begin
- result:=def_meta_node(def);
- result.switchkind(meta_kind);
- end;
- 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_declare_pd) then
- fllvm_dbg_declare_pd:=search_system_proc('llvm_dbg_declare');
- 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_declare_pd) and
- (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(2022041730);
- 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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,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);
- impldinode:=def_meta_impl(def);
- if not assigned(impldinode) then
- internalerror(2021120501);
- 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;
- if assigned(def.typesym) and
- not(df_generic in def.defoptions) then
- begin
- if refdinode=impldinode then
- internalerror(2022110710);
- refdinode.addenum('tag','DW_TAG_typedef');
- refdinode.addstring('name',symname(def.typesym,false));
- try_add_file_metaref(refdinode,def.typesym.fileinfo,false);
- refdinode.addmetadatarefto('baseType',impldinode);
- list.concat(refdinode);
- end
- else if impldinode<>refdinode then
- internalerror(2022110711);
- 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 in [la_call,la_invoke])) 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 }
- if (taillvm(hp).llvmopcode in [la_call,la_invoke]) and
- not assigned(positionmeta) then
- begin
- positionmeta:=filepos_getmetanode(procdeffileinfo,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.
|