dbgdwarf.pas 190 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770
  1. {
  2. Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl
  3. This units contains support for DWARF debug info generation
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {
  18. This units contains support for DWARF debug info generation.
  19. Currently a lot of code looks like being mergable with dbgstabs. This might
  20. change however when improved dwarf info is generated, so the stuff shouldn't be
  21. merged yet. (FK)
  22. The easiest way to debug dwarf debug info generation is the usage of
  23. readelf --debug-dump <executable>
  24. This works only with elf targets though.
  25. There is a similar utility called dwarfdump which is not elf-specific and
  26. which has been ported to most systems.
  27. }
  28. unit dbgdwarf;
  29. {$i fpcdefs.inc}
  30. interface
  31. uses
  32. cclasses,globtype,
  33. cgbase,
  34. aasmbase,aasmtai,aasmdata,
  35. symbase,symconst,symtype,symdef,symsym,
  36. finput,
  37. DbgBase, dbgdwarfconst;
  38. type
  39. {$ifdef avr}
  40. // re-map to larger types because of offsets required to distinguish different memory spaces
  41. puint = cardinal;
  42. pint = longint;
  43. {$endif avr}
  44. TDwarfFile = record
  45. Index: integer;
  46. Name: PChar;
  47. end;
  48. { flags for emitting variables/parameters }
  49. tdwarfvarsymflag =
  50. { force the sym to be emitted as a local variable regardless of its
  51. type; used for "absolute" local variables referring to parameters.
  52. }
  53. (dvf_force_local_var
  54. );
  55. tdwarfvarsymflags = set of tdwarfvarsymflag;
  56. pAbbrevSearchTreeItem = ^tAbbrevSearchTreeItem;
  57. tAbbrevSearchTreeItem = record
  58. value: QWord;
  59. Abbrev: longint;
  60. // When this item does not match the abbrev-value, look for it
  61. // in the next SearchItem
  62. SearchItem: pAbbrevSearchTreeItem;
  63. // Next and prior item of the abbrev-section
  64. NextItem: pAbbrevSearchTreeItem;
  65. PriorItem: pAbbrevSearchTreeItem;
  66. bit8: boolean;
  67. end;
  68. { Sometimes a property references a field of which the debug info is
  69. not yet written, so it's offset is not known yet.
  70. In those cases a tai_const is added and a reference is kept in a
  71. PTaiConstItem-structure. So that the offset could be filled into the
  72. tai_const as soon it is available }
  73. { TPendingOffsetConst }
  74. TPendingOffsetConst = class(tobject)
  75. tc: tai_const;
  76. { It could be that there is more then one property referencing this field/
  77. method }
  78. next: TPendingOffsetConst;
  79. destructor Destroy; override;
  80. end;
  81. TDwarfHashSetItem = record
  82. HashSetItem: THashSetItem;
  83. lab, ref_lab: tasmsymbol;
  84. { Label for the structure-part of types that contain a structure.
  85. (objects, records and such) For types encoded with an implicit
  86. reference, struct_lab differs from lab }
  87. struct_lab: tasmsymbol;
  88. end;
  89. PDwarfHashSetItem = ^TDwarfHashSetItem;
  90. TDwarfLabHashSet = class(THashSet)
  91. class function SizeOfItem: Integer; override;
  92. end;
  93. { TDebugInfoDwarf }
  94. TDebugInfoDwarf = class(TDebugInfo)
  95. private
  96. currabbrevnumber : longint;
  97. { use this defs to create info for variants and file handles }
  98. { unused (MWE)
  99. filerecdef,
  100. textrecdef : tdef;
  101. }
  102. dirlist: TFPHashObjectList;
  103. filesequence: Integer;
  104. loclist: tdynamicarray;
  105. asmline: TAsmList;
  106. { lookup table for def -> DWARF-labels }
  107. dwarflabels: TDwarfLabHashSet;
  108. { lookup table for def/sym -> pending offsets }
  109. PendingOffsets: THashSet;
  110. // The current entry in dwarf_info with the link to the abbrev-section
  111. dwarf_info_abbref_tai: tai_const;
  112. // Empty start-item of the abbrev-searchtree
  113. AbbrevSearchTree: pAbbrevSearchTreeItem;
  114. // The current abbrev-item
  115. CurrentSearchTreeItem: pAbbrevSearchTreeItem;
  116. // Is true when the abbrev-section is newly created
  117. NewAbbrev: boolean;
  118. { To encode properties it must be possible to reference every field and/
  119. or method. It is undoable to add labels for each of them, so instead
  120. an offset relative to the label at the start of the
  121. structure's debug-info is kept.
  122. To be able to do so the current offset is kept in DwarfOffset, which is
  123. increased each time something is added to the al_dwarf_info-asmlist }
  124. DwarfOffset: Int64;
  125. procedure ResetDwarfOffset;
  126. procedure StartAbbrevSearch;
  127. procedure AddConstToAbbrev(Value: QWord; bit8:boolean=false);
  128. procedure StartAbbrevSectionFromSearchtree;
  129. procedure WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem);
  130. function FinishAbbrevSearch: longint;
  131. procedure set_sym_dwarf_offset(sym:tsym; dwarf_offset: integer);
  132. procedure set_def_dwarf_offset(def: tprocdef; dwarf_offset: integer);
  133. procedure set_pending_dwarf_offset(def_or_sym: tobject; dwarf_offset: integer);
  134. function def_dwarf_lab(def:tdef) : tasmsymbol;
  135. function def_dwarf_ref_lab(def:tdef) : tasmsymbol;
  136. function def_dwarf_class_struct_lab(def:tabstractrecorddef) : tasmsymbol;
  137. function get_file_index(afile: tinputfile): Integer;
  138. function relative_dwarf_path(const s:tcmdstr):tcmdstr;
  139. protected
  140. // set if we should use 64bit headers (dwarf3 and up)
  141. _use_64bit_headers: Boolean;
  142. // set to ait_const32bit if use_64bit_headers is false, otherwise
  143. // to ait_const64bit
  144. offsetreltype,
  145. offsetabstype : taiconst_type;
  146. // set if we generated any lineinfo at all. If not, we have to terminate
  147. // when insertmoduleinfo is called.
  148. generated_lineinfo: boolean;
  149. vardatadef: trecorddef;
  150. procedure set_use_64bit_headers(state: boolean);
  151. property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers;
  152. function get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
  153. function need_struct_def_lab(def:tdef): Boolean;
  154. procedure append_to_al_dwarf_info(Item:TLinkedListItem; size: integer; list: TAsmList = nil);
  155. procedure append_realconst_to_al_dwarf_info(Item: tai_realconst; list: TAsmList = nil);
  156. procedure append_const_to_al_dwarf_info(Item: tai_const; list: TAsmList = nil);
  157. function is_fbreg(reg:tregister):boolean;
  158. { Convenience version of the method below, so the compiler creates the
  159. tvarrec for us (must only pass one element in the last parameter). }
  160. procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
  161. procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
  162. procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  163. procedure append_block1(attr: tdwarf_attribute; size: aint);
  164. procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  165. procedure append_labelentry_addr_ref(sym : tasmsymbol); virtual;
  166. procedure append_labelentry_addr_ref_offset(sym : tasmsymbol; offset: Int64); virtual;
  167. procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  168. procedure append_labelentry_ref_offset(attr : tdwarf_attribute;sym : tasmsymbol; offset: Int64); virtual;
  169. procedure append_offsetentry_ref(attr: tdwarf_attribute;def_or_sym: tobject;dwarf_offset: Integer;anchorlabel: TAsmSymbol);
  170. procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
  171. procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
  172. procedure append_labelentry_dataptr_common(attr : tdwarf_attribute);
  173. procedure append_pointerclass(list:TAsmList;def:tpointerdef);
  174. procedure append_proc_frame_base(list:TAsmList;def:tprocdef);
  175. {$ifdef i8086}
  176. procedure append_seg_name(const name:string);
  177. procedure append_seg_reg(const segment_register:tregister);
  178. {$endif i8086}
  179. procedure beforeappenddef(list:TAsmList;def:tdef);override;
  180. procedure afterappenddef(list:TAsmList;def:tdef);override;
  181. procedure appenddef_ord(list:TAsmList;def:torddef);override;
  182. procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
  183. procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
  184. procedure appenddef_array(list:TAsmList;def:tarraydef);override;
  185. procedure appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring);
  186. procedure appenddef_record(list:TAsmList;def:trecorddef);override;
  187. procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
  188. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  189. procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
  190. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  191. function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  192. procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  193. procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags);
  194. { used for fields and properties mapped to fields }
  195. procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint; is_fake_property: boolean);
  196. procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
  197. procedure beforeappendsym(list:TAsmList;sym:tsym);override;
  198. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  199. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  200. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  201. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  202. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  203. procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
  204. procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
  205. procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
  206. procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
  207. function symdebugname(sym:tsym): String; virtual;
  208. function symname(sym: tsym; manglename: boolean): String; virtual;
  209. procedure append_visibility(vis: tvisibility);
  210. procedure enum_membersyms_callback(p:TObject;arg:pointer);
  211. procedure finish_children;
  212. procedure finish_entry;
  213. procedure finish_lineinfo;
  214. public
  215. constructor Create;override;
  216. destructor Destroy;override;
  217. procedure insertmoduleinfo;override;
  218. procedure inserttypeinfo;override;
  219. procedure referencesections(list:TAsmList);override;
  220. procedure insertlineinfo(list:TAsmList);override;
  221. function dwarf_version: Word; virtual; abstract;
  222. end;
  223. { TDebugInfoDwarf2 }
  224. TDebugInfoDwarf2 = class(TDebugInfoDwarf)
  225. private
  226. protected
  227. procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean);
  228. procedure append_object_struct(def: tobjectdef; const objectname: PShortString);
  229. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  230. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  231. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  232. procedure appenddef_set(list:TAsmList;def:tsetdef); override;
  233. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  234. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  235. public
  236. function dwarf_version: Word; override;
  237. end;
  238. { TDebugInfoDwarf3 }
  239. TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
  240. private
  241. protected
  242. procedure append_labelentry_addr_ref(sym : tasmsymbol); override;
  243. procedure append_labelentry_addr_ref_offset(sym : tasmsymbol; offset: Int64); override;
  244. procedure appenddef_array(list:TAsmList;def:tarraydef); override;
  245. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  246. procedure appenddef_file(list:TAsmList;def:tfiledef); override;
  247. procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
  248. procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
  249. procedure appenddef_set(list:TAsmList;def: tsetdef); override;
  250. procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
  251. procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
  252. function symdebugname(sym:tsym): String; override;
  253. public
  254. function dwarf_version: Word; override;
  255. end;
  256. TDebugInfoDwarf4 = class(TDebugInfoDwarf3)
  257. public
  258. function dwarf_version: Word; override;
  259. end;
  260. implementation
  261. uses
  262. sysutils,cutils,cfileutl,constexp,
  263. version,globals,verbose,systems,
  264. cpubase,cpuinfo,paramgr,
  265. fmodule,
  266. defutil,symtable,symcpu,ppu
  267. {$ifdef OMFOBJSUPPORT}
  268. ,dbgcodeview
  269. {$endif OMFOBJSUPPORT}
  270. ;
  271. const
  272. LINE_BASE = 1;
  273. OPCODE_BASE = 13;
  274. const
  275. DW_TAG_lo_user = $4080;
  276. DW_TAG_hi_user = $ffff;
  277. { Flag that tells whether entry has a child or not. }
  278. DW_children_no = 0;
  279. DW_children_yes = 1;
  280. const
  281. { Implementation-defined range start. }
  282. DW_AT_lo_user = $2000;
  283. { Implementation-defined range end. }
  284. DW_AT_hi_user = $3ff0;
  285. const
  286. { Implementation-defined range start. }
  287. DW_LANG_lo_user = $8000;
  288. { Implementation-defined range start. }
  289. DW_LANG_hi_user = $ffff;
  290. {$ifdef avr}
  291. // More space required to include memory type offset
  292. aitconst_ptr_unaligned = aitconst_32bit_unaligned;
  293. {$endif avr}
  294. type
  295. { Names and codes for macro information. }
  296. tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2,
  297. DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4,
  298. DW_MACINFO_vendor_ext := 255);
  299. const
  300. DW_ATE_lo_user = $80;
  301. DW_ATE_hi_user = $ff;
  302. type
  303. Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1
  304. );
  305. { Access attribute. }
  306. Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2,
  307. DW_ACCESS_private := 3);
  308. { Visibility. }
  309. Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2,
  310. DW_VIS_qualified := 3);
  311. { Virtuality. }
  312. Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1,
  313. DW_VIRTUALITY_pure_virtual := 2);
  314. { Case sensitivity. }
  315. Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1,
  316. DW_ID_down_case := 2,DW_ID_case_insensitive := 3
  317. );
  318. { Calling convention. }
  319. Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2,
  320. DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40, DW_CC_GNU_borland_fastcall_i386 := $41
  321. );
  322. const
  323. { Implementation-defined range start. }
  324. DW_OP_lo_user = $e0;
  325. { Implementation-defined range end. }
  326. DW_OP_hi_user = $ff;
  327. const
  328. DW_LNS_extended_op = $00;
  329. { next copied from cfidwarf, need to go to something shared }
  330. DW_LNS_copy = $01;
  331. DW_LNS_advance_pc = $02;
  332. DW_LNS_advance_line = $03;
  333. DW_LNS_set_file = $04;
  334. DW_LNS_set_column = $05;
  335. DW_LNS_negate_stmt = $06;
  336. DW_LNS_set_basic_block = $07;
  337. DW_LNS_const_add_pc = $08;
  338. DW_LNS_fixed_advance_pc = $09;
  339. DW_LNS_set_prologue_end = $0a;
  340. DW_LNS_set_epilogue_begin = $0b;
  341. DW_LNS_set_isa = $0c;
  342. DW_LNE_end_sequence = $01;
  343. DW_LNE_set_address = $02;
  344. DW_LNE_define_file = $03;
  345. { DW_LNE_set_segment is a non-standard Open Watcom extension. It might
  346. create conflicts with future versions of the DWARF standard. }
  347. DW_LNE_set_segment = $04;
  348. DW_LNE_lo_user = $80;
  349. DW_LNE_hi_user = $ff;
  350. type
  351. { TDirIndexItem }
  352. TDirIndexItem = class(TFPHashObject)
  353. private
  354. FFiles: TFPHashObjectList;
  355. public
  356. IndexNr : Integer;
  357. constructor Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
  358. destructor Destroy;override;
  359. property Files: TFPHashObjectList read FFiles;
  360. end;
  361. { TFileIndexItem }
  362. TFileIndexItem = class(TFPHashObject)
  363. private
  364. FDirIndex: Integer;
  365. public
  366. IndexNr : Integer;
  367. constructor Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
  368. property DirIndex: Integer read FDirIndex;
  369. end;
  370. {****************************************************************************
  371. procs
  372. ****************************************************************************}
  373. function DirListSortCompare(AItem1, AItem2: Pointer): Integer;
  374. begin
  375. Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr;
  376. end;
  377. function FileListSortCompare(AItem1, AItem2: Pointer): Integer;
  378. begin
  379. Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr;
  380. end;
  381. function AllocateNewAiSearchItem: pAbbrevSearchTreeItem;
  382. begin
  383. new(result);
  384. FillChar(result^,sizeof(result^),#0);
  385. end;
  386. procedure FreeSearchItem(SI: pAbbrevSearchTreeItem);
  387. begin
  388. if assigned(SI^.NextItem) then
  389. FreeSearchItem(SI^.NextItem);
  390. if assigned(SI^.SearchItem) then
  391. FreeSearchItem(SI^.SearchItem);
  392. Dispose(SI);
  393. end;
  394. { TPendingOffsetConst }
  395. destructor TPendingOffsetConst.Destroy;
  396. begin
  397. next.Free;
  398. inherited Destroy;
  399. end;
  400. {****************************************************************************
  401. TDwarfLabHashSet
  402. ****************************************************************************}
  403. class function TDwarfLabHashSet.SizeOfItem: Integer;
  404. begin
  405. Result:=sizeof(TDwarfHashSetItem);
  406. end;
  407. {****************************************************************************
  408. TDirIndexItem
  409. ****************************************************************************}
  410. constructor TDirIndexItem.Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
  411. begin
  412. inherited Create(AList,AName);
  413. FFiles := TFPHashObjectList.Create;
  414. IndexNr := AIndex;
  415. end;
  416. destructor TDirIndexItem.Destroy;
  417. begin
  418. FFiles.Free;
  419. inherited Destroy;
  420. end;
  421. {****************************************************************************
  422. TFileIndexItem
  423. ****************************************************************************}
  424. constructor TFileIndexItem.Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
  425. begin
  426. inherited Create(AList,Aname);
  427. FDirIndex := ADirIndex;
  428. IndexNr := AIndex;
  429. end;
  430. {****************************************************************************
  431. TDebugInfoDwarf
  432. ****************************************************************************}
  433. procedure TDebugInfoDwarf.StartAbbrevSearch;
  434. begin
  435. CurrentSearchTreeItem:=AbbrevSearchTree;
  436. end;
  437. procedure TDebugInfoDwarf.WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem);
  438. begin
  439. if SI^.bit8 then
  440. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_8bit(SI^.value))
  441. else
  442. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_uleb128bit(SI^.value));
  443. end;
  444. procedure TDebugInfoDwarf.StartAbbrevSectionFromSearchtree;
  445. procedure AddCurrentAndPriorItemsToAbrev(SI: pAbbrevSearchTreeItem);
  446. begin
  447. if assigned(SI^.PriorItem) then
  448. AddCurrentAndPriorItemsToAbrev(SI^.PriorItem);
  449. WriteSearchItemToAbbrevSection(SI);
  450. end;
  451. begin
  452. NewAbbrev:=true;
  453. inc(currabbrevnumber);
  454. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber))));
  455. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber));
  456. if CurrentSearchTreeItem<>AbbrevSearchTree then
  457. AddCurrentAndPriorItemsToAbrev(CurrentSearchTreeItem);
  458. end;
  459. function TDebugInfoDwarf.FinishAbbrevSearch: longint;
  460. procedure FinalizeAbbrevSection;
  461. begin
  462. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  463. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  464. CurrentSearchTreeItem^.Abbrev:=currabbrevnumber;
  465. NewAbbrev := false;
  466. end;
  467. begin
  468. if NewAbbrev then
  469. FinalizeAbbrevSection;
  470. result := CurrentSearchTreeItem^.Abbrev;
  471. if result=0 then
  472. begin
  473. // In this case the abbrev-section equals an existing longer abbrev section.
  474. // So a new abbrev-section has to be made which ends on the current
  475. // searchtree item
  476. StartAbbrevSectionFromSearchtree;
  477. FinalizeAbbrevSection;
  478. result := CurrentSearchTreeItem^.Abbrev;
  479. end;
  480. end;
  481. procedure TDebugInfoDwarf.AddConstToAbbrev(Value: QWord; bit8:boolean);
  482. procedure AddCurrentItemToAbbrev;
  483. begin
  484. CurrentSearchTreeItem^.value:=value;
  485. CurrentSearchTreeItem^.bit8:=bit8;
  486. WriteSearchItemToAbbrevSection(CurrentSearchTreeItem);
  487. end;
  488. var si: pAbbrevSearchTreeItem;
  489. begin
  490. // Instead of adding this value directly to the ai-tree, search if an
  491. // abbrev section with the same values already exist, and use the existing
  492. // one or create one.
  493. if NewAbbrev then
  494. begin
  495. // The current abbrev-section is new, so add the value to the abbrev-section
  496. // and add it to the search-list.
  497. CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem;
  498. CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem;
  499. CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem;
  500. AddCurrentItemToAbbrev;
  501. end
  502. else
  503. begin
  504. // Search for the value which is added in the next sections of the
  505. // searchtree for a match
  506. si := CurrentSearchTreeItem^.NextItem;
  507. while assigned(si) do
  508. begin
  509. if (SI^.value=Value) and (si^.bit8=bit8) then
  510. begin
  511. // If a match is found, set the current searchtree item to the next item
  512. CurrentSearchTreeItem:=SI;
  513. Exit;
  514. end
  515. else if si^.SearchItem=nil then
  516. begin
  517. // If no match is found, add a new item to the searchtree and write
  518. // a new abbrev-section.
  519. StartAbbrevSectionFromSearchtree;
  520. si^.SearchItem:=AllocateNewAiSearchItem;
  521. if currentsearchtreeitem<>AbbrevSearchTree then
  522. si^.SearchItem^.PriorItem:=CurrentSearchTreeItem;
  523. CurrentSearchTreeItem := si^.SearchItem;
  524. AddCurrentItemToAbbrev;
  525. Exit;
  526. end;
  527. Si := SI^.SearchItem;
  528. end;
  529. // The abbrev section we are looking for is longer than the one
  530. // which is already in the search-tree. So expand the searchtree with
  531. // the new value and write a new abbrev section
  532. StartAbbrevSectionFromSearchtree;
  533. CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem;
  534. if currentsearchtreeitem^.PriorItem<>AbbrevSearchTree then
  535. CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem;
  536. CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem;
  537. AddCurrentItemToAbbrev;
  538. end;
  539. end;
  540. function TDebugInfoDwarf.relative_dwarf_path(const s:tcmdstr):tcmdstr;
  541. begin
  542. { Make a clean path for gdb. Remove trailing / and ./ prefixes and
  543. use always a / }
  544. result:=BsToSlash(ExcludeTrailingPathDelimiter(ExtractRelativePath(GetCurrentDir,FixFileName(ExpandFileName(s)))));
  545. end;
  546. procedure TDebugInfoDwarf.set_use_64bit_headers(state: boolean);
  547. begin
  548. _use_64bit_headers:=state;
  549. if not(state) then
  550. begin
  551. if (target_info.system in systems_windows+systems_wince) then
  552. offsetabstype:=aitconst_secrel32_symbol
  553. else
  554. offsetabstype:=aitconst_32bit_unaligned;
  555. if (target_info.system in systems_darwin) then
  556. offsetreltype:=aitconst_darwin_dwarf_delta32
  557. else
  558. offsetreltype:=aitconst_32bit_unaligned;
  559. end
  560. else
  561. begin
  562. if (target_info.system in systems_darwin) then
  563. offsetreltype:=aitconst_darwin_dwarf_delta64
  564. else
  565. offsetreltype:=aitconst_64bit_unaligned;
  566. offsetabstype:=aitconst_64bit_unaligned;
  567. end;
  568. end;
  569. function TDebugInfoDwarf.get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
  570. var
  571. needstructdeflab: boolean;
  572. begin
  573. { Keep track of used dwarf entries, this info is only useful for dwarf entries
  574. referenced by the symbols. Definitions will always include all
  575. required stabs }
  576. if def.dbg_state=dbg_state_unused then
  577. def.dbg_state:=dbg_state_used;
  578. { Need a new label? }
  579. result:=PDwarfHashSetItem(dwarflabels.FindOrAdd(@def,sizeof(def)));
  580. { the other fields besides Data are not initialised }
  581. if not assigned(result^.HashSetItem.Data) then
  582. begin
  583. { Mark as initialised }
  584. result^.HashSetItem.Data:=self;
  585. { A record needs a label also, so it is possible to reference fields /
  586. methods in a property. }
  587. needstructdeflab:=need_struct_def_lab(def);
  588. if not(tf_dwarf_only_local_labels in target_info.flags) then
  589. begin
  590. if (ds_dwarf_dbg_info_written in def.defstates) then
  591. begin
  592. if not assigned(def.typesym) then
  593. internalerror(200610011);
  594. result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_METADATA);
  595. result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_METADATA);
  596. if needstructdeflab then
  597. result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_METADATA)
  598. else
  599. result^.struct_lab:=result^.lab;
  600. def.dbg_state:=dbg_state_written;
  601. end
  602. else
  603. begin
  604. { Create an exported DBG symbol if we are generating a def defined in the
  605. globalsymtable of the current unit }
  606. if assigned(def.typesym) and
  607. (def.owner.symtabletype=globalsymtable) and
  608. (def.owner.iscurrentunit) then
  609. begin
  610. result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
  611. result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
  612. if needstructdeflab then
  613. result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype)
  614. else
  615. result^.struct_lab:=result^.lab;
  616. include(def.defstates,ds_dwarf_dbg_info_written);
  617. end
  618. else
  619. begin
  620. { The pointer typecast is needed to prevent a problem with range checking
  621. on when the typecast is changed to 'as' }
  622. current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.lab)));
  623. current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.ref_lab)));
  624. if needstructdeflab then
  625. current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.struct_lab)))
  626. else
  627. result^.struct_lab:=result^.lab;
  628. end;
  629. end;
  630. end
  631. else
  632. begin
  633. { The pointer typecast is needed to prevent a problem with range checking
  634. on when the typecast is changed to 'as' }
  635. { addrlabel instead of datalabel because it must be a local one }
  636. current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.lab)));
  637. current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.ref_lab)));
  638. if needstructdeflab then
  639. current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.struct_lab)))
  640. else
  641. result^.struct_lab:=result^.lab;
  642. end;
  643. if def.dbg_state=dbg_state_used then
  644. deftowritelist.Add(def);
  645. defnumberlist.Add(def);
  646. end;
  647. end;
  648. function TDebugInfoDwarf.need_struct_def_lab(def:tdef): Boolean;
  649. begin
  650. Result := (def.typ=objectdef) and
  651. (tobjectdef(def).objecttype in [
  652. odt_interfacecom,
  653. odt_interfacecorba,
  654. odt_dispinterface,
  655. odt_helper,
  656. odt_class,
  657. odt_objcclass]);
  658. end;
  659. function TDebugInfoDwarf.is_fbreg(reg: tregister): boolean;
  660. begin
  661. {$if defined(i8086)}
  662. result:=reg=NR_BP;
  663. {$elseif defined(wasm)}
  664. result:=reg=NR_LOCAL_FRAME_POINTER_REG;
  665. {$else}
  666. { always return false, because we don't emit DW_AT_frame_base attributes yet }
  667. result:=false;
  668. {$endif}
  669. end;
  670. function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol;
  671. begin
  672. result:=get_def_dwarf_labs(def)^.lab;
  673. end;
  674. function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tabstractrecorddef): tasmsymbol;
  675. begin
  676. result:=get_def_dwarf_labs(def)^.struct_lab;
  677. end;
  678. function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol;
  679. begin
  680. result:=get_def_dwarf_labs(def)^.ref_lab;
  681. end;
  682. constructor TDebugInfoDwarf.Create;
  683. begin
  684. inherited Create;
  685. { 64bit headers are only supported for dwarf3 and up, so default off }
  686. use_64bit_headers := false;
  687. { we haven't generated any lineinfo yet }
  688. generated_lineinfo := false;
  689. dirlist := TFPHashObjectList.Create;
  690. { add current dir as first item (index=0) }
  691. TDirIndexItem.Create(dirlist,'.', 0);
  692. asmline := TAsmList.create;
  693. loclist := tdynamicarray.Create(4096);
  694. AbbrevSearchTree:=AllocateNewAiSearchItem;
  695. vardatadef := nil;
  696. end;
  697. destructor TDebugInfoDwarf.Destroy;
  698. begin
  699. dirlist.Free;
  700. if assigned(AbbrevSearchTree) then
  701. FreeSearchItem(AbbrevSearchTree);
  702. dirlist := nil;
  703. asmline.free;
  704. asmline:=nil;
  705. loclist.Free;
  706. loclist := nil;
  707. inherited Destroy;
  708. end;
  709. procedure TDebugInfoDwarf.enum_membersyms_callback(p:TObject; arg: pointer);
  710. begin
  711. case tsym(p).typ of
  712. fieldvarsym:
  713. appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
  714. propertysym:
  715. appendsym_property(TAsmList(arg),tpropertysym(p));
  716. constsym:
  717. appendsym_const_member(TAsmList(arg),tconstsym(p),true);
  718. else
  719. ;
  720. end;
  721. end;
  722. function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer;
  723. var
  724. dirname: String;
  725. diritem: TDirIndexItem;
  726. diridx: Integer;
  727. fileitem: TFileIndexItem;
  728. begin
  729. if afile.path = '' then
  730. dirname := '.'
  731. else
  732. begin
  733. { add the canonical form here already to avoid problems with }
  734. { paths such as './' etc }
  735. dirname := relative_dwarf_path(afile.path);
  736. if dirname = '' then
  737. dirname := '.';
  738. end;
  739. diritem := TDirIndexItem(dirlist.Find(dirname));
  740. if diritem = nil then
  741. diritem := TDirIndexItem.Create(dirlist,dirname, dirlist.Count);
  742. diridx := diritem.IndexNr;
  743. fileitem := TFileIndexItem(diritem.files.Find(afile.name));
  744. if fileitem = nil then
  745. begin
  746. Inc(filesequence);
  747. fileitem := TFileIndexItem.Create(diritem.files,afile.name, diridx, filesequence);
  748. end;
  749. Result := fileitem.IndexNr;
  750. end;
  751. procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
  752. begin
  753. if length(values)<>1 then
  754. internalerror(2009040402);
  755. append_attribute(attr,form,values[0]);
  756. end;
  757. procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
  758. begin
  759. { attribute }
  760. AddConstToAbbrev(cardinal(attr));
  761. { form }
  762. AddConstToAbbrev(cardinal(form));
  763. { info itself }
  764. case form of
  765. DW_FORM_string:
  766. case value.VType of
  767. vtChar:
  768. append_to_al_dwarf_info(tai_string.create(value.VChar), 1);
  769. vtString:
  770. append_to_al_dwarf_info(tai_string.create(value.VString^), Length(value.VString^));
  771. vtAnsistring:
  772. append_to_al_dwarf_info(tai_string.create(Ansistring(value.VAnsiString)), Length(Ansistring(value.VAnsiString))+1);
  773. else
  774. internalerror(200601264);
  775. end;
  776. DW_FORM_flag:
  777. append_const_to_al_dwarf_info(tai_const.create_8bit(byte(value.VBoolean)));
  778. DW_FORM_data1:
  779. case value.VType of
  780. vtInteger:
  781. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VInteger));
  782. vtInt64:
  783. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VInt64^));
  784. vtQWord:
  785. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VQWord^));
  786. else
  787. internalerror(200602143);
  788. end;
  789. DW_FORM_data2:
  790. case value.VType of
  791. vtInteger:
  792. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(value.VInteger));
  793. vtInt64:
  794. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(value.VInt64^));
  795. vtQWord:
  796. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(value.VQWord^));
  797. else
  798. internalerror(200602144);
  799. end;
  800. DW_FORM_data4:
  801. case value.VType of
  802. vtInteger:
  803. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(value.VInteger));
  804. vtInt64:
  805. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(value.VInt64^));
  806. vtQWord:
  807. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(value.VQWord^));
  808. else
  809. internalerror(200602145);
  810. end;
  811. DW_FORM_data8:
  812. case value.VType of
  813. vtInteger:
  814. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(value.VInteger));
  815. vtInt64:
  816. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(value.VInt64^));
  817. vtQWord:
  818. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(value.VQWord^));
  819. else
  820. internalerror(200602146);
  821. end;
  822. DW_FORM_sdata:
  823. case value.VType of
  824. vtInteger:
  825. append_const_to_al_dwarf_info(tai_const.create_sleb128bit(value.VInteger));
  826. vtInt64:
  827. append_const_to_al_dwarf_info(tai_const.create_sleb128bit(value.VInt64^));
  828. vtQWord:
  829. append_const_to_al_dwarf_info(tai_const.create_sleb128bit(value.VQWord^));
  830. else
  831. internalerror(200601285);
  832. end;
  833. DW_FORM_udata:
  834. case value.VType of
  835. vtInteger:
  836. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(value.VInteger));
  837. vtInt64:
  838. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(value.VInt64^));
  839. vtQWord:
  840. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(value.VQWord^));
  841. else
  842. internalerror(200601284);
  843. end;
  844. { block gets only the size, the rest is appended manually by the caller }
  845. DW_FORM_block1:
  846. case value.VType of
  847. vtInteger:
  848. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VInteger));
  849. vtInt64:
  850. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VInt64^));
  851. vtQWord:
  852. append_const_to_al_dwarf_info(tai_const.create_8bit(value.VQWord^));
  853. else
  854. internalerror(200602141);
  855. end;
  856. else
  857. internalerror(200601263);
  858. end;
  859. end;
  860. { writing the data through a few simply procedures allows to create easily extra information
  861. for debugging of debug info }
  862. procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
  863. var
  864. i : longint;
  865. begin
  866. { abbrev number }
  867. // Store the ai with the reference to the abbrev number and start a search
  868. // to find the right abbrev-section. (Or create one)
  869. dwarf_info_abbref_tai := tai_const.create_uleb128bit(currabbrevnumber);
  870. append_to_al_dwarf_info(dwarf_info_abbref_tai, dwarf_info_abbref_tai.size);
  871. StartAbbrevSearch;
  872. { tag }
  873. AddConstToAbbrev(ord(tag));
  874. { children? }
  875. AddConstToAbbrev(ord(has_children),true);
  876. i:=0;
  877. while i<=high(data) do
  878. begin
  879. if (i+2 > high(data)) then
  880. internalerror(2009040401);
  881. if data[i].VType<>vtInteger then
  882. internalerror(200601261);
  883. if data[i+1].VType<>vtInteger then
  884. internalerror(2006012602);
  885. append_attribute(tdwarf_attribute(data[i].VInteger),tdwarf_form(data[i+1].VInteger),data[i+2]);
  886. inc(i,3);
  887. end;
  888. end;
  889. procedure TDebugInfoDwarf.append_block1(attr: tdwarf_attribute; size: aint);
  890. begin
  891. AddConstToAbbrev(ord(attr));
  892. AddConstToAbbrev(ord(DW_FORM_block1));
  893. append_const_to_al_dwarf_info(tai_const.create_8bit(size));
  894. end;
  895. procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
  896. begin
  897. AddConstToAbbrev(ord(attr));
  898. AddConstToAbbrev(ord(DW_FORM_addr));
  899. append_const_to_al_dwarf_info(tai_const.create_type_sym(aitconst_ptr_unaligned,sym));
  900. end;
  901. procedure TDebugInfoDwarf.append_labelentry_addr_ref(sym : tasmsymbol);
  902. begin
  903. AddConstToAbbrev(ord(DW_FORM_ref_addr));
  904. {$ifdef i8086}
  905. { DW_FORM_ref_addr is treated as 32-bit by Open Watcom on i8086 }
  906. append_const_to_al_dwarf_info(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym));
  907. {$else i8086}
  908. append_const_to_al_dwarf_info(tai_const.create_type_sym(aitconst_ptr_unaligned,sym));
  909. {$endif i8086}
  910. end;
  911. procedure TDebugInfoDwarf.append_labelentry_addr_ref_offset(sym : tasmsymbol; offset : Int64);
  912. begin
  913. AddConstToAbbrev(ord(DW_FORM_ref_addr));
  914. {$ifdef i8086}
  915. { DW_FORM_ref_addr is treated as 32-bit by Open Watcom on i8086 }
  916. append_const_to_al_dwarf_info(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym));
  917. {$else i8086}
  918. append_const_to_al_dwarf_info(tai_const.Create_type_sym_offset(aitconst_ptr_unaligned,sym, offset));
  919. {$endif i8086}
  920. end;
  921. procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
  922. begin
  923. AddConstToAbbrev(ord(attr));
  924. if not(tf_dwarf_only_local_labels in target_info.flags) then
  925. append_labelentry_addr_ref(sym)
  926. else
  927. begin
  928. if use_64bit_headers then
  929. AddConstToAbbrev(ord(DW_FORM_ref8))
  930. else
  931. AddConstToAbbrev(ord(DW_FORM_ref4));
  932. append_const_to_al_dwarf_info(tai_const.create_rel_sym(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype),sym));
  933. end;
  934. end;
  935. procedure TDebugInfoDwarf.append_labelentry_ref_offset(attr: tdwarf_attribute; sym: tasmsymbol; offset: Int64);
  936. begin
  937. AddConstToAbbrev(ord(attr));
  938. if not(tf_dwarf_only_local_labels in target_info.flags) then
  939. append_labelentry_addr_ref_offset(sym, offset)
  940. else
  941. begin
  942. if use_64bit_headers then
  943. AddConstToAbbrev(ord(DW_FORM_ref8))
  944. else
  945. AddConstToAbbrev(ord(DW_FORM_ref4));
  946. append_const_to_al_dwarf_info(tai_const.Create_rel_sym_offset(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype),sym, offset));
  947. end;
  948. end;
  949. procedure TDebugInfoDwarf.append_labelentry_dataptr_common(attr : tdwarf_attribute);
  950. begin
  951. AddConstToAbbrev(ord(attr));
  952. if use_64bit_headers then
  953. AddConstToAbbrev(ord(DW_FORM_data8))
  954. else
  955. AddConstToAbbrev(ord(DW_FORM_data4));
  956. end;
  957. procedure TDebugInfoDwarf.append_pointerclass(list: TAsmList;
  958. def: tpointerdef);
  959. begin
  960. {$ifdef i8086}
  961. case tcpupointerdef(def).x86pointertyp of
  962. x86pt_near,
  963. { todo: is there a way to specify these somehow? }
  964. x86pt_near_cs,x86pt_near_ds,x86pt_near_ss,
  965. x86pt_near_es,x86pt_near_fs,x86pt_near_gs:
  966. append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_near16]);
  967. x86pt_far:
  968. append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16]);
  969. x86pt_huge:
  970. append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_huge16]);
  971. end;
  972. {$else i8086}
  973. { Theoretically, we could do this, but it might upset some debuggers, }
  974. { even though it's part of the DWARF standard. }
  975. { append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]); }
  976. {$endif i8086}
  977. end;
  978. procedure TDebugInfoDwarf.append_proc_frame_base(list: TAsmList;
  979. def: tprocdef);
  980. {$ifdef i8086}
  981. var
  982. dreg: longint;
  983. blocksize: longint;
  984. templist: TAsmList;
  985. begin
  986. dreg:=dwarf_reg(NR_BP);
  987. templist:=TAsmList.create;
  988. if dreg<=31 then
  989. begin
  990. templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg));
  991. blocksize:=1;
  992. end
  993. else
  994. begin
  995. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  996. templist.concat(tai_const.create_uleb128bit(dreg));
  997. blocksize:=1+Lengthuleb128(dreg);
  998. end;
  999. append_block1(DW_AT_frame_base,blocksize);
  1000. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1001. templist.free;
  1002. end;
  1003. {$else i8086}
  1004. begin
  1005. { problem: base reg isn't known here
  1006. DW_AT_frame_base,DW_FORM_block1,1
  1007. }
  1008. end;
  1009. {$endif i8086}
  1010. {$ifdef i8086}
  1011. procedure TDebugInfoDwarf.append_seg_name(const name:string);
  1012. begin
  1013. append_block1(DW_AT_segment,3);
  1014. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_const2u)));
  1015. append_const_to_al_dwarf_info(tai_const.Create_seg_name(name));
  1016. end;
  1017. procedure TDebugInfoDwarf.append_seg_reg(const segment_register: tregister);
  1018. var
  1019. dreg: longint;
  1020. blocksize: longint;
  1021. templist: TAsmList;
  1022. begin
  1023. dreg:=dwarf_reg(segment_register);
  1024. templist:=TAsmList.create;
  1025. if dreg<=31 then
  1026. begin
  1027. templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg));
  1028. blocksize:=1;
  1029. end
  1030. else
  1031. begin
  1032. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  1033. templist.concat(tai_const.create_uleb128bit(dreg));
  1034. blocksize:=1+Lengthuleb128(dreg);
  1035. end;
  1036. append_block1(DW_AT_segment,blocksize);
  1037. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  1038. templist.free;
  1039. end;
  1040. {$endif i8086}
  1041. procedure TDebugInfoDwarf.append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
  1042. begin
  1043. {
  1044. used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
  1045. The size of these depend on the header format
  1046. Must be relative to another symbol on tf_dwarf_relative_addresses
  1047. targets
  1048. }
  1049. if (tf_dwarf_relative_addresses in target_info.flags) then
  1050. { use append_labelentry_dataptr_rel instead }
  1051. internalerror(2007020210);
  1052. append_labelentry_dataptr_common(attr);
  1053. append_const_to_al_dwarf_info(tai_const.create_type_sym(offsetabstype,sym))
  1054. end;
  1055. procedure TDebugInfoDwarf.append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
  1056. begin
  1057. {
  1058. used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
  1059. The size of these depend on the header format
  1060. Must be relative to another symbol on tf_dwarf_relative_addresses
  1061. targets
  1062. }
  1063. append_labelentry_dataptr_common(attr);
  1064. append_const_to_al_dwarf_info(tai_const.create_rel_sym(offsetreltype,sym,endsym));
  1065. end;
  1066. procedure TDebugInfoDwarf.finish_entry;
  1067. begin
  1068. dwarf_info_abbref_tai.value:=FinishAbbrevSearch;
  1069. end;
  1070. procedure TDebugInfoDwarf.finish_children;
  1071. begin
  1072. append_const_to_al_dwarf_info(tai_const.create_8bit(0));
  1073. end;
  1074. procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef);
  1075. var
  1076. basedef : tdef;
  1077. sign : tdwarf_type;
  1078. signform : tdwarf_form;
  1079. fullbytesize : byte;
  1080. ordtype : tordtype;
  1081. begin
  1082. ordtype:=def.ordtype;
  1083. if ordtype=customint then
  1084. ordtype:=range_to_basetype(def.low,def.high);
  1085. case ordtype of
  1086. s8bit,
  1087. s16bit,
  1088. s32bit,
  1089. u8bit,
  1090. u16bit,
  1091. u32bit :
  1092. begin
  1093. { generate proper signed/unsigned info for types like 0..3 }
  1094. { these are s8bit, but should be identified as unsigned }
  1095. { because otherwise they are interpreted wrongly when used }
  1096. { in a bitpacked record }
  1097. if (def.low<0) then
  1098. begin
  1099. sign:=DW_ATE_signed;
  1100. signform:=DW_FORM_sdata
  1101. end
  1102. else
  1103. begin
  1104. sign:=DW_ATE_unsigned;
  1105. signform:=DW_FORM_udata
  1106. end;
  1107. fullbytesize:=def.size;
  1108. case fullbytesize of
  1109. 1:
  1110. if (sign=DW_ATE_signed) then
  1111. basedef:=s8inttype
  1112. else
  1113. basedef:=u8inttype;
  1114. 2:
  1115. if (sign=DW_ATE_signed) then
  1116. basedef:=s16inttype
  1117. else
  1118. basedef:=u16inttype;
  1119. 3,4:
  1120. if (sign=DW_ATE_signed) then
  1121. basedef:=s32inttype
  1122. else
  1123. basedef:=u32inttype;
  1124. else
  1125. internalerror(2008032201);
  1126. end;
  1127. if (def.low=torddef(basedef).low) and
  1128. (def.high=torddef(basedef).high) then
  1129. { base type such as byte/shortint/word/... }
  1130. if assigned(def.typesym) then
  1131. append_entry(DW_TAG_base_type,false,[
  1132. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1133. DW_AT_encoding,DW_FORM_data1,sign,
  1134. DW_AT_byte_size,DW_FORM_data1,fullbytesize])
  1135. else
  1136. append_entry(DW_TAG_base_type,false,[
  1137. DW_AT_encoding,DW_FORM_data1,sign,
  1138. DW_AT_byte_size,DW_FORM_data1,fullbytesize])
  1139. else
  1140. begin
  1141. { subrange type }
  1142. { note: don't do this 64 bit int types, they appear }
  1143. { to be always clipped to s32bit for some reason }
  1144. if assigned(def.typesym) then
  1145. append_entry(DW_TAG_subrange_type,false,[
  1146. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1147. DW_AT_lower_bound,signform,int64(def.low),
  1148. DW_AT_upper_bound,signform,int64(def.high)
  1149. ])
  1150. else
  1151. append_entry(DW_TAG_subrange_type,false,[
  1152. DW_AT_lower_bound,signform,int64(def.low),
  1153. DW_AT_upper_bound,signform,int64(def.high)
  1154. ]);
  1155. append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef));
  1156. end;
  1157. finish_entry;
  1158. end;
  1159. uvoid :
  1160. begin
  1161. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  1162. replace it with a unsigned type with size 0 (FK)
  1163. }
  1164. append_entry(DW_TAG_base_type,false,[
  1165. DW_AT_name,DW_FORM_string,'Void'#0,
  1166. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  1167. DW_AT_byte_size,DW_FORM_data1,0
  1168. ]);
  1169. finish_entry;
  1170. end;
  1171. uchar :
  1172. begin
  1173. append_entry(DW_TAG_base_type,false,[
  1174. DW_AT_name,DW_FORM_string,'Char'#0,
  1175. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  1176. DW_AT_byte_size,DW_FORM_data1,1
  1177. ]);
  1178. finish_entry;
  1179. end;
  1180. uwidechar :
  1181. begin
  1182. append_entry(DW_TAG_base_type,false,[
  1183. DW_AT_name,DW_FORM_string,'WideChar'#0,
  1184. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
  1185. DW_AT_byte_size,DW_FORM_data1,2
  1186. ]);
  1187. finish_entry;
  1188. end;
  1189. pasbool1 :
  1190. begin
  1191. append_entry(DW_TAG_base_type,false,[
  1192. DW_AT_name,DW_FORM_string,'Boolean'#0,
  1193. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1194. DW_AT_byte_size,DW_FORM_data1,1
  1195. ]);
  1196. finish_entry;
  1197. end;
  1198. pasbool8 :
  1199. begin
  1200. append_entry(DW_TAG_base_type,false,[
  1201. DW_AT_name,DW_FORM_string,'Boolean8'#0,
  1202. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1203. DW_AT_byte_size,DW_FORM_data1,1
  1204. ]);
  1205. finish_entry;
  1206. end;
  1207. bool8bit :
  1208. begin
  1209. append_entry(DW_TAG_base_type,false,[
  1210. DW_AT_name,DW_FORM_string,'ByteBool'#0,
  1211. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1212. DW_AT_byte_size,DW_FORM_data1,1
  1213. ]);
  1214. finish_entry;
  1215. end;
  1216. pasbool16 :
  1217. begin
  1218. append_entry(DW_TAG_base_type,false,[
  1219. DW_AT_name,DW_FORM_string,'Boolean16'#0,
  1220. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1221. DW_AT_byte_size,DW_FORM_data1,2
  1222. ]);
  1223. finish_entry;
  1224. end;
  1225. bool16bit :
  1226. begin
  1227. append_entry(DW_TAG_base_type,false,[
  1228. DW_AT_name,DW_FORM_string,'WordBool'#0,
  1229. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1230. DW_AT_byte_size,DW_FORM_data1,2
  1231. ]);
  1232. finish_entry;
  1233. end;
  1234. pasbool32 :
  1235. begin
  1236. append_entry(DW_TAG_base_type,false,[
  1237. DW_AT_name,DW_FORM_string,'Boolean32'#0,
  1238. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1239. DW_AT_byte_size,DW_FORM_data1,4
  1240. ]);
  1241. finish_entry;
  1242. end;
  1243. bool32bit :
  1244. begin
  1245. append_entry(DW_TAG_base_type,false,[
  1246. DW_AT_name,DW_FORM_string,'LongBool'#0,
  1247. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1248. DW_AT_byte_size,DW_FORM_data1,4
  1249. ]);
  1250. finish_entry;
  1251. end;
  1252. pasbool64 :
  1253. begin
  1254. append_entry(DW_TAG_base_type,false,[
  1255. DW_AT_name,DW_FORM_string,'Boolean64'#0,
  1256. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1257. DW_AT_byte_size,DW_FORM_data1,8
  1258. ]);
  1259. finish_entry;
  1260. end;
  1261. bool64bit :
  1262. begin
  1263. append_entry(DW_TAG_base_type,false,[
  1264. DW_AT_name,DW_FORM_string,'QWordBool'#0,
  1265. DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
  1266. DW_AT_byte_size,DW_FORM_data1,8
  1267. ]);
  1268. finish_entry;
  1269. end;
  1270. u64bit :
  1271. begin
  1272. append_entry(DW_TAG_base_type,false,[
  1273. DW_AT_name,DW_FORM_string,'QWord'#0,
  1274. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  1275. DW_AT_byte_size,DW_FORM_data1,8
  1276. ]);
  1277. finish_entry;
  1278. end;
  1279. scurrency :
  1280. begin
  1281. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  1282. append_entry(DW_TAG_base_type,false,[
  1283. DW_AT_name,DW_FORM_string,'Currency'#0,
  1284. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1285. DW_AT_byte_size,DW_FORM_data1,8
  1286. ]);
  1287. finish_entry;
  1288. end;
  1289. s64bit :
  1290. begin
  1291. append_entry(DW_TAG_base_type,false,[
  1292. DW_AT_name,DW_FORM_string,'Int64'#0,
  1293. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1294. DW_AT_byte_size,DW_FORM_data1,8
  1295. ]);
  1296. finish_entry;
  1297. end;
  1298. u128bit:
  1299. begin
  1300. append_entry(DW_TAG_base_type,false,[
  1301. DW_AT_name,DW_FORM_string,'Int128'#0,
  1302. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  1303. DW_AT_byte_size,DW_FORM_data1,16
  1304. ]);
  1305. finish_entry;
  1306. end;
  1307. s128bit:
  1308. begin
  1309. append_entry(DW_TAG_base_type,false,[
  1310. DW_AT_name,DW_FORM_string,'Int128'#0,
  1311. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1312. DW_AT_byte_size,DW_FORM_data1,16
  1313. ]);
  1314. finish_entry;
  1315. end;
  1316. else
  1317. internalerror(200601287);
  1318. end;
  1319. end;
  1320. procedure TDebugInfoDwarf.appenddef_float(list:TAsmList;def:tfloatdef);
  1321. begin
  1322. case def.floattype of
  1323. s32real,
  1324. s64real,
  1325. s80real,
  1326. sc80real:
  1327. if assigned(def.typesym) then
  1328. begin
  1329. append_entry(DW_TAG_base_type,false,[
  1330. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1331. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  1332. DW_AT_byte_size,DW_FORM_data1,def.size
  1333. ]);
  1334. if (def.floattype in [s80real,sc80real]) and
  1335. (def.size<>10) then
  1336. begin
  1337. append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]);
  1338. { "The bit offset attribute describes the offset in bits
  1339. of the high order bit of a value of the given type
  1340. from the high order bit of the storage unit used to
  1341. contain that value." }
  1342. if target_info.endian=endian_little then
  1343. append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]);
  1344. end;
  1345. end
  1346. else
  1347. append_entry(DW_TAG_base_type,false,[
  1348. DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
  1349. DW_AT_byte_size,DW_FORM_data1,def.size
  1350. ]);
  1351. s64currency:
  1352. { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
  1353. if assigned(def.typesym) then
  1354. append_entry(DW_TAG_base_type,false,[
  1355. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1356. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1357. DW_AT_byte_size,DW_FORM_data1,8
  1358. ])
  1359. else
  1360. append_entry(DW_TAG_base_type,false,[
  1361. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1362. DW_AT_byte_size,DW_FORM_data1,8
  1363. ]);
  1364. s64comp:
  1365. if assigned(def.typesym) then
  1366. append_entry(DW_TAG_base_type,false,[
  1367. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1368. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1369. DW_AT_byte_size,DW_FORM_data1,8
  1370. ])
  1371. else
  1372. append_entry(DW_TAG_base_type,false,[
  1373. DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
  1374. DW_AT_byte_size,DW_FORM_data1,8
  1375. ]);
  1376. else
  1377. internalerror(200601289);
  1378. end;
  1379. finish_entry;
  1380. end;
  1381. procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef);
  1382. var
  1383. hp : tenumsym;
  1384. i : integer;
  1385. begin
  1386. if assigned(def.typesym) then
  1387. append_entry(DW_TAG_enumeration_type,true,[
  1388. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1389. DW_AT_byte_size,DW_FORM_data1,def.size
  1390. ])
  1391. else
  1392. append_entry(DW_TAG_enumeration_type,true,[
  1393. DW_AT_byte_size,DW_FORM_data1,def.size
  1394. ]);
  1395. if assigned(def.basedef) then
  1396. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef));
  1397. finish_entry;
  1398. { write enum symbols }
  1399. for i := 0 to def.symtable.SymList.Count - 1 do
  1400. begin
  1401. hp:=tenumsym(def.symtable.SymList[i]);
  1402. if hp.value<def.minval then
  1403. continue
  1404. else
  1405. if hp.value>def.maxval then
  1406. break;
  1407. append_entry(DW_TAG_enumerator,false,[
  1408. DW_AT_name,DW_FORM_string,symname(hp, false)+#0,
  1409. DW_AT_const_value,DW_FORM_data4,hp.value
  1410. ]);
  1411. finish_entry;
  1412. end;
  1413. finish_children;
  1414. end;
  1415. procedure tdebuginfodwarf.appenddef_array(list:tasmList;def:tarraydef);
  1416. var
  1417. size : PInt;
  1418. elesize : PInt;
  1419. elestrideattr : tdwarf_attribute;
  1420. labsym: tasmlabel;
  1421. begin
  1422. if is_dynamic_array(def) then
  1423. begin
  1424. { It's a pointer to the actual array }
  1425. current_asmdata.getaddrlabel(labsym);
  1426. append_entry(DW_TAG_pointer_type,false,[]);
  1427. append_labelentry_ref(DW_AT_type,labsym);
  1428. finish_entry;
  1429. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1430. end;
  1431. if not is_packed_array(def) then
  1432. begin
  1433. elestrideattr:=DW_AT_byte_stride;
  1434. elesize:=def.elesize;
  1435. end
  1436. else
  1437. begin
  1438. elestrideattr:=DW_AT_stride_size;
  1439. elesize:=def.elepackedbitsize;
  1440. end;
  1441. if is_special_array(def) then
  1442. begin
  1443. { no known size, no known upper bound }
  1444. if assigned(def.typesym) then
  1445. append_entry(DW_TAG_array_type,true,[
  1446. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1447. elestrideattr,DW_FORM_udata,elesize
  1448. ])
  1449. else
  1450. append_entry(DW_TAG_array_type,true,[
  1451. elestrideattr,DW_FORM_udata,elesize
  1452. ]);
  1453. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  1454. finish_entry;
  1455. { a missing upper bound means "unknown"/default }
  1456. append_entry(DW_TAG_subrange_type,false,[
  1457. DW_AT_lower_bound,DW_FORM_sdata,def.lowrange
  1458. ]);
  1459. end
  1460. else
  1461. begin
  1462. size:=def.size;
  1463. if assigned(def.typesym) then
  1464. append_entry(DW_TAG_array_type,true,[
  1465. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1466. DW_AT_byte_size,DW_FORM_udata,size,
  1467. elestrideattr,DW_FORM_udata,elesize
  1468. ])
  1469. else
  1470. append_entry(DW_TAG_array_type,true,[
  1471. DW_AT_byte_size,DW_FORM_udata,size,
  1472. elestrideattr,DW_FORM_udata,elesize
  1473. ]);
  1474. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  1475. finish_entry;
  1476. { to simplify things, we don't write a multidimensional array here }
  1477. append_entry(DW_TAG_subrange_type,false,[
  1478. DW_AT_lower_bound,DW_FORM_sdata,def.lowrange,
  1479. DW_AT_upper_bound,DW_FORM_sdata,def.highrange
  1480. ]);
  1481. end;
  1482. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
  1483. finish_entry;
  1484. finish_children;
  1485. end;
  1486. procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef);
  1487. begin
  1488. if assigned(def.objname) then
  1489. appenddef_record_named(list,def,def.objname^)
  1490. else
  1491. appenddef_record_named(list,def,'');
  1492. end;
  1493. procedure TDebugInfoDwarf.appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring);
  1494. begin
  1495. if (name<>'') then
  1496. append_entry(DW_TAG_structure_type,true,[
  1497. DW_AT_name,DW_FORM_string,name+#0,
  1498. DW_AT_byte_size,DW_FORM_udata,def.size
  1499. ])
  1500. else
  1501. append_entry(DW_TAG_structure_type,true,[
  1502. DW_AT_byte_size,DW_FORM_udata,def.size
  1503. ]);
  1504. finish_entry;
  1505. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  1506. { don't know whether external record declaration is allow but if it so then
  1507. do the same as we do for other object types - skip procdef info generation
  1508. for external defs (Paul Ishenin) }
  1509. if not(oo_is_external in def.objectoptions) then
  1510. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
  1511. finish_children;
  1512. end;
  1513. procedure TDebugInfoDwarf.appenddef_pointer(list:TAsmList;def:tpointerdef);
  1514. begin
  1515. append_entry(DW_TAG_pointer_type,false,[]);
  1516. append_pointerclass(list,def);
  1517. if not(is_voidpointer(def)) then
  1518. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointeddef));
  1519. finish_entry;
  1520. end;
  1521. procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef);
  1522. procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: asizeuint);
  1523. var
  1524. { maxlen can be > high(int64) }
  1525. slen : asizeuint;
  1526. arr : tasmlabel;
  1527. begin
  1528. { fix length of openshortstring }
  1529. slen:=aword(def.len);
  1530. if (slen=0) or
  1531. (slen>maxlen) then
  1532. slen:=maxlen;
  1533. { create a structure with two elements }
  1534. if not(tf_dwarf_only_local_labels in target_info.flags) then
  1535. current_asmdata.getglobaldatalabel(arr)
  1536. else
  1537. current_asmdata.getaddrlabel(arr);
  1538. append_entry(DW_TAG_structure_type,true,[
  1539. DW_AT_name,DW_FORM_string,name+#0,
  1540. DW_AT_byte_size,DW_FORM_udata,qword(lendef.size)+slen
  1541. ]);
  1542. finish_entry;
  1543. { length entry }
  1544. append_entry(DW_TAG_member,false,[
  1545. DW_AT_name,DW_FORM_string,'length'#0,
  1546. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1547. ]);
  1548. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1549. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(0));
  1550. append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
  1551. finish_entry;
  1552. { string data entry }
  1553. append_entry(DW_TAG_member,false,[
  1554. DW_AT_name,DW_FORM_string,'st'#0,
  1555. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1)
  1556. ]);
  1557. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1558. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(lendef.size));
  1559. append_labelentry_ref(DW_AT_type,arr);
  1560. finish_entry;
  1561. finish_children;
  1562. { now the data array }
  1563. if arr.bind=AB_GLOBAL then
  1564. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(arr,0))
  1565. else
  1566. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
  1567. append_entry(DW_TAG_array_type,true,[
  1568. DW_AT_byte_size,DW_FORM_udata,def.size,
  1569. DW_AT_byte_stride,DW_FORM_udata,1
  1570. ]);
  1571. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype));
  1572. finish_entry;
  1573. append_entry(DW_TAG_subrange_type,false,[
  1574. DW_AT_lower_bound,DW_FORM_udata,1,
  1575. DW_AT_upper_bound,DW_FORM_udata,qword(slen)
  1576. ]);
  1577. append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
  1578. finish_entry;
  1579. finish_children;
  1580. end;
  1581. begin
  1582. case def.stringtype of
  1583. st_shortstring:
  1584. begin
  1585. addnormalstringdef('ShortString',u8inttype,255);
  1586. end;
  1587. st_longstring:
  1588. begin
  1589. { a) we don't actually support variables of this type currently
  1590. b) this type is only used as the type for constant strings
  1591. > 255 characters
  1592. c) in such a case, gdb will allocate and initialise enough
  1593. memory to hold the maximum size for such a string
  1594. -> don't use high(qword)/high(cardinal) as maximum, since that
  1595. will cause exhausting the VM space, but some "reasonably high"
  1596. number that should be enough for most constant strings
  1597. }
  1598. {$ifdef cpu64bitaddr}
  1599. addnormalstringdef('LongString',u64inttype,qword(1024*1024));
  1600. {$endif cpu64bitaddr}
  1601. {$ifdef cpu32bitaddr}
  1602. addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
  1603. {$endif cpu32bitaddr}
  1604. {$ifdef cpu16bitaddr}
  1605. addnormalstringdef('LongString',u16inttype,cardinal(1024));
  1606. {$endif cpu16bitaddr}
  1607. end;
  1608. st_ansistring:
  1609. begin
  1610. { looks like a pchar }
  1611. append_entry(DW_TAG_pointer_type,false,[]);
  1612. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype));
  1613. finish_entry;
  1614. end;
  1615. st_unicodestring,
  1616. st_widestring:
  1617. begin
  1618. { looks like a pwidechar }
  1619. append_entry(DW_TAG_pointer_type,false,[]);
  1620. append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype));
  1621. finish_entry;
  1622. end;
  1623. end;
  1624. end;
  1625. procedure TDebugInfoDwarf.appenddef_procvar(list:TAsmList;def:tprocvardef);
  1626. procedure doappend;
  1627. var
  1628. i : longint;
  1629. begin
  1630. if assigned(def.typesym) then
  1631. append_entry(DW_TAG_subroutine_type,true,[
  1632. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  1633. DW_AT_prototyped,DW_FORM_flag,true
  1634. ])
  1635. else
  1636. append_entry(DW_TAG_subroutine_type,true,[
  1637. DW_AT_prototyped,DW_FORM_flag,true
  1638. ]);
  1639. if not(is_void(tprocvardef(def).returndef)) then
  1640. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef));
  1641. finish_entry;
  1642. { write parameters }
  1643. for i:=0 to def.paras.count-1 do
  1644. begin
  1645. append_entry(DW_TAG_formal_parameter,false,[
  1646. DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]), false)+#0
  1647. ]);
  1648. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
  1649. finish_entry;
  1650. end;
  1651. finish_children;
  1652. end;
  1653. var
  1654. proc : tasmlabel;
  1655. begin
  1656. if not def.is_addressonly then
  1657. begin
  1658. { create a structure with two elements }
  1659. if not(tf_dwarf_only_local_labels in target_info.flags) then
  1660. current_asmdata.getglobaldatalabel(proc)
  1661. else
  1662. current_asmdata.getaddrlabel(proc);
  1663. append_entry(DW_TAG_structure_type,true,[
  1664. DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint)
  1665. ]);
  1666. finish_entry;
  1667. { proc entry }
  1668. append_entry(DW_TAG_member,false,[
  1669. DW_AT_name,DW_FORM_string,'Proc'#0,
  1670. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  1671. ]);
  1672. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1673. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(0));
  1674. append_labelentry_ref(DW_AT_type,proc);
  1675. finish_entry;
  1676. { self entry }
  1677. append_entry(DW_TAG_member,false,[
  1678. DW_AT_name,DW_FORM_string,'Self'#0,
  1679. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(pint))
  1680. ]);
  1681. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  1682. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(sizeof(pint)));
  1683. append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject));
  1684. finish_entry;
  1685. finish_children;
  1686. if proc.bind=AB_GLOBAL then
  1687. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(proc,0))
  1688. else
  1689. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
  1690. doappend;
  1691. end
  1692. else
  1693. doappend;
  1694. end;
  1695. procedure TDebugInfoDwarf.beforeappenddef(list:TAsmList;def:tdef);
  1696. var
  1697. labsym : tasmsymbol;
  1698. begin
  1699. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
  1700. labsym:=def_dwarf_lab(def);
  1701. case labsym.bind of
  1702. AB_GLOBAL:
  1703. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
  1704. AB_LOCAL:
  1705. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1706. else
  1707. internalerror(2013082001);
  1708. end;
  1709. ResetDwarfOffset;
  1710. { On Darwin, dwarf info is not linked in the final binary,
  1711. but kept in the individual object files. This allows for
  1712. faster linking, but means that you have to keep the object
  1713. files for debugging and also that gdb only loads in the
  1714. debug info of a particular object file once you step into
  1715. or over a procedure in it.
  1716. To solve this, there is a tool called dsymutil which can
  1717. extract all the dwarf info from a program's object files.
  1718. This utility however performs "smart linking" on the dwarf
  1719. info and throws away all unreferenced dwarf entries. Since
  1720. variables' types always point to the dwarfinfo for a tdef
  1721. and never to that for a typesym, this means all debug
  1722. entries generated for typesyms are thrown away.
  1723. The problem with that is that we translate typesyms into
  1724. DW_TAG_typedef, and gdb's dwarf-2 reader only makes types
  1725. globally visibly if they are defined using a DW_TAG_typedef.
  1726. So as a result, before running dsymutil types only become
  1727. available once you stepped into/over a function in the object
  1728. file where they are declared, and after running dsymutil they
  1729. are all gone (printing variables still works because the
  1730. tdef dwarf info is still available, but you cannot typecast
  1731. anything outside the declaring units because the type names
  1732. are not known there).
  1733. The solution: if a tdef has an associated typesym, let the
  1734. debug label for the tdef point to a DW_TAG_typedef instead
  1735. of directly to the tdef itself. And don't write anything
  1736. special for the typesym itself.
  1737. Update: we now also do this for other platforms, because
  1738. otherwise if you compile unit A without debug info and
  1739. use one of its types in unit B, then no typedef will be
  1740. generated and hence gdb will not be able to give a definition
  1741. of the type.
  1742. }
  1743. if is_objc_class_or_protocol(def) then
  1744. begin
  1745. { for Objective-C classes, the typedef must refer to the
  1746. struct itself, not to the pointer of the struct; Objective-C
  1747. classes are not implicit pointers in Objective-C itself, only
  1748. in FPC. So make the def label point to a pointer to the
  1749. typedef, which in turn refers to the actual struct (for Delphi-
  1750. style classes, the def points to the typedef, which refers to
  1751. a pointer to the actual struct) }
  1752. { implicit pointer }
  1753. current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
  1754. append_entry(DW_TAG_pointer_type,false,[]);
  1755. append_labelentry_ref(DW_AT_type,labsym);
  1756. finish_entry;
  1757. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1758. end;
  1759. if assigned(def.typesym) and
  1760. not(df_generic in def.defoptions) then
  1761. begin
  1762. current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
  1763. append_entry(DW_TAG_typedef,false,[
  1764. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
  1765. ]);
  1766. append_labelentry_ref(DW_AT_type,labsym);
  1767. finish_entry;
  1768. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1769. end
  1770. end;
  1771. procedure TDebugInfoDwarf.afterappenddef(list:TAsmList;def:tdef);
  1772. var
  1773. labsym : tasmsymbol;
  1774. begin
  1775. { end of the symbol }
  1776. labsym:=def_dwarf_lab(def);
  1777. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol_end.Create(labsym));
  1778. { create a derived reference type for pass-by-reference parameters }
  1779. { (gdb doesn't support DW_AT_variable_parameter yet) }
  1780. labsym:=def_dwarf_ref_lab(def);
  1781. case labsym.bind of
  1782. AB_GLOBAL:
  1783. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
  1784. AB_LOCAL:
  1785. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  1786. else
  1787. internalerror(2013082002);
  1788. end;
  1789. append_entry(DW_TAG_reference_type,false,[]);
  1790. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  1791. finish_entry;
  1792. end;
  1793. procedure TDebugInfoDwarf.appendprocdef(list:TAsmList; def:tprocdef);
  1794. function dwarf_calling_convention(def: tprocdef): Tdwarf_calling_convention;
  1795. begin
  1796. case def.proccalloption of
  1797. pocall_register:
  1798. result:=DW_CC_GNU_borland_fastcall_i386;
  1799. pocall_cdecl,
  1800. pocall_stdcall,
  1801. pocall_cppdecl,
  1802. pocall_mwpascal:
  1803. result:=DW_CC_normal;
  1804. else
  1805. result:=DW_CC_nocall;
  1806. end
  1807. end;
  1808. var
  1809. procendlabel : tasmlabel;
  1810. procentry,s : string;
  1811. cc : Tdwarf_calling_convention;
  1812. st : tsymtable;
  1813. vmtoffset : pint;
  1814. in_currentunit : boolean;
  1815. begin
  1816. { only write debug info for procedures defined in the current module,
  1817. except in case of methods (gcc-compatible)
  1818. }
  1819. in_currentunit:=def.in_currentunit;
  1820. if not in_currentunit and
  1821. not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1822. exit;
  1823. { happens for init procdef of units without init section }
  1824. if in_currentunit and
  1825. not assigned(def.procstarttai) then
  1826. exit;
  1827. if df_generic in def.defoptions then
  1828. exit;
  1829. { Procdefs are not handled by the regular def writing code, so
  1830. dbg_state is not set/checked for them. Do it here. }
  1831. if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
  1832. exit;
  1833. defnumberlist.Add(def);
  1834. { Write methods and only in the scope of their parent objectdefs. }
  1835. if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1836. begin
  1837. { this code can also work for nested procdefs, but is not yet
  1838. activated for those because there is no clear advantage yet to
  1839. limiting the scope of nested procedures to that of their parent,
  1840. and it makes it impossible to set breakpoints in them by
  1841. referring to their name. }
  1842. st:=def.owner;
  1843. while assigned(st.defowner) and
  1844. (tdef(st.defowner).typ = procdef) do
  1845. st:=tprocdef(st.defowner).owner;
  1846. if assigned(st) and
  1847. (tdef(st.defowner).dbg_state<>dbg_state_writing) then
  1848. exit;
  1849. end;
  1850. def.dbg_state:=dbg_state_writing;
  1851. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
  1852. { Set offset, to be able to reference this method in a property }
  1853. set_def_dwarf_offset(tprocdef(def), DwarfOffset);
  1854. if not is_objc_class_or_protocol(def.struct) then
  1855. append_entry(DW_TAG_subprogram,true,
  1856. [DW_AT_name,DW_FORM_string,symname(def.procsym, false)+#0])
  1857. else
  1858. append_entry(DW_TAG_subprogram,true,
  1859. [DW_AT_name,DW_FORM_string,def.mangledname+#0]);
  1860. if (ds_dwarf_cpp in current_settings.debugswitches) and (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1861. begin
  1862. { If C++ emulation is enabled, add DW_AT_linkage_name attribute for methods.
  1863. LLDB uses it to display fully qualified method names.
  1864. Add a simple C++ mangled name without params to achieve at least "Class::Method()"
  1865. instead of just "Method" in LLDB. }
  1866. s:=tabstractrecorddef(def.owner.defowner).objrealname^;
  1867. procentry:=Format('_ZN%d%s', [Length(s), s]);
  1868. s:=symname(def.procsym, false);
  1869. procentry:=Format('%s%d%sEv'#0, [procentry, Length(s), s]);
  1870. append_attribute(DW_AT_linkage_name,DW_FORM_string, [procentry]);
  1871. end;
  1872. append_proc_frame_base(list,def);
  1873. { Append optional flags. }
  1874. { All Pascal procedures are prototyped }
  1875. append_attribute(DW_AT_prototyped,DW_FORM_flag,[true]);
  1876. { Calling convention. }
  1877. cc:=dwarf_calling_convention(def);
  1878. if (cc<>DW_CC_normal) then
  1879. append_attribute(DW_AT_calling_convention,DW_FORM_data1,[ord(cc)]);
  1880. {$ifdef i8086}
  1881. { Call model (near or far). Open Watcom compatible. }
  1882. if tcpuprocdef(def).is_far then
  1883. append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16])
  1884. else
  1885. append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]);
  1886. {$endif i8086}
  1887. { Externally visible. }
  1888. if (po_global in def.procoptions) and
  1889. (def.parast.symtablelevel<=normal_function_level) then
  1890. append_attribute(DW_AT_external,DW_FORM_flag,[true]);
  1891. { Abstract or virtual/overriding method. }
  1892. if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and
  1893. not is_objc_class_or_protocol(def.struct) and
  1894. not is_objectpascal_helper(def.struct) then
  1895. begin
  1896. if not(po_abstractmethod in def.procoptions) then
  1897. append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)])
  1898. else
  1899. append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_pure_virtual)]);
  1900. { Element number in the vmt (needs to skip stuff coming before the
  1901. actual method addresses in the vmt, so we use vmtmethodoffset()
  1902. and then divide by sizeof(pint)). }
  1903. vmtoffset:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber);
  1904. append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[3+LengthUleb128(vmtoffset)]);
  1905. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  1906. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_constu)));
  1907. append_const_to_al_dwarf_info(tai_const.Create_uleb128bit(vmtoffset));
  1908. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus)));
  1909. end;
  1910. { accessibility: public/private/protected }
  1911. if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1912. append_visibility(def.visibility);
  1913. { Return type. }
  1914. if not(is_void(tprocdef(def).returndef)) then
  1915. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
  1916. { we can only write the start/end if this procedure is implemented in
  1917. this module
  1918. }
  1919. if in_currentunit then
  1920. begin
  1921. { mark end of procedure }
  1922. current_asmdata.getlabel(procendlabel,alt_dbgtype);
  1923. current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
  1924. if use_dotted_functions then
  1925. procentry := '.' + def.mangledname
  1926. else
  1927. procentry := def.mangledname;
  1928. {$ifdef i8086}
  1929. append_seg_name(procentry);
  1930. {$endif i8086}
  1931. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION));
  1932. append_labelentry(DW_AT_high_pc,procendlabel);
  1933. if not(target_info.system in systems_darwin) then
  1934. begin
  1935. current_asmdata.asmlists[al_dwarf_aranges].Concat(
  1936. tai_const.create_type_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION)));
  1937. {$ifdef i8086}
  1938. { bits 16..31 of the offset }
  1939. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
  1940. { segment }
  1941. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_seg_name(procentry));
  1942. {$endif i8086}
  1943. current_asmdata.asmlists[al_dwarf_aranges].Concat(
  1944. tai_const.Create_rel_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION),procendlabel));
  1945. {$ifdef i8086}
  1946. { bits 16..31 of length }
  1947. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
  1948. {$endif i8086}
  1949. end;
  1950. end;
  1951. { Don't write the funcretsym explicitly, it's also in the
  1952. localsymtable and/or parasymtable.
  1953. }
  1954. finish_entry;
  1955. def.dbg_state:=dbg_state_written;
  1956. if assigned(def.parast) then
  1957. begin
  1958. { First insert self, because gdb uses the fact whether or not the
  1959. first parameter of a method is artificial to distinguish static
  1960. from regular methods. }
  1961. { fortunately, self is the always the first parameter in the
  1962. paralist, since it has the lowest paranr. Note that this is not
  1963. true for Objective-C, but those methods are detected in
  1964. another way (by reading the ObjC run time information) }
  1965. write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras);
  1966. end;
  1967. { local type defs and vars should not be written
  1968. inside the main proc }
  1969. if in_currentunit and
  1970. assigned(def.localst) and
  1971. (def.localst.symtabletype=localsymtable) then
  1972. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1973. { last write the types from this procdef }
  1974. if assigned(def.parast) then
  1975. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
  1976. { only try to write the localst if the routine is implemented here }
  1977. if in_currentunit and
  1978. assigned(def.localst) and
  1979. (def.localst.symtabletype=localsymtable) then
  1980. begin
  1981. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1982. { Write nested procedures -- disabled, see scope check at the
  1983. beginning; currently, these are still written in the global
  1984. scope. }
  1985. // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  1986. end;
  1987. finish_children;
  1988. end;
  1989. function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
  1990. var
  1991. elesize : pint;
  1992. currdef : tdef;
  1993. indirection: boolean;
  1994. begin
  1995. result:=false;
  1996. if not assigned(symlist) then
  1997. exit;
  1998. sym:=nil;
  1999. offset:=0;
  2000. currdef:=nil;
  2001. indirection:=false;
  2002. repeat
  2003. case symlist^.sltype of
  2004. sl_load:
  2005. begin
  2006. if assigned(sym) then
  2007. internalerror(2009031203);
  2008. if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
  2009. { can't handle... }
  2010. exit;
  2011. sym:=tabstractvarsym(symlist^.sym);
  2012. currdef:=tabstractvarsym(sym).vardef;
  2013. if ((sym.typ=paravarsym) and
  2014. paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then
  2015. indirection:=true;
  2016. end;
  2017. sl_subscript:
  2018. begin
  2019. if not assigned(currdef) then
  2020. internalerror(2009031301);
  2021. if (symlist^.sym.typ<>fieldvarsym) then
  2022. internalerror(2009031202);
  2023. { can't handle offsets with indirections yet }
  2024. if indirection then
  2025. exit;
  2026. if is_packed_record_or_object(currdef) then
  2027. begin
  2028. { can't calculate the address of a non-byte aligned field }
  2029. if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then
  2030. exit;
  2031. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8)
  2032. end
  2033. else
  2034. inc(offset,tfieldvarsym(symlist^.sym).fieldoffset);
  2035. currdef:=tfieldvarsym(symlist^.sym).vardef;
  2036. end;
  2037. sl_absolutetype,
  2038. sl_typeconv:
  2039. begin
  2040. currdef:=symlist^.def;
  2041. { ignore, these don't change the address }
  2042. end;
  2043. sl_vec:
  2044. begin
  2045. if not assigned(currdef) then
  2046. internalerror(2009031201);
  2047. { can't handle offsets with indirections yet }
  2048. if indirection then
  2049. exit;
  2050. case currdef.typ of
  2051. arraydef:
  2052. begin
  2053. if not is_packed_array(currdef) then
  2054. elesize:=tarraydef(currdef).elesize
  2055. else
  2056. begin
  2057. elesize:=tarraydef(currdef).elepackedbitsize;
  2058. { can't calculate the address of a non-byte aligned element }
  2059. if (elesize mod 8)<>0 then
  2060. exit;
  2061. elesize:=elesize div 8;
  2062. end;
  2063. inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
  2064. currdef:=tarraydef(currdef).elementdef;
  2065. end;
  2066. stringdef:
  2067. begin
  2068. case tstringdef(currdef).stringtype of
  2069. st_widestring,st_unicodestring:
  2070. begin
  2071. inc(offset,(symlist^.value.svalue-1)*2);
  2072. currdef:=cwidechartype;
  2073. end;
  2074. st_shortstring:
  2075. begin
  2076. inc(offset,symlist^.value.svalue);
  2077. currdef:=cansichartype;
  2078. end;
  2079. st_ansistring:
  2080. begin
  2081. inc(offset,symlist^.value.svalue-1);
  2082. currdef:=cansichartype;
  2083. end;
  2084. else
  2085. Internalerror(2022070502);
  2086. end;
  2087. end;
  2088. else
  2089. internalerror(2022070501);
  2090. end;
  2091. end;
  2092. else
  2093. internalerror(2009031403);
  2094. end;
  2095. symlist:=symlist^.next;
  2096. until not assigned(symlist);
  2097. if not assigned(sym) then
  2098. internalerror(2009031205);
  2099. result:=true;
  2100. end;
  2101. procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  2102. begin
  2103. appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]);
  2104. end;
  2105. procedure TDebugInfoDwarf.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags);
  2106. var
  2107. templist : TAsmList;
  2108. blocksize,size_of_int : longint;
  2109. tag : tdwarf_tag;
  2110. has_high_reg : boolean;
  2111. dreg,dreghigh : shortint;
  2112. {$ifdef i8086}
  2113. has_segment_sym_name : boolean=false;
  2114. segment_sym_name : TSymStr='';
  2115. segment_reg: TRegister=NR_NO;
  2116. {$endif i8086}
  2117. begin
  2118. blocksize:=0;
  2119. dreghigh:=0;
  2120. { external symbols can't be resolved at link time, so we
  2121. can't generate stabs for them
  2122. not sure if this applies to dwarf as well (FK)
  2123. }
  2124. if vo_is_external in sym.varoptions then
  2125. exit;
  2126. { There is no space allocated for not referenced locals }
  2127. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  2128. exit;
  2129. templist:=TAsmList.create;
  2130. case sym.localloc.loc of
  2131. LOC_REGISTER,
  2132. LOC_CREGISTER,
  2133. LOC_MMREGISTER,
  2134. LOC_CMMREGISTER,
  2135. LOC_FPUREGISTER,
  2136. LOC_CFPUREGISTER :
  2137. begin
  2138. { dwarf_reg_no_error might return -1
  2139. in case the register variable has been optimized out }
  2140. dreg:=dwarf_reg_no_error(sym.localloc.register);
  2141. has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO);
  2142. if has_high_reg then
  2143. dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi);
  2144. if dreghigh=-1 then
  2145. has_high_reg:=false;
  2146. if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  2147. (sym.typ=paravarsym) and
  2148. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  2149. not(vo_has_local_copy in sym.varoptions) and
  2150. not is_open_string(sym.vardef) and (dreg>=0) then
  2151. begin
  2152. templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
  2153. templist.concat(tai_const.create_uleb128bit(dreg));
  2154. templist.concat(tai_const.create_sleb128bit(0));
  2155. blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(0);
  2156. end
  2157. else
  2158. begin
  2159. if has_high_reg then
  2160. begin
  2161. templist.concat(tai_comment.create(strpnew('high:low reg pair variable')));
  2162. size_of_int:=sizeof(aint);
  2163. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  2164. templist.concat(tai_const.create_uleb128bit(dreg));
  2165. blocksize:=1+Lengthuleb128(dreg);
  2166. templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
  2167. templist.concat(tai_const.create_uleb128bit(size_of_int));
  2168. blocksize:=blocksize+1+Lengthuleb128(size_of_int);
  2169. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  2170. templist.concat(tai_const.create_uleb128bit(dreghigh));
  2171. blocksize:=blocksize+1+Lengthuleb128(dreghigh);
  2172. templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
  2173. templist.concat(tai_const.create_uleb128bit(size_of_int));
  2174. blocksize:=blocksize+1+Lengthuleb128(size_of_int);
  2175. end
  2176. else if (dreg>=0) then
  2177. begin
  2178. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  2179. templist.concat(tai_const.create_uleb128bit(dreg));
  2180. blocksize:=1+Lengthuleb128(dreg);
  2181. end;
  2182. end;
  2183. end;
  2184. else
  2185. begin
  2186. case sym.typ of
  2187. staticvarsym:
  2188. begin
  2189. if vo_is_thread_var in sym.varoptions then
  2190. begin
  2191. if tf_section_threadvars in target_info.flags then
  2192. begin
  2193. case sizeof(puint) of
  2194. 2:
  2195. templist.concat(tai_const.create_8bit(ord(DW_OP_const2u)));
  2196. 4:
  2197. templist.concat(tai_const.create_8bit(ord(DW_OP_const4u)));
  2198. 8:
  2199. templist.concat(tai_const.create_8bit(ord(DW_OP_const8u)));
  2200. else
  2201. Internalerror(2019100501);
  2202. end;
  2203. {$push}
  2204. {$warn 6018 off} { Unreachable code due to compile time evaluation }
  2205. templist.concat(tai_const.Create_type_name(aitconst_dtpoff,sym.mangledname,0));
  2206. { so far, aitconst_dtpoff is solely 32 bit }
  2207. if (sizeof(puint)=8) and (target_info.endian=endian_little) then
  2208. templist.concat(tai_const.create_32bit(0));
  2209. templist.concat(tai_const.create_8bit(ord(DW_OP_GNU_push_tls_address)));
  2210. if (sizeof(puint)=8) and (target_info.endian=endian_big) then
  2211. templist.concat(tai_const.create_32bit(0));
  2212. {$pop}
  2213. blocksize:=2+sizeof(puint);
  2214. end
  2215. else
  2216. begin
  2217. { TODO: !!! FIXME: dwarf for thread vars !!!}
  2218. { This is only a minimal change to at least be able to get a value
  2219. in only one thread is present PM 2014-11-21, like for stabs format }
  2220. templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
  2221. templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,
  2222. offset+sizeof(pint)));
  2223. blocksize:=1+sizeof(puint);
  2224. end;
  2225. end
  2226. else
  2227. begin
  2228. templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
  2229. templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset));
  2230. blocksize:=1+sizeof(puint);
  2231. {$ifdef i8086}
  2232. segment_sym_name:=sym.mangledname;
  2233. has_segment_sym_name:=true;
  2234. {$endif i8086}
  2235. end;
  2236. end;
  2237. paravarsym,
  2238. localvarsym:
  2239. begin
  2240. { Happens when writing debug info for paras of procdefs not
  2241. implemented in the current module. Can't add a general check
  2242. for LOC_INVALID above, because staticvarsyms may also have it.
  2243. }
  2244. if sym.localloc.loc<> LOC_INVALID then
  2245. begin
  2246. if is_fbreg(sym.localloc.reference.base) then
  2247. begin
  2248. templist.concat(tai_const.create_8bit(ord(DW_OP_fbreg)));
  2249. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  2250. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
  2251. end
  2252. else
  2253. begin
  2254. dreg:=dwarf_reg(sym.localloc.reference.base);
  2255. if dreg<=31 then
  2256. begin
  2257. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_breg0)+dreg), templist);
  2258. append_const_to_al_dwarf_info(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset), templist);
  2259. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
  2260. end
  2261. else
  2262. begin
  2263. templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
  2264. templist.concat(tai_const.create_uleb128bit(dreg));
  2265. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
  2266. blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(sym.localloc.reference.offset+offset);
  2267. end;
  2268. end;
  2269. {$ifdef i8086}
  2270. segment_reg:=sym.localloc.reference.segment;
  2271. {$endif i8086}
  2272. {$ifndef gdb_supports_DW_AT_variable_parameter}
  2273. { Parameters which are passed by reference. (var and the like)
  2274. Hide the reference-pointer and dereference the pointer
  2275. in the DW_AT_location block.
  2276. }
  2277. if (sym.typ=paravarsym) and
  2278. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  2279. not(vo_has_local_copy in sym.varoptions) and
  2280. not is_open_string(sym.vardef) then
  2281. begin
  2282. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)), templist);
  2283. inc(blocksize);
  2284. end
  2285. {$endif not gdb_supports_DW_AT_variable_parameter}
  2286. end;
  2287. end
  2288. else
  2289. internalerror(200601288);
  2290. end;
  2291. end;
  2292. end;
  2293. { function results must not be added to the parameter list,
  2294. as they are not part of the signature of the function
  2295. (gdb automatically adds them according to the ABI specifications
  2296. when calling the function)
  2297. }
  2298. if (sym.typ=paravarsym) and
  2299. not(dvf_force_local_var in flags) and
  2300. not(vo_is_funcret in sym.varoptions) then
  2301. tag:=DW_TAG_formal_parameter
  2302. else
  2303. tag:=DW_TAG_variable;
  2304. { must be parasym of externally implemented procdef, but
  2305. the parasymtable can con also contain e.g. absolutevarsyms
  2306. -> check symtabletype}
  2307. if (sym.owner.symtabletype=parasymtable) and
  2308. (sym.localloc.loc=LOC_INVALID) then
  2309. begin
  2310. if (sym.owner.symtabletype<>parasymtable) then
  2311. internalerror(2009101001);
  2312. append_entry(tag,false,[
  2313. DW_AT_name,DW_FORM_string,name+#0
  2314. {
  2315. DW_AT_decl_file,DW_FORM_data1,0,
  2316. DW_AT_decl_line,DW_FORM_data1,
  2317. }
  2318. ])
  2319. end
  2320. else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
  2321. LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  2322. ((sym.owner.symtabletype = globalsymtable) or
  2323. (sp_static in sym.symoptions) or
  2324. (vo_is_public in sym.varoptions)) then
  2325. append_entry(tag,false,[
  2326. DW_AT_name,DW_FORM_string,name+#0,
  2327. {
  2328. DW_AT_decl_file,DW_FORM_data1,0,
  2329. DW_AT_decl_line,DW_FORM_data1,
  2330. }
  2331. DW_AT_external,DW_FORM_flag,true,
  2332. { data continues below }
  2333. DW_AT_location,DW_FORM_block1,blocksize
  2334. ])
  2335. {$ifdef gdb_supports_DW_AT_variable_parameter}
  2336. else if (sym.typ=paravarsym) and
  2337. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  2338. not(vo_has_local_copy in sym.varoptions) and
  2339. not is_open_string(sym.vardef) then
  2340. append_entry(tag,false,[
  2341. DW_AT_name,DW_FORM_string,name+#0,
  2342. DW_AT_variable_parameter,DW_FORM_flag,true,
  2343. {
  2344. DW_AT_decl_file,DW_FORM_data1,0,
  2345. DW_AT_decl_line,DW_FORM_data1,
  2346. }
  2347. { data continues below }
  2348. DW_AT_location,DW_FORM_block1,blocksize
  2349. ])
  2350. {$endif gdb_supports_DW_AT_variable_parameter}
  2351. else
  2352. append_entry(tag,false,[
  2353. DW_AT_name,DW_FORM_string,name+#0,
  2354. {
  2355. DW_AT_decl_file,DW_FORM_data1,0,
  2356. DW_AT_decl_line,DW_FORM_data1,
  2357. }
  2358. { data continues below }
  2359. DW_AT_location,DW_FORM_block1,blocksize
  2360. ]);
  2361. { append block data }
  2362. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  2363. { Mark self as artificial for methods, because gdb uses the fact
  2364. whether or not the first parameter of a method is artificial to
  2365. distinguish regular from static methods (since there are no
  2366. no vo_is_self parameters for static methods, we don't have to check
  2367. that). }
  2368. if (vo_is_self in sym.varoptions) then
  2369. append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
  2370. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  2371. {$ifdef i8086}
  2372. if has_segment_sym_name then
  2373. append_seg_name(segment_sym_name)
  2374. else if segment_reg<>NR_NO then
  2375. append_seg_reg(segment_reg);
  2376. {$endif i8086}
  2377. templist.free;
  2378. finish_entry;
  2379. end;
  2380. procedure TDebugInfoDwarf.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  2381. begin
  2382. appendsym_var(list,sym);
  2383. end;
  2384. procedure TDebugInfoDwarf.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  2385. begin
  2386. appendsym_var(list,sym);
  2387. end;
  2388. procedure TDebugInfoDwarf.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  2389. begin
  2390. appendsym_var(list,sym);
  2391. end;
  2392. procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  2393. begin
  2394. appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0,false);
  2395. end;
  2396. procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint; is_fake_property: boolean);
  2397. var
  2398. bitoffset,
  2399. fieldoffset,
  2400. fieldnatsize: asizeint;
  2401. begin
  2402. if (sp_static in sym.symoptions) or
  2403. (sym.visibility=vis_hidden) then
  2404. exit;
  2405. if not is_fake_property then
  2406. { Store the offset of this field (relative to the label at the start of
  2407. the debug info for this structure) so that properties are able to
  2408. reference this field
  2409. When the ds_dwarf_properties is not provided, the compiler creates
  2410. 'fake' properties, though. In that case the offset is invalid and should
  2411. not be stored }
  2412. set_sym_dwarf_offset(sym, DwarfOffset);
  2413. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
  2414. { only ordinals are bitpacked }
  2415. not is_ordinal(sym.vardef) then
  2416. begin
  2417. { other kinds of fields can however also appear in a bitpacked }
  2418. { record, and then their offset is also specified in bits rather }
  2419. { than in bytes }
  2420. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
  2421. fieldoffset:=sym.fieldoffset
  2422. else
  2423. fieldoffset:=sym.fieldoffset div 8;
  2424. inc(fieldoffset,offset);
  2425. append_entry(DW_TAG_member,false,[
  2426. DW_AT_name,DW_FORM_string,name+#0,
  2427. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  2428. ]);
  2429. end
  2430. else
  2431. begin
  2432. if (sym.vardef.packedbitsize > 255) then
  2433. internalerror(2007061201);
  2434. { we don't bitpack according to the ABI, but as close as }
  2435. { possible, i.e., equivalent to gcc's }
  2436. { __attribute__((__packed__)), which is also what gpc }
  2437. { does. }
  2438. fieldnatsize:=max(sizeof(pint),sym.vardef.size);
  2439. fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
  2440. inc(fieldoffset,offset);
  2441. bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
  2442. if (target_info.endian=endian_little) then
  2443. bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
  2444. append_entry(DW_TAG_member,false,[
  2445. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  2446. { gcc also generates both a bit and byte size attribute }
  2447. { we don't support ordinals >= 256 bits }
  2448. DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
  2449. { nor >= 256 bits (not yet, anyway, see IE above) }
  2450. DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
  2451. { data1 and data2 are unsigned, bitoffset can also be negative }
  2452. DW_AT_bit_offset,DW_FORM_data4,bitoffset,
  2453. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  2454. ]);
  2455. end;
  2456. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  2457. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(fieldoffset));
  2458. if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  2459. append_visibility(sym.visibility);
  2460. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
  2461. finish_entry;
  2462. end;
  2463. procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym);
  2464. begin
  2465. appendsym_const_member(list,sym,false);
  2466. end;
  2467. procedure TDebugInfoDwarf.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
  2468. var
  2469. i,
  2470. size: aint;
  2471. usedef: tdef;
  2472. begin
  2473. { These are default values of parameters. These should be encoded
  2474. via DW_AT_default_value, not as a separate sym. Moreover, their
  2475. type is not available when writing the debug info for external
  2476. procedures.
  2477. }
  2478. if (sym.owner.symtabletype=parasymtable) then
  2479. exit;
  2480. if ismember then
  2481. append_entry(DW_TAG_member,false,[
  2482. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  2483. { The DW_AT_declaration tag is invalid according to the DWARF specifications.
  2484. But gcc adds this to static const members and gdb checks
  2485. for this flag. So we have to set it also.
  2486. }
  2487. DW_AT_declaration,DW_FORM_flag,true,
  2488. DW_AT_external,DW_FORM_flag,true
  2489. ])
  2490. else
  2491. append_entry(DW_TAG_variable,false,[
  2492. DW_AT_name,DW_FORM_string,symname(sym, false)+#0
  2493. ]);
  2494. { for string constants, constdef isn't set because they have no real type }
  2495. case sym.consttyp of
  2496. conststring:
  2497. begin
  2498. { if DW_FORM_string is used below one day, this usedef should
  2499. probably become nil }
  2500. { note: < 255 instead of <= 255 because we have to store the
  2501. entire length of the string as well, and 256 does not fit in
  2502. a byte }
  2503. if (sym.value.len<255) then
  2504. usedef:=cshortstringtype
  2505. else
  2506. usedef:=clongstringtype;
  2507. end;
  2508. constresourcestring,
  2509. constwstring:
  2510. usedef:=nil;
  2511. else
  2512. usedef:=sym.constdef;
  2513. end;
  2514. if assigned(usedef) then
  2515. append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef));
  2516. AddConstToAbbrev(ord(DW_AT_const_value));
  2517. case sym.consttyp of
  2518. conststring:
  2519. begin
  2520. { DW_FORM_string isn't supported yet by the Pascal value printer
  2521. -> create a string using raw bytes }
  2522. if (sym.value.len<255) then
  2523. begin
  2524. AddConstToAbbrev(ord(DW_FORM_block1));
  2525. append_const_to_al_dwarf_info(tai_const.create_8bit(sym.value.len+1));
  2526. append_const_to_al_dwarf_info(tai_const.create_8bit(sym.value.len));
  2527. end
  2528. else
  2529. begin
  2530. AddConstToAbbrev(ord(DW_FORM_block));
  2531. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(sym.value.len+sizesinttype.size));
  2532. append_const_to_al_dwarf_info(tai_const.Create_sizeint_unaligned(sym.value.len));
  2533. end;
  2534. i:=0;
  2535. size:=sym.value.len;
  2536. while(i<size) do
  2537. begin
  2538. append_const_to_al_dwarf_info(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
  2539. inc(i);
  2540. end;
  2541. end;
  2542. constguid,
  2543. constset:
  2544. begin
  2545. AddConstToAbbrev(ord(DW_FORM_block1));
  2546. append_const_to_al_dwarf_info(tai_const.create_8bit(usedef.size));
  2547. i:=0;
  2548. size:=sym.constdef.size;
  2549. while (i<size) do
  2550. begin
  2551. append_const_to_al_dwarf_info(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
  2552. inc(i);
  2553. end;
  2554. end;
  2555. constwstring,
  2556. constresourcestring:
  2557. begin
  2558. { write dummy for now }
  2559. AddConstToAbbrev(ord(DW_FORM_string));
  2560. append_to_al_dwarf_info(tai_string.create(''), 1);
  2561. append_const_to_al_dwarf_info(tai_const.create_8bit(0));
  2562. end;
  2563. constord:
  2564. begin
  2565. if (sym.value.valueord<0) then
  2566. begin
  2567. AddConstToAbbrev(ord(DW_FORM_sdata));
  2568. append_const_to_al_dwarf_info(tai_const.create_sleb128bit(sym.value.valueord.svalue));
  2569. end
  2570. else
  2571. begin
  2572. AddConstToAbbrev(ord(DW_FORM_udata));
  2573. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(sym.value.valueord.uvalue));
  2574. end;
  2575. end;
  2576. constnil:
  2577. begin
  2578. {$ifdef cpu64bitaddr}
  2579. AddConstToAbbrev(ord(DW_FORM_data8));
  2580. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(0));
  2581. {$else cpu64bitaddr}
  2582. AddConstToAbbrev(ord(DW_FORM_data4));
  2583. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(0));
  2584. {$endif cpu64bitaddr}
  2585. end;
  2586. constpointer:
  2587. begin
  2588. {$ifdef cpu64bitaddr}
  2589. AddConstToAbbrev(ord(DW_FORM_data8));
  2590. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(int64(sym.value.valueordptr)));
  2591. {$else cpu64bitaddr}
  2592. AddConstToAbbrev(ord(DW_FORM_data4));
  2593. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(longint(sym.value.valueordptr)));
  2594. {$endif cpu64bitaddr}
  2595. end;
  2596. constreal:
  2597. begin
  2598. AddConstToAbbrev(ord(DW_FORM_block1));
  2599. case tfloatdef(sym.constdef).floattype of
  2600. s32real:
  2601. begin
  2602. append_const_to_al_dwarf_info(tai_const.create_8bit(4));
  2603. append_realconst_to_al_dwarf_info(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^));
  2604. end;
  2605. s64real:
  2606. begin
  2607. append_const_to_al_dwarf_info(tai_const.create_8bit(8));
  2608. append_realconst_to_al_dwarf_info(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^));
  2609. end;
  2610. s64comp,
  2611. s64currency:
  2612. begin
  2613. append_const_to_al_dwarf_info(tai_const.create_8bit(8));
  2614. append_const_to_al_dwarf_info(tai_const.create_64bit_unaligned(trunc(pbestreal(sym.value.valueptr)^)));
  2615. end;
  2616. s80real,
  2617. sc80real:
  2618. begin
  2619. append_const_to_al_dwarf_info(tai_const.create_8bit(sym.constdef.size));
  2620. append_realconst_to_al_dwarf_info(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size));
  2621. end;
  2622. else
  2623. internalerror(200601291);
  2624. end;
  2625. end;
  2626. else
  2627. internalerror(200601292);
  2628. end;
  2629. finish_entry;
  2630. end;
  2631. procedure TDebugInfoDwarf.appendsym_label(list:TAsmList;sym: tlabelsym);
  2632. begin
  2633. { ignore label syms for now, the problem is that a label sym
  2634. can have more than one label associated e.g. in case of
  2635. an inline procedure expansion }
  2636. end;
  2637. procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym);
  2638. procedure append_property;
  2639. var
  2640. symlist: ppropaccesslistitem;
  2641. tosym: tabstractvarsym;
  2642. offset: pint;
  2643. begin
  2644. if assigned(sym.propaccesslist[palt_read]) and
  2645. not assigned(sym.propaccesslist[palt_read].procdef) then
  2646. symlist:=sym.propaccesslist[palt_read].firstsym
  2647. else
  2648. { can't handle }
  2649. exit;
  2650. if not get_symlist_sym_offset(symlist,tosym,offset) then
  2651. exit;
  2652. if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  2653. begin
  2654. if (tosym.typ=fieldvarsym) then
  2655. internalerror(2009031404);
  2656. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[])
  2657. end
  2658. else
  2659. appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset,true)
  2660. end;
  2661. { Append reference to the underlying field or method for read/write/stored access }
  2662. procedure append_reference_to_access_member(attr : tdwarf_attribute; accesslist: tpropaccesslist);
  2663. var
  2664. anchorlabel: TAsmSymbol;
  2665. memberowner: TSymtable;
  2666. membersym: tabstractvarsym;
  2667. memberdef: tdef;
  2668. memberdef_or_sym: tobject;
  2669. dwarfoffset: pint;
  2670. defowner: tabstractrecorddef;
  2671. begin
  2672. memberowner:=nil;
  2673. membersym:=nil;
  2674. memberdef:=nil;
  2675. { To get rid off warning. }
  2676. memberdef_or_sym:=nil;
  2677. dwarfoffset:=0;
  2678. if assigned(accesslist.procdef) then
  2679. begin
  2680. memberdef := accesslist.procdef;
  2681. { Debuginfo for procdefs is only written for members of an odt_helper
  2682. or odt_class. (So, among others, not for interfaces.)
  2683. It is not possible to reference something that is not there, so
  2684. omit te reference. }
  2685. if Assigned(memberdef.owner.defowner) and (memberdef.owner.defowner.typ=objectdef) and
  2686. (tobjectdef(memberdef.owner.defowner).objecttype in [odt_helper, odt_class]) then
  2687. begin
  2688. if Assigned(tprocdef(memberdef).localst) then
  2689. begin
  2690. memberowner := memberdef.owner;
  2691. dwarfoffset := (accesslist.procdef as tcpuprocdef).dwarfoffset;
  2692. memberdef_or_sym := memberdef;
  2693. end;
  2694. end;
  2695. end
  2696. { Note that the returned 'dwarfoffset' is not used and not a dwarf-offset }
  2697. else if get_symlist_sym_offset(accesslist.firstsym, membersym, dwarfoffset) and
  2698. { Debuginfo for static members is not written
  2699. It is not possible to reference something that is not there, so
  2700. omit te reference. }
  2701. not (sp_static in membersym.symoptions) then
  2702. begin
  2703. memberowner := membersym.owner;
  2704. if (membersym.typ <> fieldvarsym) then
  2705. internalerror(202201301);
  2706. dwarfoffset:=tcpufieldvarsym(membersym).dwarfoffset;
  2707. memberdef_or_sym := membersym;
  2708. end;
  2709. if assigned(memberowner) then
  2710. begin
  2711. { Retrieve information about the structure of the underlying field/method }
  2712. defowner := memberowner.defowner as tabstractrecorddef;
  2713. { A label representing the start of the debug-info for the
  2714. underlying structure. This is the structure where the DwarfOffset is
  2715. relative to. }
  2716. anchorlabel := def_dwarf_class_struct_lab(defowner);
  2717. { When the debug-info for the member is not written yet, it will be
  2718. as part of this CU, so also in this case we can add a relative
  2719. reference }
  2720. if (memberowner.iscurrentunit) or not (ds_dwarf_dbg_info_written in defowner.defstates) then
  2721. { Create a relative reference to the member }
  2722. append_offsetentry_ref(attr, memberdef_or_sym, dwarfoffset, anchorlabel)
  2723. else
  2724. { Create an absolute reference to the member, based on a global
  2725. label. (+offset) }
  2726. append_labelentry_ref_offset(attr, anchorlabel, dwarfoffset);
  2727. end;
  2728. end;
  2729. procedure append_property_using_fpc_extension;
  2730. begin
  2731. append_entry(DW_TAG_FPC_Property,false,[
  2732. DW_AT_name,DW_FORM_string,symname(sym, false)+#0
  2733. ]);
  2734. if assigned(sym.propaccesslist[palt_read]) then
  2735. append_reference_to_access_member(DW_AT_FPC_property_read, sym.propaccesslist[palt_read]);
  2736. if assigned(sym.propaccesslist[palt_write]) then
  2737. append_reference_to_access_member(DW_AT_FPC_property_write, sym.propaccesslist[palt_write]);
  2738. if assigned(sym.propaccesslist[palt_stored]) then
  2739. append_reference_to_access_member(DW_AT_FPC_property_stored, sym.propaccesslist[palt_stored]);
  2740. if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  2741. append_visibility(sym.visibility);
  2742. finish_entry;
  2743. end;
  2744. begin
  2745. if (ds_dwarf_properties in current_settings.debugswitches) then
  2746. append_property_using_fpc_extension
  2747. else
  2748. append_property()
  2749. end;
  2750. function TDebugInfoDwarf.symdebugname(sym: tsym): String;
  2751. begin
  2752. result := sym.name;
  2753. end;
  2754. procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym);
  2755. begin
  2756. { just queue the def if needed, beforeappenddef will
  2757. emit the typedef if necessary }
  2758. def_dwarf_lab(sym.typedef);
  2759. end;
  2760. procedure TDebugInfoDwarf.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  2761. var
  2762. templist : TAsmList;
  2763. blocksize : longint;
  2764. symlist : ppropaccesslistitem;
  2765. tosym: tabstractvarsym;
  2766. offset: pint;
  2767. flags: tdwarfvarsymflags;
  2768. begin
  2769. templist:=TAsmList.create;
  2770. case tabsolutevarsym(sym).abstyp of
  2771. toaddr :
  2772. begin
  2773. { MWE: replaced ifdef i368 }
  2774. (*
  2775. if target_cpu = cpu_i386 then
  2776. begin
  2777. { in theory, we could write a DW_AT_segment entry here for sym.absseg,
  2778. however I doubt that gdb supports this (FK) }
  2779. end;
  2780. *)
  2781. templist.concat(tai_const.create_8bit(3));
  2782. {$ifdef avr}
  2783. // Add $800000 to indicate that the address is in memory space
  2784. templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset + $800000, aitconst_ptr_unaligned));
  2785. {$else}
  2786. templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset));
  2787. {$endif}
  2788. blocksize:=1+sizeof(puint);
  2789. end;
  2790. toasm :
  2791. begin
  2792. templist.concat(tai_const.create_8bit(3));
  2793. templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0));
  2794. blocksize:=1+sizeof(puint);
  2795. end;
  2796. tovar:
  2797. begin
  2798. symlist:=tabsolutevarsym(sym).ref.firstsym;
  2799. if get_symlist_sym_offset(symlist,tosym,offset) then
  2800. begin
  2801. if (tosym.typ=fieldvarsym) then
  2802. internalerror(2009031402);
  2803. flags:=[];
  2804. if (sym.owner.symtabletype=localsymtable) then
  2805. include(flags,dvf_force_local_var);
  2806. appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags);
  2807. end;
  2808. templist.free;
  2809. exit;
  2810. end;
  2811. end;
  2812. append_entry(DW_TAG_variable,false,[
  2813. DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
  2814. {
  2815. DW_AT_decl_file,DW_FORM_data1,0,
  2816. DW_AT_decl_line,DW_FORM_data1,
  2817. }
  2818. DW_AT_external,DW_FORM_flag,true,
  2819. { data continues below }
  2820. DW_AT_location,DW_FORM_block1,blocksize
  2821. ]);
  2822. { append block data }
  2823. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  2824. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  2825. templist.free;
  2826. finish_entry;
  2827. end;
  2828. procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym);
  2829. begin
  2830. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true))));
  2831. end;
  2832. procedure TDebugInfoDwarf.insertmoduleinfo;
  2833. var
  2834. templist: TAsmList;
  2835. linelist: TAsmList;
  2836. lbl : tasmlabel;
  2837. n,m : Integer;
  2838. ditem : TDirIndexItem;
  2839. fitem : TFileIndexItem;
  2840. flist : TFPList;
  2841. dbgname : TSymStr;
  2842. begin
  2843. if not (target_info.system in systems_wasm) then
  2844. begin
  2845. { insert DEBUGSTART and DEBUGEND labels }
  2846. dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
  2847. { Darwin's linker does not like two global labels both pointing to the
  2848. end of a section, which can happen in case of units without code ->
  2849. make them local; we don't need the debugtable stuff there either,
  2850. so it doesn't matter that they are not global.
  2851. }
  2852. if (target_info.system in systems_darwin) then
  2853. dbgname:='L'+dbgname;
  2854. new_section(current_asmdata.asmlists[al_start],sec_code,dbgname,0,secorder_begin);
  2855. if not(target_info.system in systems_darwin) then
  2856. current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype))
  2857. else
  2858. current_asmdata.asmlists[al_start].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype));
  2859. dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
  2860. { See above. }
  2861. if (target_info.system in systems_darwin) then
  2862. dbgname:='L'+dbgname;
  2863. new_section(current_asmdata.asmlists[al_end],sec_code,dbgname,0,secorder_end);
  2864. if not(target_info.system in systems_darwin) then
  2865. current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype))
  2866. else
  2867. current_asmdata.asmlists[al_end].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype));
  2868. end;
  2869. { insert .Ldebug_abbrev0 label }
  2870. templist:=TAsmList.create;
  2871. new_section(templist,sec_debug_abbrev,'',0);
  2872. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrevsection0',AT_METADATA,0,voidpointertype));
  2873. { add any extra stuff which needs to be in the abbrev section, but before }
  2874. { the actual abbreviations, in between the symbol above and below, i.e. here }
  2875. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrev0',AT_METADATA,0,voidpointertype));
  2876. current_asmdata.asmlists[al_start].insertlist(templist);
  2877. templist.free;
  2878. { insert .Ldebug_line0 label }
  2879. templist:=TAsmList.create;
  2880. new_section(templist,sec_debug_line,'',0);
  2881. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_linesection0',AT_METADATA,0,voidpointertype));
  2882. { add any extra stuff which needs to be in the line section, but before }
  2883. { the actual line info, in between the symbol above and below, i.e. here }
  2884. templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_line0',AT_METADATA,0,voidpointertype));
  2885. current_asmdata.asmlists[al_start].insertlist(templist);
  2886. templist.free;
  2887. { finalize line info if the unit doesn't contain any function/ }
  2888. { procedure/init/final code }
  2889. finish_lineinfo;
  2890. { debug line header }
  2891. linelist := current_asmdata.asmlists[al_dwarf_line];
  2892. new_section(linelist,sec_debug_line,'',0);
  2893. linelist.concat(tai_comment.Create(strpnew('=== header start ===')));
  2894. { size }
  2895. current_asmdata.getlabel(lbl,alt_dbgfile);
  2896. if use_64bit_headers then
  2897. linelist.concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
  2898. linelist.concat(tai_const.create_rel_sym(offsetreltype,
  2899. lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_line0',AB_LOCAL,AT_METADATA,voidpointertype)));
  2900. linelist.concat(tai_label.create(lbl));
  2901. { version }
  2902. linelist.concat(tai_const.create_16bit_unaligned(dwarf_version));
  2903. { header length }
  2904. current_asmdata.getlabel(lbl,alt_dbgfile);
  2905. linelist.concat(tai_const.create_rel_sym(offsetreltype,
  2906. lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'ehdebug_line0',AB_LOCAL,AT_METADATA,voidpointertype)));
  2907. linelist.concat(tai_label.create(lbl));
  2908. { minimum_instruction_length }
  2909. linelist.concat(tai_const.create_8bit(1));
  2910. { default_is_stmt }
  2911. linelist.concat(tai_const.create_8bit(1));
  2912. { line_base }
  2913. linelist.concat(tai_const.create_8bit(LINE_BASE));
  2914. { line_range }
  2915. { only line increase, no adress }
  2916. linelist.concat(tai_const.create_8bit(255));
  2917. { opcode_base }
  2918. linelist.concat(tai_const.create_8bit(OPCODE_BASE));
  2919. { standard_opcode_lengths }
  2920. { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) }
  2921. { DW_LNS_copy }
  2922. linelist.concat(tai_const.create_8bit(0));
  2923. { DW_LNS_advance_pc }
  2924. linelist.concat(tai_const.create_8bit(1));
  2925. { DW_LNS_advance_line }
  2926. linelist.concat(tai_const.create_8bit(1));
  2927. { DW_LNS_set_file }
  2928. linelist.concat(tai_const.create_8bit(1));
  2929. { DW_LNS_set_column }
  2930. linelist.concat(tai_const.create_8bit(1));
  2931. { DW_LNS_negate_stmt }
  2932. linelist.concat(tai_const.create_8bit(0));
  2933. { DW_LNS_set_basic_block }
  2934. linelist.concat(tai_const.create_8bit(0));
  2935. { DW_LNS_const_add_pc }
  2936. linelist.concat(tai_const.create_8bit(0));
  2937. { DW_LNS_fixed_advance_pc }
  2938. linelist.concat(tai_const.create_8bit(1));
  2939. { DW_LNS_set_prologue_end }
  2940. linelist.concat(tai_const.create_8bit(0));
  2941. { DW_LNS_set_epilogue_begin }
  2942. linelist.concat(tai_const.create_8bit(0));
  2943. { DW_LNS_set_isa }
  2944. linelist.concat(tai_const.create_8bit(1));
  2945. { Create single list of filenames sorted in IndexNr }
  2946. flist:=TFPList.Create;
  2947. for n := 0 to dirlist.Count - 1 do
  2948. begin
  2949. ditem := TDirIndexItem(dirlist[n]);
  2950. for m := 0 to ditem.Files.Count - 1 do
  2951. flist.Add(ditem.Files[m]);
  2952. end;
  2953. flist.Sort(@FileListSortCompare);
  2954. { include_directories }
  2955. linelist.concat(tai_comment.Create(strpnew('include_directories')));
  2956. for n := 0 to dirlist.Count - 1 do
  2957. begin
  2958. ditem := TDirIndexItem(dirlist[n]);
  2959. if ditem.Name = '.' then
  2960. Continue;
  2961. { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist }
  2962. linelist.concat(tai_string.create(ditem.Name+#0));
  2963. end;
  2964. linelist.concat(tai_const.create_8bit(0));
  2965. { file_names }
  2966. linelist.concat(tai_comment.Create(strpnew('file_names')));
  2967. for n := 0 to flist.Count - 1 do
  2968. begin
  2969. fitem := TFileIndexItem(flist[n]);
  2970. { file name }
  2971. linelist.concat(tai_string.create(fitem.Name+#0));
  2972. { directory index }
  2973. linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex));
  2974. { last modification }
  2975. linelist.concat(tai_const.create_uleb128bit(0));
  2976. { file length }
  2977. linelist.concat(tai_const.create_uleb128bit(0));
  2978. end;
  2979. linelist.concat(tai_const.create_8bit(0));
  2980. { end of debug line header }
  2981. linelist.concat(tai_symbol.createname(target_asm.labelprefix+'ehdebug_line0',AT_METADATA,0,voidpointertype));
  2982. linelist.concat(tai_comment.Create(strpnew('=== header end ===')));
  2983. { add line program }
  2984. linelist.concatList(asmline);
  2985. { end of debug line table }
  2986. linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_METADATA,0,voidpointertype));
  2987. flist.free;
  2988. end;
  2989. procedure TDebugInfoDwarf.inserttypeinfo;
  2990. var
  2991. storefilepos : tfileposinfo;
  2992. lenstartlabel,arangestartlabel: tasmlabel;
  2993. i : longint;
  2994. def: tdef;
  2995. dbgname: string;
  2996. vardatatype: ttypesym;
  2997. bind: tasmsymbind;
  2998. lang: tdwarf_source_language;
  2999. begin
  3000. include(current_module.moduleflags,mf_has_dwarf_debuginfo);
  3001. storefilepos:=current_filepos;
  3002. current_filepos:=current_module.mainfilepos;
  3003. if assigned(dwarflabels) then
  3004. internalerror(2015100301);
  3005. { one item per def, plus some extra space in case of nested types,
  3006. externally used types etc (it will grow further if necessary) }
  3007. i:=current_module.localsymtable.DefList.count*4;
  3008. if assigned(current_module.globalsymtable) then
  3009. inc(i,current_module.globalsymtable.DefList.count*2);
  3010. dwarflabels:=TDwarfLabHashSet.Create(i,true,false);
  3011. { How to guess the amount of properties referencing dwarf-items that are
  3012. not written yet? This is a really crude attempt. (it will grow further
  3013. if necessary)}
  3014. if (ds_dwarf_properties in current_settings.debugswitches) then
  3015. begin
  3016. i:=current_module.localsymtable.DefList.count;
  3017. PendingOffsets:=THashSet.Create(i,true,true);
  3018. end;
  3019. currabbrevnumber:=0;
  3020. defnumberlist:=TFPObjectList.create(false);
  3021. deftowritelist:=TFPObjectList.create(false);
  3022. { not exported (FK)
  3023. FILEREC
  3024. TEXTREC
  3025. }
  3026. vardatatype:=try_search_system_type('TVARDATA');
  3027. if assigned(vardatatype) then
  3028. vardatadef:=trecorddef(vardatatype.typedef);
  3029. { write start labels }
  3030. new_section(current_asmdata.asmlists[al_dwarf_info],sec_debug_info,'',0);
  3031. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'debug_info0',AT_METADATA,0,voidpointertype));
  3032. { start abbrev section }
  3033. new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
  3034. if not(target_info.system in systems_darwin) then
  3035. begin
  3036. { start aranges section }
  3037. new_section(current_asmdata.asmlists[al_dwarf_aranges],sec_debug_aranges,'',0);
  3038. current_asmdata.getlabel(arangestartlabel,alt_dbgfile);
  3039. if use_64bit_headers then
  3040. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
  3041. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
  3042. arangestartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'earanges0',AB_LOCAL,AT_METADATA,voidpointertype)));
  3043. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_label.create(arangestartlabel));
  3044. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_16bit_unaligned(2));
  3045. if not(tf_dwarf_relative_addresses in target_info.flags) then
  3046. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_type_sym(offsetabstype,
  3047. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype)))
  3048. else
  3049. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
  3050. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_infosection0',AB_LOCAL,AT_METADATA,voidpointertype),
  3051. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype)));
  3052. {$ifdef i8086}
  3053. { address_size }
  3054. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(4));
  3055. { segment_size }
  3056. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(2));
  3057. { no alignment/padding bytes on i8086 for Open Watcom compatibility }
  3058. {$else i8086}
  3059. { address_size }
  3060. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(sizeof(pint)));
  3061. { segment_size }
  3062. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(0));
  3063. { alignment }
  3064. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(0));
  3065. {$endif i8086}
  3066. { start ranges section }
  3067. new_section(current_asmdata.asmlists[al_dwarf_ranges],sec_debug_ranges,'',0);
  3068. end;
  3069. { debug info header }
  3070. current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
  3071. { size }
  3072. if use_64bit_headers then
  3073. append_const_to_al_dwarf_info(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
  3074. append_const_to_al_dwarf_info(tai_const.create_rel_sym(offsetreltype,
  3075. lenstartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_info0',AB_LOCAL,AT_METADATA,voidpointertype)));
  3076. append_to_al_dwarf_info(tai_label.create(lenstartlabel), 0);
  3077. { version }
  3078. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(dwarf_version));
  3079. { abbrev table (=relative from section start)}
  3080. if not(tf_dwarf_relative_addresses in target_info.flags) then
  3081. append_const_to_al_dwarf_info(tai_const.create_type_sym(offsetabstype,
  3082. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)))
  3083. else
  3084. append_const_to_al_dwarf_info(tai_const.create_rel_sym(offsetreltype,
  3085. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0',AB_LOCAL,AT_METADATA,voidpointertype),
  3086. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)));
  3087. { address size }
  3088. append_const_to_al_dwarf_info(tai_const.create_8bit(sizeof(pint)));
  3089. if (ds_dwarf_cpp in current_settings.debugswitches) then
  3090. lang:=DW_LANG_C_plus_plus
  3091. else
  3092. lang:=DW_LANG_Pascal83;
  3093. { first manadatory compilation unit TAG }
  3094. append_entry(DW_TAG_compile_unit,true,[
  3095. DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path+current_module.sourcefiles.get_file(1).name)+#0,
  3096. DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
  3097. DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0,
  3098. DW_AT_language,DW_FORM_data1,lang,
  3099. DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
  3100. {$ifdef i8086}
  3101. case current_settings.x86memorymodel of
  3102. mm_tiny,
  3103. mm_small:
  3104. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_small]);
  3105. mm_medium:
  3106. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_medium]);
  3107. mm_compact:
  3108. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_compact]);
  3109. mm_large:
  3110. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_large]);
  3111. mm_huge:
  3112. append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_huge]);
  3113. end;
  3114. {$endif i8086}
  3115. { reference to line info section }
  3116. if not(tf_dwarf_relative_addresses in target_info.flags) then
  3117. append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype))
  3118. else
  3119. append_labelentry_dataptr_rel(DW_AT_stmt_list,
  3120. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_linesection0',AB_LOCAL,AT_METADATA,voidpointertype),
  3121. current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype));
  3122. if (m_objectivec1 in current_settings.modeswitches) then
  3123. append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]);
  3124. if target_info.system in systems_wasm then
  3125. begin
  3126. append_attribute(DW_AT_low_pc,DW_FORM_data4,[0]);
  3127. { todo: append DW_AT_ranges }
  3128. end
  3129. else
  3130. begin
  3131. dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
  3132. if (target_info.system in systems_darwin) then
  3133. begin
  3134. bind:=AB_LOCAL;
  3135. dbgname:='L'+dbgname;
  3136. end
  3137. else
  3138. bind:=AB_GLOBAL;
  3139. append_labelentry(DW_AT_low_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
  3140. dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
  3141. if (target_info.system in systems_darwin) then
  3142. dbgname:='L'+dbgname;
  3143. append_labelentry(DW_AT_high_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
  3144. end;
  3145. finish_entry;
  3146. { write all global/local variables. This will flag all required tdefs }
  3147. if assigned(current_module.globalsymtable) then
  3148. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  3149. if assigned(current_module.localsymtable) then
  3150. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  3151. { write all procedures and methods. This will flag all required tdefs }
  3152. if assigned(current_module.globalsymtable) then
  3153. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  3154. if assigned(current_module.localsymtable) then
  3155. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  3156. { reset unit type info flag }
  3157. reset_unit_type_info;
  3158. { write used types from the used units }
  3159. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  3160. { last write the types from this unit }
  3161. if assigned(current_module.globalsymtable) then
  3162. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  3163. if assigned(current_module.localsymtable) then
  3164. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  3165. { write defs not written yet }
  3166. write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]);
  3167. { close compilation unit entry }
  3168. finish_children;
  3169. { end of debug info table }
  3170. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_METADATA,0,voidpointertype));
  3171. { end of abbrev table }
  3172. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
  3173. if not(target_info.system in systems_darwin) then
  3174. begin
  3175. { end of aranges table }
  3176. {$ifdef i8086}
  3177. { 32-bit offset }
  3178. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
  3179. { 16-bit segment }
  3180. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
  3181. { 32-bit length }
  3182. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
  3183. {$else i8086}
  3184. { offset }
  3185. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
  3186. { length }
  3187. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
  3188. {$endif i8086}
  3189. current_asmdata.asmlists[al_dwarf_aranges].concat(tai_symbol.createname(target_asm.labelprefix+'earanges0',AT_METADATA,0,voidpointertype));
  3190. end;
  3191. { reset all def debug states }
  3192. for i:=0 to defnumberlist.count-1 do
  3193. begin
  3194. def := tdef(defnumberlist[i]);
  3195. if assigned(def) then
  3196. def.dbg_state:=dbg_state_unused;
  3197. end;
  3198. dwarflabels.free;
  3199. dwarflabels:=nil;
  3200. defnumberlist.free;
  3201. defnumberlist:=nil;
  3202. deftowritelist.free;
  3203. deftowritelist:=nil;
  3204. if Assigned(PendingOffsets) and (PendingOffsets.Count > 0) then
  3205. Internalerror(2022021201);
  3206. PendingOffsets.Free;
  3207. PendingOffsets:=nil;
  3208. current_filepos:=storefilepos;
  3209. end;
  3210. procedure TDebugInfoDwarf.referencesections(list:TAsmList);
  3211. var
  3212. hp : tmodule;
  3213. begin
  3214. { Reference all DEBUGINFO sections from the main .fpc section }
  3215. { to prevent eliminating them by smartlinking }
  3216. if (target_info.system in ([system_powerpc_macosclassic]+systems_darwin+systems_wasm)) then
  3217. exit;
  3218. new_section(list,sec_fpc,'links',0);
  3219. { include reference to all debuginfo sections of used units }
  3220. hp:=tmodule(loaded_units.first);
  3221. while assigned(hp) do
  3222. begin
  3223. If (mf_has_dwarf_debuginfo in hp.moduleflags) and not assigned(hp.package) then
  3224. begin
  3225. list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
  3226. list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
  3227. end;
  3228. hp:=tmodule(hp.next);
  3229. end;
  3230. end;
  3231. function TDebugInfoDwarf.symname(sym: tsym; manglename: boolean): String;
  3232. begin
  3233. if (sym.typ=paravarsym) and
  3234. (vo_is_self in tparavarsym(sym).varoptions) then
  3235. { We use 'this' for regular methods because that's what gdb triggers
  3236. on to automatically search fields. Don't do this for class methods,
  3237. because search class fields is not supported, and gdb 7.0+ fails
  3238. in this case because "this" is not a record in that case (it's a
  3239. pointer to a vmt) }
  3240. if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and
  3241. not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
  3242. result:='this'
  3243. else
  3244. result:='self'
  3245. else if (sym.typ=typesym) and
  3246. is_objc_class_or_protocol(ttypesym(sym).typedef) then
  3247. result:=tobjectdef(ttypesym(sym).typedef).objextname^
  3248. else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
  3249. (sym.typ=procsym) and
  3250. (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
  3251. begin
  3252. result:=tprocsym(sym).owner.name^+'__';
  3253. if manglename then
  3254. result := result + sym.name
  3255. else
  3256. result := result + symdebugname(sym);
  3257. end
  3258. else
  3259. begin
  3260. if manglename then
  3261. result := sym.name
  3262. else
  3263. result := symdebugname(sym);
  3264. end;
  3265. end;
  3266. procedure TDebugInfoDwarf.append_visibility(vis: tvisibility);
  3267. begin
  3268. case vis of
  3269. vis_hidden,
  3270. vis_private,
  3271. vis_strictprivate:
  3272. append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]);
  3273. vis_protected,
  3274. vis_strictprotected:
  3275. append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]);
  3276. vis_published,
  3277. vis_public:
  3278. { default };
  3279. vis_none:
  3280. internalerror(2019050720);
  3281. end;
  3282. end;
  3283. procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
  3284. var
  3285. currfileinfo,
  3286. lastfileinfo : tfileposinfo;
  3287. currfuncname : pshortstring;
  3288. currstatement: boolean;
  3289. currsectype : TAsmSectiontype;
  3290. hp, hpend : tai;
  3291. infile : tinputfile;
  3292. prevcolumn,
  3293. diffline,
  3294. prevline,
  3295. prevfileidx,
  3296. currfileidx,
  3297. nolineinfolevel : Integer;
  3298. prevlabel,
  3299. currlabel : tasmlabel;
  3300. begin
  3301. {$ifdef OMFOBJSUPPORT}
  3302. if ds_dwarf_omf_linnum in current_settings.debugswitches then
  3303. dbgcodeview.InsertLineInfo_OMF_LINNUM_MsLink(list);
  3304. {$endif OMFOBJSUPPORT}
  3305. { this function will always terminate the lineinfo block }
  3306. generated_lineinfo := true;
  3307. { if this unit only contains code without debug info (implicit init
  3308. or final etc), make sure the file table contains at least one entry
  3309. (the main source of the unit), because normally this table gets
  3310. populated via calls to get_file_index and that won't happen in this
  3311. case }
  3312. get_file_index(current_module.sourcefiles.get_file(1));
  3313. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  3314. currfuncname:=nil;
  3315. currsectype:=sec_code;
  3316. hp:=Tai(list.first);
  3317. currstatement:=true;
  3318. prevcolumn := 0;
  3319. prevline := 1;
  3320. prevfileidx := 1;
  3321. prevlabel := nil;
  3322. nolineinfolevel:=0;
  3323. while assigned(hp) do
  3324. begin
  3325. case hp.typ of
  3326. ait_section :
  3327. currsectype:=tai_section(hp).sectype;
  3328. ait_function_name :
  3329. begin
  3330. currfuncname:=tai_function_name(hp).funcname;
  3331. asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
  3332. end;
  3333. ait_force_line :
  3334. begin
  3335. lastfileinfo.line:=-1;
  3336. end;
  3337. ait_marker :
  3338. begin
  3339. case tai_marker(hp).kind of
  3340. mark_NoLineInfoStart:
  3341. inc(nolineinfolevel);
  3342. mark_NoLineInfoEnd:
  3343. dec(nolineinfolevel);
  3344. else
  3345. ;
  3346. end;
  3347. end;
  3348. else
  3349. ;
  3350. end;
  3351. if (currsectype=sec_code) and
  3352. (hp.typ=ait_instruction) then
  3353. begin
  3354. currfileinfo:=tailineinfo(hp).fileinfo;
  3355. { file changed ? (must be before line info) }
  3356. if (currfileinfo.fileindex<>0) and
  3357. ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
  3358. (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
  3359. begin
  3360. infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
  3361. if assigned(infile) then
  3362. begin
  3363. currfileidx := get_file_index(infile);
  3364. if prevfileidx <> currfileidx then
  3365. begin
  3366. list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path)), hp);
  3367. list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name)), hp);
  3368. list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp);
  3369. { set file }
  3370. asmline.concat(tai_comment.Create(strpnew('path: '+infile.path)));
  3371. asmline.concat(tai_comment.Create(strpnew('file: '+infile.name)));
  3372. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  3373. asmline.concat(tai_const.create_uleb128bit(currfileidx));
  3374. prevfileidx := currfileidx;
  3375. end;
  3376. { force new line info }
  3377. lastfileinfo.line:=-1;
  3378. end;
  3379. end;
  3380. { Set the line-nr to 0 if the code does not corresponds to a particular line }
  3381. if nolineinfolevel>0 then
  3382. currfileinfo.line := 0;
  3383. { line changed ? }
  3384. if (lastfileinfo.line<>currfileinfo.line) and ((currfileinfo.line<>0) or (nolineinfolevel>0)) then
  3385. begin
  3386. { set address }
  3387. current_asmdata.getlabel(currlabel, alt_dbgline);
  3388. list.insertbefore(tai_label.create(currlabel), hp);
  3389. asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']')));
  3390. if (prevlabel = nil) or
  3391. { darwin's assembler cannot create an uleb128 of the difference
  3392. between to symbols
  3393. same goes for Solaris native assembler
  3394. ... and riscv }
  3395. (target_info.system in systems_darwin+[system_riscv32_linux,system_riscv64_linux,
  3396. system_riscv32_embedded,system_riscv64_embedded]) or
  3397. (target_asm.id=as_solaris_as) then
  3398. begin
  3399. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  3400. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  3401. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  3402. asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel));
  3403. {$ifdef i8086}
  3404. { on i8086 we also emit an Open Watcom-specific 'set segment' op }
  3405. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  3406. asmline.concat(tai_const.create_uleb128bit(3));
  3407. asmline.concat(tai_const.create_8bit(DW_LNE_set_segment));
  3408. asmline.concat(tai_const.Create_seg_name(currlabel.Name));
  3409. {$endif i8086}
  3410. end
  3411. else
  3412. begin
  3413. asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc));
  3414. asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel));
  3415. end;
  3416. prevlabel := currlabel;
  3417. { set column }
  3418. if prevcolumn <> currfileinfo.column then
  3419. begin
  3420. asmline.concat(tai_const.create_8bit(DW_LNS_set_column));
  3421. asmline.concat(tai_const.create_uleb128bit(currfileinfo.column));
  3422. prevcolumn := currfileinfo.column;
  3423. end;
  3424. { set statement }
  3425. if (currfileinfo.line=0) and currstatement then
  3426. begin
  3427. currstatement := false;
  3428. asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt));
  3429. end;
  3430. if not currstatement and (currfileinfo.line>0) then
  3431. begin
  3432. currstatement := true;
  3433. asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt));
  3434. end;
  3435. { set line }
  3436. diffline := currfileinfo.line - prevline;
  3437. if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then
  3438. begin
  3439. { use special opcode, this also adds a row }
  3440. asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE));
  3441. end
  3442. else
  3443. begin
  3444. if diffline <> 0 then
  3445. begin
  3446. asmline.concat(tai_const.create_8bit(DW_LNS_advance_line));
  3447. asmline.concat(tai_const.create_sleb128bit(diffline));
  3448. end;
  3449. { no row added yet, do it manually }
  3450. asmline.concat(tai_const.create_8bit(DW_LNS_copy));
  3451. end;
  3452. prevline := currfileinfo.line;
  3453. end;
  3454. lastfileinfo:=currfileinfo;
  3455. end;
  3456. hpend:=hp;
  3457. hp:=tai(hp.next);
  3458. end;
  3459. if assigned(hpend) then
  3460. begin
  3461. { set address for end (see appendix 3 of dwarf 2 specs) }
  3462. current_asmdata.getlabel(currlabel, alt_dbgline);
  3463. list.insertafter(tai_label.create(currlabel), hpend);
  3464. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  3465. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  3466. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  3467. asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel));
  3468. end;
  3469. { end sequence }
  3470. asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op));
  3471. asmline.concat(tai_const.Create_8bit(1));
  3472. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  3473. asmline.concat(tai_comment.Create(strpnew('###################')));
  3474. end;
  3475. procedure TDebugInfoDwarf.finish_lineinfo;
  3476. var
  3477. infile: tinputfile;
  3478. begin
  3479. { only needed if no line info at all has been generated }
  3480. if generated_lineinfo then
  3481. begin
  3482. { reset for next module compilation }
  3483. generated_lineinfo:=false;
  3484. exit;
  3485. end;
  3486. { at least the Darwin linker is annoyed if you do not }
  3487. { finish the lineinfo section, or if it doesn't }
  3488. { contain at least one file name and set_address }
  3489. infile:=current_module.sourcefiles.get_file(1);
  3490. if not assigned(infile) then
  3491. internalerror(2006020211);
  3492. asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
  3493. asmline.concat(tai_const.create_uleb128bit(get_file_index(infile)));
  3494. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  3495. asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
  3496. asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
  3497. asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,nil));
  3498. asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
  3499. asmline.concat(tai_const.Create_8bit(1));
  3500. asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
  3501. asmline.concat(tai_comment.Create(strpnew('###################')));
  3502. end;
  3503. procedure TDebugInfoDwarf.set_sym_dwarf_offset(sym: tsym;dwarf_offset: integer);
  3504. begin
  3505. { This is always done, also without the ds_dwarf_properties flag, so
  3506. that other units which are compiled with this flag can reference fields
  3507. in this unit. }
  3508. (sym as tcpufieldvarsym).dwarfoffset := DwarfOffset;
  3509. set_pending_dwarf_offset(sym, dwarf_offset);
  3510. end;
  3511. procedure TDebugInfoDwarf.set_def_dwarf_offset(def: tprocdef; dwarf_offset: integer);
  3512. begin
  3513. (def as tprocdef).dwarfoffset := dwarf_offset;
  3514. set_pending_dwarf_offset(def, dwarf_offset);
  3515. end;
  3516. procedure TDebugInfoDwarf.set_pending_dwarf_offset(def_or_sym: tobject;dwarf_offset: integer);
  3517. var
  3518. tci: TPendingOffsetConst;
  3519. hsi: PHashSetItem;
  3520. begin
  3521. if (ds_dwarf_properties in current_settings.debugswitches) then
  3522. begin
  3523. hsi := PendingOffsets.Find(@def_or_sym,SizeOf(hsi));
  3524. if Assigned(hsi) then
  3525. begin
  3526. tci := TPendingOffsetConst(hsi^.Data);
  3527. while Assigned(tci) do
  3528. begin
  3529. tci.tc.symofs := dwarf_offset;
  3530. tci.tc.value := dwarf_offset;
  3531. tci := tci.next;
  3532. end;
  3533. PendingOffsets.Remove(hsi);
  3534. end;
  3535. end;
  3536. end;
  3537. procedure TDebugInfoDwarf.append_to_al_dwarf_info(Item: TLinkedListItem; size: integer; list: TAsmList);
  3538. begin
  3539. if list = nil then
  3540. list := current_asmdata.asmlists[al_dwarf_info];
  3541. list.Concat(Item);
  3542. Inc(DwarfOffset, size);
  3543. end;
  3544. procedure TDebugInfoDwarf.ResetDwarfOffset;
  3545. begin
  3546. DwarfOffset := 0;
  3547. end;
  3548. procedure TDebugInfoDwarf.append_const_to_al_dwarf_info(Item: tai_const; list: TAsmList);
  3549. begin
  3550. append_to_al_dwarf_info(Item, Item.size, list);
  3551. end;
  3552. procedure TDebugInfoDwarf.append_realconst_to_al_dwarf_info(Item: tai_realconst; list: TAsmList = nil);
  3553. begin
  3554. append_to_al_dwarf_info(Item, Item.datasize, list);
  3555. end;
  3556. procedure TDebugInfoDwarf.append_offsetentry_ref(attr: tdwarf_attribute;def_or_sym: tobject; dwarf_offset: Integer; anchorlabel: TAsmSymbol);
  3557. var
  3558. tci: TPendingOffsetConst;
  3559. tc: tai_const;
  3560. hsi: PHashSetItem;
  3561. begin
  3562. AddConstToAbbrev(ord(attr));
  3563. { ToDo Dwarf64! }
  3564. AddConstToAbbrev(ord(DW_FORM_ref4));
  3565. tc := tai_const.Create_rel_sym_offset(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype), anchorlabel, dwarf_offset);
  3566. if dwarf_offset = -1 then
  3567. begin
  3568. hsi := PendingOffsets.FindOrAdd(@def_or_sym, SizeOf(def_or_sym));
  3569. { In this case the debug-info for the referenced member has not been
  3570. written yet. Add an element to hold the offset that could be filled
  3571. later. }
  3572. tci := TPendingOffsetConst.Create;
  3573. tci.tc := tc;
  3574. tci.next := TPendingOffsetConst(hsi^.Data);
  3575. hsi^.Data := tci;
  3576. end;
  3577. append_const_to_al_dwarf_info(tc);
  3578. end;
  3579. {****************************************************************************
  3580. TDebugInfoDwarf2
  3581. ****************************************************************************}
  3582. procedure TDebugInfoDwarf2.appenddef_file(list:TAsmList;def: tfiledef);
  3583. begin
  3584. { gdb 6.4 doesn't support files so far so we use some fake recorddef
  3585. file recs. are less than 1k so using data2 is enough }
  3586. if assigned(def.typesym) then
  3587. append_entry(DW_TAG_structure_type,false,[
  3588. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  3589. DW_AT_byte_size,DW_FORM_udata,def.size
  3590. ])
  3591. else
  3592. append_entry(DW_TAG_structure_type,false,[
  3593. DW_AT_byte_size,DW_FORM_udata,def.size
  3594. ]);
  3595. finish_entry;
  3596. end;
  3597. procedure TDebugInfoDwarf2.appenddef_formal(list:TAsmList;def: tformaldef);
  3598. begin
  3599. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  3600. replace it with a unsigned type with size 0 (FK)
  3601. }
  3602. append_entry(DW_TAG_base_type,false,[
  3603. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  3604. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  3605. DW_AT_byte_size,DW_FORM_data1,0
  3606. ]);
  3607. finish_entry;
  3608. end;
  3609. procedure TDebugInfoDwarf2.append_object_struct(def: tobjectdef; const objectname: PShortString);
  3610. var
  3611. lab: TAsmSymbol;
  3612. createlabel: boolean;
  3613. begin
  3614. createlabel := need_struct_def_lab(def);
  3615. if createlabel then
  3616. begin
  3617. lab := def_dwarf_class_struct_lab(def);
  3618. if not(tf_dwarf_only_local_labels in target_info.flags) then
  3619. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(lab,0))
  3620. else
  3621. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
  3622. ResetDwarfOffset;
  3623. end;
  3624. if assigned(objectname) then
  3625. append_entry(DW_TAG_class_type,true,[
  3626. DW_AT_name,DW_FORM_string,objectname^+#0,
  3627. DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
  3628. ])
  3629. else
  3630. append_entry(DW_TAG_class_type,true,[
  3631. DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
  3632. ]);
  3633. { Apple-specific tag that identifies it as an Objective-C class }
  3634. if (def.objecttype=odt_objcclass) then
  3635. append_attribute(DW_AT_APPLE_runtime_class,DW_FORM_data1,[DW_LANG_ObjC]);
  3636. finish_entry;
  3637. if assigned(def.childof) then
  3638. begin
  3639. append_entry(DW_TAG_inheritance,false,[
  3640. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  3641. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  3642. ]);
  3643. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  3644. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(0));
  3645. if (def.childof.dbg_state=dbg_state_unused) then
  3646. def.childof.dbg_state:=dbg_state_used;
  3647. append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def.childof));
  3648. finish_entry;
  3649. end;
  3650. if (oo_has_vmt in def.objectoptions) and
  3651. (not assigned(def.childof) or
  3652. not(oo_has_vmt in def.childof.objectoptions)) then
  3653. begin
  3654. { vmt field }
  3655. append_entry(DW_TAG_member,false,[
  3656. DW_AT_artificial,DW_FORM_flag,true,
  3657. DW_AT_name,DW_FORM_string,'_vptr$'+def.objname^+#0,
  3658. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(def.vmt_offset)
  3659. ]);
  3660. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  3661. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(def.vmt_offset));
  3662. { should be changed into a pointer to a function returning an }
  3663. { int and with TAG_unspecified_parameters }
  3664. if (voidpointertype.dbg_state=dbg_state_unused) then
  3665. voidpointertype.dbg_state:=dbg_state_used;
  3666. append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype));
  3667. finish_entry;
  3668. end;
  3669. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  3670. { Write the methods in the scope of the class/object, except for Objective-C. }
  3671. if is_objc_class_or_protocol(def) then
  3672. finish_children;
  3673. { don't write procdefs of externally defined classes, gcc doesn't
  3674. either (info is probably gotten from ObjC runtime) }
  3675. if not(oo_is_external in def.objectoptions) then
  3676. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
  3677. if not is_objc_class_or_protocol(def) then
  3678. finish_children;
  3679. end;
  3680. procedure TDebugInfoDwarf2.appenddef_object(list:TAsmList;def: tobjectdef);
  3681. begin
  3682. case def.objecttype of
  3683. odt_cppclass,
  3684. odt_object:
  3685. append_object_struct(def,def.objname);
  3686. odt_interfacecom,
  3687. odt_interfacecorba,
  3688. odt_dispinterface,
  3689. odt_helper,
  3690. odt_class:
  3691. begin
  3692. { implicit pointer }
  3693. append_entry(DW_TAG_pointer_type,false,[]);
  3694. append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def));
  3695. finish_entry;
  3696. append_object_struct(def,def.objname);
  3697. end;
  3698. odt_objcclass:
  3699. { Objective-C class: same as regular class, except for
  3700. a) Apple-specific tag that identifies it as an Objective-C class
  3701. b) use extname^ instead of objname
  3702. }
  3703. append_object_struct(def,def.objextname);
  3704. odt_objcprotocol:
  3705. begin
  3706. append_entry(DW_TAG_pointer_type,false,[]);
  3707. append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype));
  3708. finish_entry;
  3709. end;
  3710. else
  3711. internalerror(200602041);
  3712. end;
  3713. end;
  3714. procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean);
  3715. var
  3716. lab: tasmlabel;
  3717. begin
  3718. if force_tag_set or
  3719. (ds_dwarf_sets in current_settings.debugswitches) then
  3720. begin
  3721. { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types }
  3722. if assigned(def.typesym) then
  3723. append_entry(DW_TAG_set_type,false,[
  3724. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  3725. DW_AT_byte_size,DW_FORM_data2,def.size
  3726. ])
  3727. else
  3728. append_entry(DW_TAG_set_type,false,[
  3729. DW_AT_byte_size,DW_FORM_data2,def.size
  3730. ]);
  3731. if assigned(def.elementdef) then
  3732. begin
  3733. if not(tf_dwarf_only_local_labels in target_info.flags) then
  3734. current_asmdata.getglobaldatalabel(lab)
  3735. else
  3736. current_asmdata.getaddrlabel(lab);
  3737. append_labelentry_ref(DW_AT_type,lab);
  3738. finish_entry;
  3739. if lab.bind=AB_GLOBAL then
  3740. append_to_al_dwarf_info(tai_symbol.create_global(lab,0), 0)
  3741. else
  3742. append_to_al_dwarf_info(tai_symbol.create(lab,0), 0);
  3743. { Sets of e.g. [1..5] are actually stored as a set of [0..7],
  3744. so write the exact boundaries of the set here. Let's hope no
  3745. debugger ever rejects this because this "subrange" type can
  3746. actually have a larger range than the original one. }
  3747. append_entry(DW_TAG_subrange_type,false,[
  3748. DW_AT_lower_bound,DW_FORM_sdata,def.setbase,
  3749. DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue
  3750. ]);
  3751. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef))
  3752. end
  3753. end
  3754. else
  3755. begin
  3756. { gdb versions which don't support sets refuse to load the debug }
  3757. { info of modules that contain set tags }
  3758. if assigned(def.typesym) then
  3759. append_entry(DW_TAG_base_type,false,[
  3760. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  3761. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  3762. DW_AT_byte_size,DW_FORM_data2,def.size
  3763. ])
  3764. else
  3765. append_entry(DW_TAG_base_type,false,[
  3766. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  3767. DW_AT_byte_size,DW_FORM_data2,def.size
  3768. ]);
  3769. end;
  3770. finish_entry;
  3771. end;
  3772. procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
  3773. begin
  3774. appenddef_set_intern(list,def,false);
  3775. end;
  3776. procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef);
  3777. begin
  3778. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  3779. replace it with a unsigned type with size 0 (FK)
  3780. }
  3781. append_entry(DW_TAG_base_type,false,[
  3782. DW_AT_name,DW_FORM_string,'FormalDef'#0,
  3783. DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
  3784. DW_AT_byte_size,DW_FORM_data1,0
  3785. ]);
  3786. finish_entry;
  3787. end;
  3788. procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef);
  3789. begin
  3790. { variants aren't known to dwarf2 but writting tvardata should be enough }
  3791. if assigned(vardatadef) then
  3792. appenddef_record_named(list,trecorddef(vardatadef),'Variant');
  3793. end;
  3794. function TDebugInfoDwarf2.dwarf_version: Word;
  3795. begin
  3796. Result:=2;
  3797. end;
  3798. {****************************************************************************
  3799. TDebugInfoDwarf3
  3800. ****************************************************************************}
  3801. procedure TDebugInfoDwarf3.append_labelentry_addr_ref(sym : tasmsymbol);
  3802. begin
  3803. AddConstToAbbrev(ord(DW_FORM_ref_addr));
  3804. { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the
  3805. target platform, but on the used Dwarf-format (32 bit or 64 bit) for the current compilation section. }
  3806. if use_64bit_headers then
  3807. append_const_to_al_dwarf_info(tai_const.Create_type_sym(aitconst_64bit_unaligned,sym))
  3808. else
  3809. append_const_to_al_dwarf_info(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym));
  3810. end;
  3811. procedure TDebugInfoDwarf3.append_labelentry_addr_ref_offset(sym: tasmsymbol; offset: Int64);
  3812. begin
  3813. AddConstToAbbrev(ord(DW_FORM_ref_addr));
  3814. { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the
  3815. target platform, but on the used Dwarf-format (32 bit or 64 bit) for the current compilation section. }
  3816. if use_64bit_headers then
  3817. append_const_to_al_dwarf_info(tai_const.Create_type_sym_offset(aitconst_64bit_unaligned,sym,offset))
  3818. else
  3819. append_const_to_al_dwarf_info(tai_const.Create_type_sym_offset(aitconst_32bit_unaligned,sym,offset));
  3820. end;
  3821. procedure TDebugInfoDwarf3.appenddef_array(list: TAsmList; def: tarraydef);
  3822. begin
  3823. if not is_dynamic_array(def) then
  3824. begin
  3825. inherited appenddef_array(list,def);
  3826. exit;
  3827. end;
  3828. if assigned(def.typesym) then
  3829. append_entry(DW_TAG_array_type,true,[
  3830. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  3831. DW_AT_byte_stride,DW_FORM_udata,def.elesize,
  3832. DW_AT_data_location,DW_FORM_block1,2
  3833. ])
  3834. else
  3835. append_entry(DW_TAG_array_type,true,[
  3836. DW_AT_byte_stride,DW_FORM_udata,def.elesize,
  3837. DW_AT_data_location,DW_FORM_block1,2
  3838. ]);
  3839. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  3840. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3841. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
  3842. finish_entry;
  3843. { to simplify things, we don't write a multidimensional array here }
  3844. append_entry(DW_TAG_subrange_type,false,[
  3845. DW_AT_lower_bound,DW_FORM_udata,0,
  3846. DW_AT_upper_bound,DW_FORM_block1,14
  3847. ]);
  3848. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  3849. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3850. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_dup)));
  3851. { pointer = nil? }
  3852. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_bra)));
  3853. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(5));
  3854. { yes -> length = 0 }
  3855. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_const1s)));
  3856. append_const_to_al_dwarf_info(tai_const.create_8bit(byte(-1)));
  3857. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_skip)));
  3858. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(3));
  3859. { no -> load length }
  3860. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
  3861. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_minus)));
  3862. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3863. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
  3864. finish_entry;
  3865. finish_children;
  3866. end;
  3867. procedure tdebuginfodwarf3.appenddef_string(list: tasmlist; def: tstringdef);
  3868. procedure addstringdef(const name: shortstring; chardef: tdef; deref: boolean; lensize: aint);
  3869. var
  3870. upperopcodes: longint;
  3871. begin
  3872. { deref=true -> ansi/unicde/widestring; deref = false -> short/longstring }
  3873. if assigned(def.typesym) then
  3874. append_entry(DW_TAG_array_type,true,[
  3875. DW_AT_name,DW_FORM_string,name+#0,
  3876. DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
  3877. ])
  3878. else
  3879. append_entry(DW_TAG_array_type,true,[
  3880. DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
  3881. ]);
  3882. { in all cases we start with the address of the string }
  3883. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  3884. if deref then
  3885. begin
  3886. { ansi/unicode/widestring -> dereference the address of the string, and then
  3887. we point to address of the string
  3888. }
  3889. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3890. end
  3891. else
  3892. begin
  3893. { shortstring characters begin at string[1], so add one to the string's address }
  3894. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit0)+lensize));
  3895. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus)))
  3896. end;
  3897. { reference to the element type of the string }
  3898. append_labelentry_ref(DW_AT_type,def_dwarf_lab(chardef));
  3899. finish_entry;
  3900. { now the information about the length of the string }
  3901. if deref then
  3902. begin
  3903. if not (is_widestring(def) and (tf_winlikewidestring in target_info.flags)) then
  3904. upperopcodes:=13
  3905. else
  3906. upperopcodes:=16;
  3907. { lower bound is always 1, upper bound (length) needs to be calculated }
  3908. append_entry(DW_TAG_subrange_type,false,[
  3909. DW_AT_lower_bound,DW_FORM_udata,1,
  3910. DW_AT_upper_bound,DW_FORM_block1,upperopcodes
  3911. ]);
  3912. { high(string) is stored sizeof(sizeint) bytes before the string data }
  3913. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  3914. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3915. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_dup)));
  3916. { pointer = nil? }
  3917. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_bra)));
  3918. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(4));
  3919. { yes -> length = 0 }
  3920. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit0)));
  3921. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_skip)));
  3922. if upperopcodes=16 then
  3923. { skip the extra deref_size argument and the division by two of the length }
  3924. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(6))
  3925. else
  3926. append_const_to_al_dwarf_info(tai_const.create_16bit_unaligned(3));
  3927. { no -> load length }
  3928. if upperopcodes=16 then
  3929. { for Windows WideString the size is always a DWORD }
  3930. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit4)))
  3931. else
  3932. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
  3933. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_minus)));
  3934. if upperopcodes=16 then
  3935. begin
  3936. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref_size)));
  3937. append_const_to_al_dwarf_info(tai_const.create_8bit(4));
  3938. end
  3939. else
  3940. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  3941. { for widestrings, the length is specified in bytes, so divide by two }
  3942. if (upperopcodes=16) then
  3943. begin
  3944. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_lit1)));
  3945. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_shr)));
  3946. end;
  3947. end
  3948. else
  3949. begin
  3950. append_entry(DW_TAG_subrange_type,false,[
  3951. DW_AT_lower_bound,DW_FORM_udata,1,
  3952. DW_AT_upper_bound,DW_FORM_block1,3
  3953. ]);
  3954. { for shortstrings, the length is the first byte of the string }
  3955. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  3956. { load 1 byte }
  3957. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref_size)));
  3958. append_const_to_al_dwarf_info(tai_const.create_8bit(lensize));
  3959. end;
  3960. finish_entry;
  3961. finish_children;
  3962. end;
  3963. begin
  3964. if (ds_dwarf_cpp in current_settings.debugswitches) then
  3965. begin
  3966. // At least LLDB 6.0.0 does not like this implementation of string types.
  3967. // Call the inherited DWARF 2 implementation, which works fine.
  3968. inherited;
  3969. exit;
  3970. end;
  3971. case def.stringtype of
  3972. st_shortstring:
  3973. begin
  3974. addstringdef('ShortString',cansichartype,false,1);
  3975. end;
  3976. st_longstring:
  3977. begin
  3978. {$ifdef cpu64bitaddr}
  3979. addstringdef('LongString',cansichartype,false,8);
  3980. {$else cpu64bitaddr}
  3981. addstringdef('LongString',cansichartype,false,4);
  3982. {$endif cpu64bitaddr}
  3983. end;
  3984. st_ansistring:
  3985. begin
  3986. addstringdef('AnsiString',cansichartype,true,-1);
  3987. end;
  3988. st_unicodestring:
  3989. begin
  3990. addstringdef('UnicodeString',cwidechartype,true,-1);
  3991. end;
  3992. st_widestring:
  3993. begin
  3994. addstringdef('WideString',cwidechartype,true,-1)
  3995. end;
  3996. end;
  3997. end;
  3998. procedure TDebugInfoDwarf3.appenddef_file(list:TAsmList;def: tfiledef);
  3999. begin
  4000. if assigned(def.typesym) then
  4001. append_entry(DW_TAG_file_type,false,[
  4002. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
  4003. DW_AT_byte_size,DW_FORM_data2,def.size
  4004. ])
  4005. else
  4006. append_entry(DW_TAG_file_type,false,[
  4007. DW_AT_byte_size,DW_FORM_data2,def.size
  4008. ]);
  4009. if tfiledef(def).filetyp=ft_typed then
  4010. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef));
  4011. finish_entry;
  4012. end;
  4013. procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef);
  4014. begin
  4015. if (ds_dwarf_cpp in current_settings.debugswitches) then
  4016. begin
  4017. // Do not use DW_TAG_unspecified_type for C++ simulation.
  4018. // At least LLDB 3.9.0 crashes in such case.
  4019. // Call the inherited DWARF 2 implementation, which works fine.
  4020. inherited;
  4021. exit;
  4022. end;
  4023. append_entry(DW_TAG_unspecified_type,false,[]);
  4024. finish_entry;
  4025. end;
  4026. procedure TDebugInfoDwarf3.appenddef_object(list:TAsmList;def: tobjectdef);
  4027. procedure dostruct(tag: tdwarf_tag);
  4028. begin
  4029. if assigned(def.objname) then
  4030. append_entry(tag,true,[
  4031. DW_AT_name,DW_FORM_string,def.objrealname^+#0
  4032. ])
  4033. else
  4034. append_entry(DW_TAG_structure_type,true,[]);
  4035. append_attribute(DW_AT_byte_size,DW_FORM_udata,[tobjectsymtable(def.symtable).datasize]);
  4036. { an old style object and a cpp class are accessed directly, so we do not need DW_AT_allocated and DW_AT_data_location tags,
  4037. see issue #36017 }
  4038. if not(is_object(def) or is_cppclass(def)) then
  4039. begin
  4040. { The pointer to the class-structure is hidden. The debug-information
  4041. does not contain an implicit pointer, but the data-adress is dereferenced here.
  4042. In case of a nil-pointer, report the class as being unallocated.
  4043. }
  4044. append_block1(DW_AT_allocated,2);
  4045. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  4046. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  4047. append_block1(DW_AT_data_location,2);
  4048. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_push_object_address)));
  4049. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_deref)));
  4050. end;
  4051. finish_entry;
  4052. end;
  4053. procedure doimplicitpointer;
  4054. var
  4055. obj : tasmlabel;
  4056. begin
  4057. if not(tf_dwarf_only_local_labels in target_info.flags) then
  4058. current_asmdata.getglobaldatalabel(obj)
  4059. else
  4060. current_asmdata.getaddrlabel(obj);
  4061. { implicit pointer }
  4062. append_entry(DW_TAG_pointer_type,false,[]);
  4063. append_labelentry_ref(DW_AT_type,obj);
  4064. finish_entry;
  4065. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
  4066. end;
  4067. procedure doparent(isinterface: boolean);
  4068. begin
  4069. if not assigned(def.childof) then
  4070. exit;
  4071. if isinterface then
  4072. begin
  4073. append_entry(DW_TAG_inheritance,false,[]);
  4074. end
  4075. else
  4076. begin
  4077. append_entry(DW_TAG_inheritance,false,[
  4078. DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
  4079. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
  4080. ]);
  4081. append_const_to_al_dwarf_info(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  4082. append_const_to_al_dwarf_info(tai_const.create_uleb128bit(0));
  4083. end;
  4084. append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
  4085. finish_entry;
  4086. end;
  4087. var
  4088. n: integer;
  4089. begin
  4090. case def.objecttype of
  4091. odt_objcclass,
  4092. odt_objcprotocol:
  4093. begin
  4094. inherited;
  4095. exit
  4096. end;
  4097. odt_cppclass,
  4098. odt_object:
  4099. begin
  4100. dostruct(DW_TAG_structure_type);
  4101. doparent(false);
  4102. end;
  4103. odt_interfacecom,
  4104. odt_interfacecorba,
  4105. odt_dispinterface:
  4106. begin
  4107. dostruct(DW_TAG_interface_type);
  4108. doparent(true);
  4109. end;
  4110. odt_helper,
  4111. odt_class:
  4112. begin
  4113. //dostruct(DW_TAG_class_type);
  4114. //doparent(false);
  4115. append_entry(DW_TAG_pointer_type,false,[]);
  4116. append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def));
  4117. finish_entry;
  4118. append_object_struct(def,def.objrealname);
  4119. Exit;
  4120. end;
  4121. else
  4122. internalerror(200609171);
  4123. end;
  4124. { add implemented interfaces }
  4125. if assigned(def.ImplementedInterfaces) then
  4126. for n := 0 to def.ImplementedInterfaces.count-1 do
  4127. begin
  4128. append_entry(DW_TAG_inheritance,false,[]);
  4129. append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef));
  4130. finish_entry;
  4131. end;
  4132. { add members }
  4133. def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
  4134. finish_children;
  4135. end;
  4136. procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef);
  4137. begin
  4138. appenddef_set_intern(list,def,true);
  4139. end;
  4140. procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef);
  4141. begin
  4142. { ??? can a undefined def have a typename ? }
  4143. if assigned(def.typesym) then
  4144. append_entry(DW_TAG_unspecified_type,false,[
  4145. DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
  4146. ])
  4147. else
  4148. append_entry(DW_TAG_unspecified_type,false,[
  4149. ]);
  4150. finish_entry;
  4151. end;
  4152. procedure TDebugInfoDwarf3.appenddef_variant(list:TAsmList;def: tvariantdef);
  4153. const
  4154. VARIANTS: array[1..27] of record
  4155. Value: Word;
  4156. Name: String;
  4157. { some fields are only supported by some features }
  4158. features : tfeatures
  4159. end = (
  4160. (value:0; name:'';features: []),
  4161. (value:1; name:'';features: []),
  4162. (value:2; name:'VSMALLINT';features: []),
  4163. (value:3; name:'VINTEGER';features: []),
  4164. (value:4; name:'VSINGLE';features: [f_softfpu]),
  4165. (value:5; name:'VDOUBLE';features: [f_softfpu]),
  4166. (value:6; name:'VCURRENCY';features: [f_softfpu]),
  4167. (value:7; name:'VDATE';features: [f_softfpu]),
  4168. (value:8; name:'VOLESTR';features: []),
  4169. (value:9; name:'VDISPATCH';features: []),
  4170. (value:10; name:'VERROR';features: []),
  4171. (value:11; name:'VBOOLEAN';features: []),
  4172. (value:12; name:'';features: []),
  4173. (value:13; name:'VUNKNOWN';features: []),
  4174. (value:14; name:'';features: []),
  4175. (value:16; name:'VSHORTINT';features: []),
  4176. (value:17; name:'VBYTE';features: []),
  4177. (value:18; name:'VWORD';features: []),
  4178. (value:19; name:'VLONGWORD';features: []),
  4179. (value:20; name:'VINT64';features: []),
  4180. (value:21; name:'VQWORD';features: []),
  4181. (value:36; name:'VRECORD';features: []),
  4182. (value:$48; name:'';features: []),
  4183. (value:$100; name:'VSTRING';features: []),
  4184. (value:$101; name:'VANY';features: []),
  4185. (value:$2000; name:'VARRAY';features: []),
  4186. (value:$4000; name:'VPOINTER';features: [])
  4187. );
  4188. var
  4189. fs: tfieldvarsym;
  4190. lbl: tasmlabel;
  4191. idx: integer;
  4192. begin
  4193. { it could be done with DW_TAG_variant for the union part (if that info was available)
  4194. now we do it manually for variants (MWE) }
  4195. { struct }
  4196. append_entry(DW_TAG_structure_type,true,[
  4197. DW_AT_name,DW_FORM_string,'Variant'#0,
  4198. DW_AT_byte_size,DW_FORM_udata,vardatadef.size
  4199. ]);
  4200. finish_entry;
  4201. append_entry(DW_TAG_variant_part,true,[
  4202. ]);
  4203. current_asmdata.getaddrlabel(lbl);
  4204. append_labelentry_ref(DW_AT_discr,lbl);
  4205. finish_entry;
  4206. { discriminant }
  4207. fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE'));
  4208. if (fs = nil) or (fs.typ <> fieldvarsym) then
  4209. internalerror(200609271);
  4210. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0));
  4211. appendsym_fieldvar(list,fs);
  4212. { variants }
  4213. for idx := Low(VARIANTS) to High(VARIANTS) do
  4214. begin
  4215. if (features*VARIANTS[idx].features)=VARIANTS[idx].features then
  4216. begin
  4217. append_entry(DW_TAG_variant,true,[
  4218. DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value
  4219. ]);
  4220. finish_entry;
  4221. if VARIANTS[idx].name <> '' then
  4222. begin
  4223. fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name));
  4224. if (fs = nil) or (fs.typ <> fieldvarsym) then
  4225. internalerror(2006092702+idx);
  4226. appendsym_fieldvar(list,fs);
  4227. end;
  4228. finish_children; { variant }
  4229. end;
  4230. end;
  4231. finish_children; { variant part }
  4232. finish_children; { struct }
  4233. end;
  4234. function TDebugInfoDwarf3.dwarf_version: Word;
  4235. begin
  4236. Result:=3;
  4237. end;
  4238. function TDebugInfoDwarf3.symdebugname(sym: tsym): String;
  4239. begin
  4240. Result:=sym.realname;
  4241. end;
  4242. { TDebugInfoDwarf4 }
  4243. function TDebugInfoDwarf4.dwarf_version: Word;
  4244. begin
  4245. Result:=4;
  4246. end;
  4247. {****************************************************************************
  4248. ****************************************************************************}
  4249. const
  4250. dbg_dwarf2_info : tdbginfo =
  4251. (
  4252. id : dbg_dwarf2;
  4253. idtxt : 'DWARF2';
  4254. );
  4255. dbg_dwarf3_info : tdbginfo =
  4256. (
  4257. id : dbg_dwarf3;
  4258. idtxt : 'DWARF3';
  4259. );
  4260. dbg_dwarf4_info : tdbginfo =
  4261. (
  4262. id : dbg_dwarf4;
  4263. idtxt : 'DWARF4';
  4264. );
  4265. initialization
  4266. RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2);
  4267. RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3);
  4268. RegisterDebugInfo(dbg_dwarf4_info,TDebugInfoDwarf4);
  4269. end.