1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444 |
- {
- Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl
- This units contains support for DWARF debug info generation
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- {
- This units contains support for DWARF debug info generation.
- Currently a lot of code looks like being mergable with dbgstabs. This might
- change however when improved dwarf info is generated, so the stuff shouldn't be
- merged yet. (FK)
- The easiest way to debug dwarf debug info generation is the usage of
- readelf --debug-dump <executable>
- This works only with elf targets though.
- There is a similar utility called dwarfdump which is not elf-specific and
- which has been ported to most systems.
- }
- unit dbgdwarf;
- {$i fpcdefs.inc}
- interface
- uses
- cclasses,globtype,
- cgbase,
- aasmbase,aasmtai,aasmdata,
- symbase,symconst,symtype,symdef,symsym,
- finput,
- DbgBase, dbgdwarfconst;
- type
- {$ifdef avr}
- // re-map to larger types because of offsets required to distinguish different memory spaces
- puint = cardinal;
- pint = longint;
- {$endif avr}
- TDwarfFile = record
- Index: integer;
- Name: PChar;
- end;
- { flags for emitting variables/parameters }
- tdwarfvarsymflag =
- { force the sym to be emitted as a local variable regardless of its
- type; used for "absolute" local variables referring to parameters.
- }
- (dvf_force_local_var
- );
- tdwarfvarsymflags = set of tdwarfvarsymflag;
- pAbbrevSearchTreeItem = ^tAbbrevSearchTreeItem;
- tAbbrevSearchTreeItem = record
- value: QWord;
- Abbrev: longint;
- // When this item does not match the abbrev-value, look for it
- // in the next SearchItem
- SearchItem: pAbbrevSearchTreeItem;
- // Next and prior item of the abbrev-section
- NextItem: pAbbrevSearchTreeItem;
- PriorItem: pAbbrevSearchTreeItem;
- bit8: boolean;
- end;
- TDwarfHashSetItem = record
- HashSetItem: THashSetItem;
- lab, ref_lab: tasmsymbol;
- struct_lab: tasmsymbol;
- end;
- PDwarfHashSetItem = ^TDwarfHashSetItem;
- TDwarfLabHashSet = class(THashSet)
- class function SizeOfItem: Integer; override;
- end;
- { TDebugInfoDwarf }
- TDebugInfoDwarf = class(TDebugInfo)
- private
- currabbrevnumber : longint;
- { use this defs to create info for variants and file handles }
- { unused (MWE)
- filerecdef,
- textrecdef : tdef;
- }
- dirlist: TFPHashObjectList;
- filesequence: Integer;
- loclist: tdynamicarray;
- asmline: TAsmList;
- { lookup table for def -> DWARF-labels }
- dwarflabels: TDwarfLabHashSet;
- // The current entry in dwarf_info with the link to the abbrev-section
- dwarf_info_abbref_tai: tai_const;
- // Empty start-item of the abbrev-searchtree
- AbbrevSearchTree: pAbbrevSearchTreeItem;
- // The current abbrev-item
- CurrentSearchTreeItem: pAbbrevSearchTreeItem;
- // Is true when the abbrev-section is newly created
- NewAbbrev: boolean;
- procedure StartAbbrevSearch;
- procedure AddConstToAbbrev(Value: QWord; bit8:boolean=false);
- procedure StartAbbrevSectionFromSearchtree;
- procedure WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem);
- function FinishAbbrevSearch: longint;
- function def_dwarf_lab(def:tdef) : tasmsymbol;
- function def_dwarf_ref_lab(def:tdef) : tasmsymbol;
- function def_dwarf_class_struct_lab(def:tobjectdef) : tasmsymbol;
- function get_file_index(afile: tinputfile): Integer;
- function relative_dwarf_path(const s:tcmdstr):tcmdstr;
- protected
- // set if we should use 64bit headers (dwarf3 and up)
- _use_64bit_headers: Boolean;
- // set to ait_const32bit if use_64bit_headers is false, otherwise
- // to ait_const64bit
- offsetreltype,
- offsetabstype : taiconst_type;
- // set if we generated any lineinfo at all. If not, we have to terminate
- // when insertmoduleinfo is called.
- generated_lineinfo: boolean;
- vardatadef: trecorddef;
- procedure set_use_64bit_headers(state: boolean);
- property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers;
- function get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
- function is_fbreg(reg:tregister):boolean;
- { Convenience version of the method below, so the compiler creates the
- tvarrec for us (must only pass one element in the last parameter). }
- procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
- procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
- procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
- procedure append_block1(attr: tdwarf_attribute; size: aint);
- procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
- procedure append_labelentry_addr_ref(sym : tasmsymbol); virtual;
- procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
- procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
- procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
- procedure append_labelentry_dataptr_common(attr : tdwarf_attribute);
- procedure append_pointerclass(list:TAsmList;def:tpointerdef);
- procedure append_proc_frame_base(list:TAsmList;def:tprocdef);
- {$ifdef i8086}
- procedure append_seg_name(const name:string);
- procedure append_seg_reg(const segment_register:tregister);
- {$endif i8086}
- procedure beforeappenddef(list:TAsmList;def:tdef);override;
- procedure afterappenddef(list:TAsmList;def:tdef);override;
- procedure appenddef_ord(list:TAsmList;def:torddef);override;
- procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
- procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
- procedure appenddef_array(list:TAsmList;def:tarraydef);override;
- procedure appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring);
- procedure appenddef_record(list:TAsmList;def:trecorddef);override;
- procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
- procedure appenddef_string(list:TAsmList;def:tstringdef);override;
- procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
- procedure appendprocdef(list:TAsmList;def:tprocdef);override;
- function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
- procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
- procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags);
- { used for fields and properties mapped to fields }
- procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
- procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
- procedure beforeappendsym(list:TAsmList;sym:tsym);override;
- procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
- procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
- procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
- procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
- procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
- procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
- procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
- procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
- procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
- function symdebugname(sym:tsym): String; virtual;
- function symname(sym: tsym; manglename: boolean): String; virtual;
- procedure append_visibility(vis: tvisibility);
- procedure enum_membersyms_callback(p:TObject;arg:pointer);
- procedure finish_children;
- procedure finish_entry;
- procedure finish_lineinfo;
- public
- constructor Create;override;
- destructor Destroy;override;
- procedure insertmoduleinfo;override;
- procedure inserttypeinfo;override;
- procedure referencesections(list:TAsmList);override;
- procedure insertlineinfo(list:TAsmList);override;
- function dwarf_version: Word; virtual; abstract;
- end;
- { TDebugInfoDwarf2 }
- TDebugInfoDwarf2 = class(TDebugInfoDwarf)
- private
- protected
- procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean);
- procedure append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString);
- procedure appenddef_file(list:TAsmList;def:tfiledef); override;
- procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
- procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
- procedure appenddef_set(list:TAsmList;def:tsetdef); override;
- procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
- procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
- public
- function dwarf_version: Word; override;
- end;
- { TDebugInfoDwarf3 }
- TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
- private
- protected
- procedure append_labelentry_addr_ref(sym : tasmsymbol); override;
- procedure appenddef_array(list:TAsmList;def:tarraydef); override;
- procedure appenddef_string(list:TAsmList;def:tstringdef);override;
- procedure appenddef_file(list:TAsmList;def:tfiledef); override;
- procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
- procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
- procedure appenddef_set(list:TAsmList;def: tsetdef); override;
- procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
- procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
- function symdebugname(sym:tsym): String; override;
- public
- function dwarf_version: Word; override;
- end;
- TDebugInfoDwarf4 = class(TDebugInfoDwarf3)
- public
- function dwarf_version: Word; override;
- end;
- implementation
- uses
- sysutils,cutils,cfileutl,constexp,
- version,globals,verbose,systems,
- cpubase,cpuinfo,paramgr,
- fmodule,
- defutil,symtable,symcpu,ppu
- {$ifdef OMFOBJSUPPORT}
- ,dbgcodeview
- {$endif OMFOBJSUPPORT}
- ;
- const
- LINE_BASE = 1;
- OPCODE_BASE = 13;
- const
- DW_TAG_lo_user = $4080;
- DW_TAG_hi_user = $ffff;
- { Flag that tells whether entry has a child or not. }
- DW_children_no = 0;
- DW_children_yes = 1;
- const
- { Implementation-defined range start. }
- DW_AT_lo_user = $2000;
- { Implementation-defined range end. }
- DW_AT_hi_user = $3ff0;
- const
- { Implementation-defined range start. }
- DW_LANG_lo_user = $8000;
- { Implementation-defined range start. }
- DW_LANG_hi_user = $ffff;
- {$ifdef avr}
- // More space required to include memory type offset
- aitconst_ptr_unaligned = aitconst_32bit_unaligned;
- {$endif avr}
- type
- { Names and codes for macro information. }
- tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2,
- DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4,
- DW_MACINFO_vendor_ext := 255);
- const
- DW_ATE_lo_user = $80;
- DW_ATE_hi_user = $ff;
- type
- Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1
- );
- { Access attribute. }
- Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2,
- DW_ACCESS_private := 3);
- { Visibility. }
- Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2,
- DW_VIS_qualified := 3);
- { Virtuality. }
- Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1,
- DW_VIRTUALITY_pure_virtual := 2);
- { Case sensitivity. }
- Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1,
- DW_ID_down_case := 2,DW_ID_case_insensitive := 3
- );
- { Calling convention. }
- Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2,
- DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40, DW_CC_GNU_borland_fastcall_i386 := $41
- );
- const
- { Implementation-defined range start. }
- DW_OP_lo_user = $e0;
- { Implementation-defined range end. }
- DW_OP_hi_user = $ff;
- const
- DW_LNS_extended_op = $00;
- { next copied from cfidwarf, need to go to something shared }
- DW_LNS_copy = $01;
- DW_LNS_advance_pc = $02;
- DW_LNS_advance_line = $03;
- DW_LNS_set_file = $04;
- DW_LNS_set_column = $05;
- DW_LNS_negate_stmt = $06;
- DW_LNS_set_basic_block = $07;
- DW_LNS_const_add_pc = $08;
- DW_LNS_fixed_advance_pc = $09;
- DW_LNS_set_prologue_end = $0a;
- DW_LNS_set_epilogue_begin = $0b;
- DW_LNS_set_isa = $0c;
- DW_LNE_end_sequence = $01;
- DW_LNE_set_address = $02;
- DW_LNE_define_file = $03;
- { DW_LNE_set_segment is a non-standard Open Watcom extension. It might
- create conflicts with future versions of the DWARF standard. }
- DW_LNE_set_segment = $04;
- DW_LNE_lo_user = $80;
- DW_LNE_hi_user = $ff;
- type
- { TDirIndexItem }
- TDirIndexItem = class(TFPHashObject)
- private
- FFiles: TFPHashObjectList;
- public
- IndexNr : Integer;
- constructor Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
- destructor Destroy;override;
- property Files: TFPHashObjectList read FFiles;
- end;
- { TFileIndexItem }
- TFileIndexItem = class(TFPHashObject)
- private
- FDirIndex: Integer;
- public
- IndexNr : Integer;
- constructor Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
- property DirIndex: Integer read FDirIndex;
- end;
- {****************************************************************************
- procs
- ****************************************************************************}
- function DirListSortCompare(AItem1, AItem2: Pointer): Integer;
- begin
- Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr;
- end;
- function FileListSortCompare(AItem1, AItem2: Pointer): Integer;
- begin
- Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr;
- end;
- function AllocateNewAiSearchItem: pAbbrevSearchTreeItem;
- begin
- new(result);
- FillChar(result^,sizeof(result^),#0);
- end;
- procedure FreeSearchItem(SI: pAbbrevSearchTreeItem);
- begin
- if assigned(SI^.NextItem) then
- FreeSearchItem(SI^.NextItem);
- if assigned(SI^.SearchItem) then
- FreeSearchItem(SI^.SearchItem);
- Dispose(SI);
- end;
- {****************************************************************************
- TDwarfLabHashSet
- ****************************************************************************}
- class function TDwarfLabHashSet.SizeOfItem: Integer;
- begin
- Result:=sizeof(TDwarfHashSetItem);
- end;
- {****************************************************************************
- TDirIndexItem
- ****************************************************************************}
- constructor TDirIndexItem.Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer);
- begin
- inherited Create(AList,AName);
- FFiles := TFPHashObjectList.Create;
- IndexNr := AIndex;
- end;
- destructor TDirIndexItem.Destroy;
- begin
- FFiles.Free;
- inherited Destroy;
- end;
- {****************************************************************************
- TFileIndexItem
- ****************************************************************************}
- constructor TFileIndexItem.Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer);
- begin
- inherited Create(AList,Aname);
- FDirIndex := ADirIndex;
- IndexNr := AIndex;
- end;
- {****************************************************************************
- TDebugInfoDwarf
- ****************************************************************************}
- procedure TDebugInfoDwarf.StartAbbrevSearch;
- begin
- CurrentSearchTreeItem:=AbbrevSearchTree;
- end;
- procedure TDebugInfoDwarf.WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem);
- begin
- if SI^.bit8 then
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_8bit(SI^.value))
- else
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_uleb128bit(SI^.value));
- end;
- procedure TDebugInfoDwarf.StartAbbrevSectionFromSearchtree;
- procedure AddCurrentAndPriorItemsToAbrev(SI: pAbbrevSearchTreeItem);
- begin
- if assigned(SI^.PriorItem) then
- AddCurrentAndPriorItemsToAbrev(SI^.PriorItem);
- WriteSearchItemToAbbrevSection(SI);
- end;
- begin
- NewAbbrev:=true;
- inc(currabbrevnumber);
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber))));
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber));
- if CurrentSearchTreeItem<>AbbrevSearchTree then
- AddCurrentAndPriorItemsToAbrev(CurrentSearchTreeItem);
- end;
- function TDebugInfoDwarf.FinishAbbrevSearch: longint;
- procedure FinalizeAbbrevSection;
- begin
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
- CurrentSearchTreeItem^.Abbrev:=currabbrevnumber;
- NewAbbrev := false;
- end;
- begin
- if NewAbbrev then
- FinalizeAbbrevSection;
- result := CurrentSearchTreeItem^.Abbrev;
- if result=0 then
- begin
- // In this case the abbrev-section equals an existing longer abbrev section.
- // So a new abbrev-section has to be made which ends on the current
- // searchtree item
- StartAbbrevSectionFromSearchtree;
- FinalizeAbbrevSection;
- result := CurrentSearchTreeItem^.Abbrev;
- end;
- end;
- procedure TDebugInfoDwarf.AddConstToAbbrev(Value: QWord; bit8:boolean);
- procedure AddCurrentItemToAbbrev;
- begin
- CurrentSearchTreeItem^.value:=value;
- CurrentSearchTreeItem^.bit8:=bit8;
- WriteSearchItemToAbbrevSection(CurrentSearchTreeItem);
- end;
- var si: pAbbrevSearchTreeItem;
- begin
- // Instead of adding this value directly to the ai-tree, search if an
- // abbrev section with the same values already exist, and use the existing
- // one or create one.
- if NewAbbrev then
- begin
- // The current abbrev-section is new, so add the value to the abbrev-section
- // and add it to the search-list.
- CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem;
- CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem;
- CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem;
- AddCurrentItemToAbbrev;
- end
- else
- begin
- // Search for the value which is added in the next sections of the
- // searchtree for a match
- si := CurrentSearchTreeItem^.NextItem;
- while assigned(si) do
- begin
- if (SI^.value=Value) and (si^.bit8=bit8) then
- begin
- // If a match is found, set the current searchtree item to the next item
- CurrentSearchTreeItem:=SI;
- Exit;
- end
- else if si^.SearchItem=nil then
- begin
- // If no match is found, add a new item to the searchtree and write
- // a new abbrev-section.
- StartAbbrevSectionFromSearchtree;
- si^.SearchItem:=AllocateNewAiSearchItem;
- if currentsearchtreeitem<>AbbrevSearchTree then
- si^.SearchItem^.PriorItem:=CurrentSearchTreeItem;
- CurrentSearchTreeItem := si^.SearchItem;
- AddCurrentItemToAbbrev;
- Exit;
- end;
- Si := SI^.SearchItem;
- end;
- // The abbrev section we are looking for is longer than the one
- // which is already in the search-tree. So expand the searchtree with
- // the new value and write a new abbrev section
- StartAbbrevSectionFromSearchtree;
- CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem;
- if currentsearchtreeitem^.PriorItem<>AbbrevSearchTree then
- CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem;
- CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem;
- AddCurrentItemToAbbrev;
- end;
- end;
- function TDebugInfoDwarf.relative_dwarf_path(const s:tcmdstr):tcmdstr;
- begin
- { Make a clean path for gdb. Remove trailing / and ./ prefixes and
- use always a / }
- result:=BsToSlash(ExcludeTrailingPathDelimiter(ExtractRelativePath(GetCurrentDir,FixFileName(ExpandFileName(s)))));
- end;
- procedure TDebugInfoDwarf.set_use_64bit_headers(state: boolean);
- begin
- _use_64bit_headers:=state;
- if not(state) then
- begin
- if (target_info.system in systems_windows+systems_wince) then
- offsetabstype:=aitconst_secrel32_symbol
- else
- offsetabstype:=aitconst_32bit_unaligned;
- if (target_info.system in systems_darwin) then
- offsetreltype:=aitconst_darwin_dwarf_delta32
- else
- offsetreltype:=aitconst_32bit_unaligned;
- end
- else
- begin
- if (target_info.system in systems_darwin) then
- offsetreltype:=aitconst_darwin_dwarf_delta64
- else
- offsetreltype:=aitconst_64bit_unaligned;
- offsetabstype:=aitconst_64bit_unaligned;
- end;
- end;
- function TDebugInfoDwarf.get_def_dwarf_labs(def:tdef): PDwarfHashSetItem;
- var
- needstructdeflab: boolean;
- begin
- { Keep track of used dwarf entries, this info is only useful for dwarf entries
- referenced by the symbols. Definitions will always include all
- required stabs }
- if def.dbg_state=dbg_state_unused then
- def.dbg_state:=dbg_state_used;
- { Need a new label? }
- result:=PDwarfHashSetItem(dwarflabels.FindOrAdd(@def,sizeof(def)));
- { the other fields besides Data are not initialised }
- if not assigned(result^.HashSetItem.Data) then
- begin
- { Mark as initialised }
- result^.HashSetItem.Data:=self;
- needstructdeflab:=is_implicit_pointer_object_type(def);
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- begin
- if (ds_dwarf_dbg_info_written in def.defstates) then
- begin
- if not assigned(def.typesym) then
- internalerror(200610011);
- result^.lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AT_METADATA);
- result^.ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AT_METADATA);
- if needstructdeflab then
- result^.struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AT_METADATA);
- def.dbg_state:=dbg_state_written;
- end
- else
- begin
- { Create an exported DBG symbol if we are generating a def defined in the
- globalsymtable of the current unit }
- if assigned(def.typesym) and
- (def.owner.symtabletype=globalsymtable) and
- (def.owner.iscurrentunit) then
- begin
- result^.lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
- result^.ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
- if needstructdeflab then
- result^.struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym, true)),AB_GLOBAL,AT_METADATA,voidpointertype);
- include(def.defstates,ds_dwarf_dbg_info_written);
- end
- else
- begin
- { The pointer typecast is needed to prevent a problem with range checking
- on when the typecast is changed to 'as' }
- current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.lab)));
- current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.ref_lab)));
- if needstructdeflab then
- current_asmdata.getglobaldatalabel(TAsmLabel(pointer(result^.struct_lab)));
- end;
- end;
- end
- else
- begin
- { The pointer typecast is needed to prevent a problem with range checking
- on when the typecast is changed to 'as' }
- { addrlabel instead of datalabel because it must be a local one }
- current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.lab)));
- current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.ref_lab)));
- if needstructdeflab then
- current_asmdata.getaddrlabel(TAsmLabel(pointer(result^.struct_lab)));
- end;
- if def.dbg_state=dbg_state_used then
- deftowritelist.Add(def);
- defnumberlist.Add(def);
- end;
- end;
- function TDebugInfoDwarf.is_fbreg(reg: tregister): boolean;
- begin
- {$if defined(i8086)}
- result:=reg=NR_BP;
- {$elseif defined(wasm)}
- result:=reg=NR_LOCAL_FRAME_POINTER_REG;
- {$else}
- { always return false, because we don't emit DW_AT_frame_base attributes yet }
- result:=false;
- {$endif}
- end;
- function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol;
- begin
- result:=get_def_dwarf_labs(def)^.lab;
- end;
- function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tobjectdef): tasmsymbol;
- begin
- result:=get_def_dwarf_labs(def)^.struct_lab;
- end;
- function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol;
- begin
- result:=get_def_dwarf_labs(def)^.ref_lab;
- end;
- constructor TDebugInfoDwarf.Create;
- begin
- inherited Create;
- { 64bit headers are only supported for dwarf3 and up, so default off }
- use_64bit_headers := false;
- { we haven't generated any lineinfo yet }
- generated_lineinfo := false;
- dirlist := TFPHashObjectList.Create;
- { add current dir as first item (index=0) }
- TDirIndexItem.Create(dirlist,'.', 0);
- asmline := TAsmList.create;
- loclist := tdynamicarray.Create(4096);
- AbbrevSearchTree:=AllocateNewAiSearchItem;
- vardatadef := nil;
- end;
- destructor TDebugInfoDwarf.Destroy;
- begin
- dirlist.Free;
- if assigned(AbbrevSearchTree) then
- FreeSearchItem(AbbrevSearchTree);
- dirlist := nil;
- asmline.free;
- asmline:=nil;
- loclist.Free;
- loclist := nil;
- inherited Destroy;
- end;
- procedure TDebugInfoDwarf.enum_membersyms_callback(p:TObject; arg: pointer);
- begin
- case tsym(p).typ of
- fieldvarsym:
- appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
- propertysym:
- appendsym_property(TAsmList(arg),tpropertysym(p));
- constsym:
- appendsym_const_member(TAsmList(arg),tconstsym(p),true);
- else
- ;
- end;
- end;
- function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer;
- var
- dirname: String;
- diritem: TDirIndexItem;
- diridx: Integer;
- fileitem: TFileIndexItem;
- begin
- if afile.path = '' then
- dirname := '.'
- else
- begin
- { add the canonical form here already to avoid problems with }
- { paths such as './' etc }
- dirname := relative_dwarf_path(afile.path);
- if dirname = '' then
- dirname := '.';
- end;
- diritem := TDirIndexItem(dirlist.Find(dirname));
- if diritem = nil then
- diritem := TDirIndexItem.Create(dirlist,dirname, dirlist.Count);
- diridx := diritem.IndexNr;
- fileitem := TFileIndexItem(diritem.files.Find(afile.name));
- if fileitem = nil then
- begin
- Inc(filesequence);
- fileitem := TFileIndexItem.Create(diritem.files,afile.name, diridx, filesequence);
- end;
- Result := fileitem.IndexNr;
- end;
- procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const);
- begin
- if length(values)<>1 then
- internalerror(2009040402);
- append_attribute(attr,form,values[0]);
- end;
- procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec);
- begin
- { attribute }
- AddConstToAbbrev(cardinal(attr));
- { form }
- AddConstToAbbrev(cardinal(form));
- { info itself }
- case form of
- DW_FORM_string:
- case value.VType of
- vtChar:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VChar));
- vtString:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VString^));
- vtAnsistring:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(Ansistring(value.VAnsiString)));
- else
- internalerror(200601264);
- end;
- DW_FORM_flag:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(value.VBoolean)));
- DW_FORM_data1:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^));
- else
- internalerror(200602143);
- end;
- DW_FORM_data2:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(value.VQWord^));
- else
- internalerror(200602144);
- end;
- DW_FORM_data4:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(value.VQWord^));
- else
- internalerror(200602145);
- end;
- DW_FORM_data8:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(value.VQWord^));
- else
- internalerror(200602146);
- end;
- DW_FORM_sdata:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VQWord^));
- else
- internalerror(200601285);
- end;
- DW_FORM_udata:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VQWord^));
- else
- internalerror(200601284);
- end;
- { block gets only the size, the rest is appended manually by the caller }
- DW_FORM_block1:
- case value.VType of
- vtInteger:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger));
- vtInt64:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^));
- vtQWord:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^));
- else
- internalerror(200602141);
- end;
- else
- internalerror(200601263);
- end;
- end;
- { writing the data through a few simply procedures allows to create easily extra information
- for debugging of debug info }
- procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const);
- var
- i : longint;
- begin
- { abbrev number }
- // Store the ai with the reference to the abbrev number and start a search
- // to find the right abbrev-section. (Or create one)
- dwarf_info_abbref_tai := tai_const.create_uleb128bit(currabbrevnumber);
- current_asmdata.asmlists[al_dwarf_info].concat(dwarf_info_abbref_tai);
- StartAbbrevSearch;
- { tag }
- AddConstToAbbrev(ord(tag));
- { children? }
- AddConstToAbbrev(ord(has_children),true);
- i:=0;
- while i<=high(data) do
- begin
- if (i+2 > high(data)) then
- internalerror(2009040401);
- if data[i].VType<>vtInteger then
- internalerror(200601261);
- if data[i+1].VType<>vtInteger then
- internalerror(2006012602);
- append_attribute(tdwarf_attribute(data[i].VInteger),tdwarf_form(data[i+1].VInteger),data[i+2]);
- inc(i,3);
- end;
- end;
- procedure TDebugInfoDwarf.append_block1(attr: tdwarf_attribute; size: aint);
- begin
- AddConstToAbbrev(ord(attr));
- AddConstToAbbrev(ord(DW_FORM_block1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(size));
- end;
- procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol);
- begin
- AddConstToAbbrev(ord(attr));
- AddConstToAbbrev(ord(DW_FORM_addr));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_ptr_unaligned,sym));
- end;
- procedure TDebugInfoDwarf.append_labelentry_addr_ref(sym : tasmsymbol);
- begin
- AddConstToAbbrev(ord(DW_FORM_ref_addr));
- {$ifdef i8086}
- { DW_FORM_ref_addr is treated as 32-bit by Open Watcom on i8086 }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym));
- {$else i8086}
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(aitconst_ptr_unaligned,sym));
- {$endif i8086}
- end;
- procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol);
- begin
- AddConstToAbbrev(ord(attr));
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- append_labelentry_addr_ref(sym)
- else
- begin
- if use_64bit_headers then
- AddConstToAbbrev(ord(DW_FORM_ref8))
- else
- AddConstToAbbrev(ord(DW_FORM_ref4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype),sym));
- end;
- end;
- procedure TDebugInfoDwarf.append_labelentry_dataptr_common(attr : tdwarf_attribute);
- begin
- AddConstToAbbrev(ord(attr));
- if use_64bit_headers then
- AddConstToAbbrev(ord(DW_FORM_data8))
- else
- AddConstToAbbrev(ord(DW_FORM_data4));
- end;
- procedure TDebugInfoDwarf.append_pointerclass(list: TAsmList;
- def: tpointerdef);
- begin
- {$ifdef i8086}
- case tcpupointerdef(def).x86pointertyp of
- x86pt_near,
- { todo: is there a way to specify these somehow? }
- x86pt_near_cs,x86pt_near_ds,x86pt_near_ss,
- x86pt_near_es,x86pt_near_fs,x86pt_near_gs:
- append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_near16]);
- x86pt_far:
- append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16]);
- x86pt_huge:
- append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_huge16]);
- end;
- {$else i8086}
- { Theoretically, we could do this, but it might upset some debuggers, }
- { even though it's part of the DWARF standard. }
- { append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]); }
- {$endif i8086}
- end;
- procedure TDebugInfoDwarf.append_proc_frame_base(list: TAsmList;
- def: tprocdef);
- {$ifdef i8086}
- var
- dreg: longint;
- blocksize: longint;
- templist: TAsmList;
- begin
- dreg:=dwarf_reg(NR_BP);
- templist:=TAsmList.create;
- if dreg<=31 then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg));
- blocksize:=1;
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- end;
- append_block1(DW_AT_frame_base,blocksize);
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- templist.free;
- end;
- {$else i8086}
- begin
- { problem: base reg isn't known here
- DW_AT_frame_base,DW_FORM_block1,1
- }
- end;
- {$endif i8086}
- {$ifdef i8086}
- procedure TDebugInfoDwarf.append_seg_name(const name:string);
- begin
- append_block1(DW_AT_segment,3);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_const2u)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_seg_name(name));
- end;
- procedure TDebugInfoDwarf.append_seg_reg(const segment_register: tregister);
- var
- dreg: longint;
- blocksize: longint;
- templist: TAsmList;
- begin
- dreg:=dwarf_reg(segment_register);
- templist:=TAsmList.create;
- if dreg<=31 then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_reg0)+dreg));
- blocksize:=1;
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- end;
- append_block1(DW_AT_segment,blocksize);
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- templist.free;
- end;
- {$endif i8086}
- procedure TDebugInfoDwarf.append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol);
- begin
- {
- used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
- The size of these depend on the header format
- Must be relative to another symbol on tf_dwarf_relative_addresses
- targets
- }
- if (tf_dwarf_relative_addresses in target_info.flags) then
- { use append_labelentry_dataptr_rel instead }
- internalerror(2007020210);
- append_labelentry_dataptr_common(attr);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,sym))
- end;
- procedure TDebugInfoDwarf.append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol);
- begin
- {
- used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN
- The size of these depend on the header format
- Must be relative to another symbol on tf_dwarf_relative_addresses
- targets
- }
- append_labelentry_dataptr_common(attr);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,sym,endsym));
- end;
- procedure TDebugInfoDwarf.finish_entry;
- begin
- dwarf_info_abbref_tai.value:=FinishAbbrevSearch;
- end;
- procedure TDebugInfoDwarf.finish_children;
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
- end;
- procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef);
- var
- basedef : tdef;
- sign : tdwarf_type;
- signform : tdwarf_form;
- fullbytesize : byte;
- ordtype : tordtype;
- begin
- ordtype:=def.ordtype;
- if ordtype=customint then
- ordtype:=range_to_basetype(def.low,def.high);
- case ordtype of
- s8bit,
- s16bit,
- s32bit,
- u8bit,
- u16bit,
- u32bit :
- begin
- { generate proper signed/unsigned info for types like 0..3 }
- { these are s8bit, but should be identified as unsigned }
- { because otherwise they are interpreted wrongly when used }
- { in a bitpacked record }
- if (def.low<0) then
- begin
- sign:=DW_ATE_signed;
- signform:=DW_FORM_sdata
- end
- else
- begin
- sign:=DW_ATE_unsigned;
- signform:=DW_FORM_udata
- end;
- fullbytesize:=def.size;
- case fullbytesize of
- 1:
- if (sign=DW_ATE_signed) then
- basedef:=s8inttype
- else
- basedef:=u8inttype;
- 2:
- if (sign=DW_ATE_signed) then
- basedef:=s16inttype
- else
- basedef:=u16inttype;
- 3,4:
- if (sign=DW_ATE_signed) then
- basedef:=s32inttype
- else
- basedef:=u32inttype;
- else
- internalerror(2008032201);
- end;
- if (def.low=torddef(basedef).low) and
- (def.high=torddef(basedef).high) then
- { base type such as byte/shortint/word/... }
- if assigned(def.typesym) then
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_encoding,DW_FORM_data1,sign,
- DW_AT_byte_size,DW_FORM_data1,fullbytesize])
- else
- append_entry(DW_TAG_base_type,false,[
- DW_AT_encoding,DW_FORM_data1,sign,
- DW_AT_byte_size,DW_FORM_data1,fullbytesize])
- else
- begin
- { subrange type }
- { note: don't do this 64 bit int types, they appear }
- { to be always clipped to s32bit for some reason }
- if assigned(def.typesym) then
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_lower_bound,signform,int64(def.low),
- DW_AT_upper_bound,signform,int64(def.high)
- ])
- else
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,signform,int64(def.low),
- DW_AT_upper_bound,signform,int64(def.high)
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef));
- end;
- finish_entry;
- end;
- uvoid :
- begin
- { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
- replace it with a unsigned type with size 0 (FK)
- }
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Void'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data1,0
- ]);
- finish_entry;
- end;
- uchar :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Char'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
- DW_AT_byte_size,DW_FORM_data1,1
- ]);
- finish_entry;
- end;
- uwidechar :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'WideChar'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char,
- DW_AT_byte_size,DW_FORM_data1,2
- ]);
- finish_entry;
- end;
- pasbool1 :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Boolean'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,1
- ]);
- finish_entry;
- end;
- pasbool8 :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Boolean8'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,1
- ]);
- finish_entry;
- end;
- bool8bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'ByteBool'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,1
- ]);
- finish_entry;
- end;
- pasbool16 :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Boolean16'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,2
- ]);
- finish_entry;
- end;
- bool16bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'WordBool'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,2
- ]);
- finish_entry;
- end;
- pasbool32 :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Boolean32'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,4
- ]);
- finish_entry;
- end;
- bool32bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'LongBool'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,4
- ]);
- finish_entry;
- end;
- pasbool64 :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Boolean64'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- finish_entry;
- end;
- bool64bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'QWordBool'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- finish_entry;
- end;
- u64bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'QWord'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- finish_entry;
- end;
- scurrency :
- begin
- { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Currency'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- finish_entry;
- end;
- s64bit :
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Int64'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- finish_entry;
- end;
- u128bit:
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Int128'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data1,16
- ]);
- finish_entry;
- end;
- s128bit:
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'Int128'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,16
- ]);
- finish_entry;
- end;
- else
- internalerror(200601287);
- end;
- end;
- procedure TDebugInfoDwarf.appenddef_float(list:TAsmList;def:tfloatdef);
- begin
- case def.floattype of
- s32real,
- s64real,
- s80real,
- sc80real:
- if assigned(def.typesym) then
- begin
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
- DW_AT_byte_size,DW_FORM_data1,def.size
- ]);
- if (def.floattype in [s80real,sc80real]) and
- (def.size<>10) then
- begin
- append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]);
- { "The bit offset attribute describes the offset in bits
- of the high order bit of a value of the given type
- from the high order bit of the storage unit used to
- contain that value." }
- if target_info.endian=endian_little then
- append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]);
- end;
- end
- else
- append_entry(DW_TAG_base_type,false,[
- DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
- DW_AT_byte_size,DW_FORM_data1,def.size
- ]);
- s64currency:
- { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) }
- if assigned(def.typesym) then
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ])
- else
- append_entry(DW_TAG_base_type,false,[
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- s64comp:
- if assigned(def.typesym) then
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ])
- else
- append_entry(DW_TAG_base_type,false,[
- DW_AT_encoding,DW_FORM_data1,DW_ATE_signed,
- DW_AT_byte_size,DW_FORM_data1,8
- ]);
- else
- internalerror(200601289);
- end;
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef);
- var
- hp : tenumsym;
- i : integer;
- begin
- if assigned(def.typesym) then
- append_entry(DW_TAG_enumeration_type,true,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_size,DW_FORM_data1,def.size
- ])
- else
- append_entry(DW_TAG_enumeration_type,true,[
- DW_AT_byte_size,DW_FORM_data1,def.size
- ]);
- if assigned(def.basedef) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef));
- finish_entry;
- { write enum symbols }
- for i := 0 to def.symtable.SymList.Count - 1 do
- begin
- hp:=tenumsym(def.symtable.SymList[i]);
- if hp.value<def.minval then
- continue
- else
- if hp.value>def.maxval then
- break;
- append_entry(DW_TAG_enumerator,false,[
- DW_AT_name,DW_FORM_string,symname(hp, false)+#0,
- DW_AT_const_value,DW_FORM_data4,hp.value
- ]);
- finish_entry;
- end;
- finish_children;
- end;
- procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef);
- var
- size : PInt;
- elesize : PInt;
- elestrideattr : tdwarf_attribute;
- labsym: tasmlabel;
- begin
- if is_dynamic_array(def) then
- begin
- { It's a pointer to the actual array }
- current_asmdata.getaddrlabel(labsym);
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,labsym);
- finish_entry;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
- end;
- if not is_packed_array(def) then
- begin
- elestrideattr:=DW_AT_byte_stride;
- elesize:=def.elesize;
- end
- else
- begin
- elestrideattr:=DW_AT_stride_size;
- elesize:=def.elepackedbitsize;
- end;
- if is_special_array(def) then
- begin
- { no known size, no known upper bound }
- if assigned(def.typesym) then
- append_entry(DW_TAG_array_type,true,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- elestrideattr,DW_FORM_udata,elesize
- ])
- else
- append_entry(DW_TAG_array_type,true,[
- elestrideattr,DW_FORM_udata,elesize
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
- finish_entry;
- { a missing upper bound means "unknown"/default }
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_sdata,def.lowrange
- ]);
- end
- else
- begin
- size:=def.size;
- if assigned(def.typesym) then
- append_entry(DW_TAG_array_type,true,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_size,DW_FORM_udata,size,
- elestrideattr,DW_FORM_udata,elesize
- ])
- else
- append_entry(DW_TAG_array_type,true,[
- DW_AT_byte_size,DW_FORM_udata,size,
- elestrideattr,DW_FORM_udata,elesize
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
- finish_entry;
- { to simplify things, we don't write a multidimensional array here }
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_sdata,def.lowrange,
- DW_AT_upper_bound,DW_FORM_sdata,def.highrange
- ]);
- end;
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
- finish_entry;
- finish_children;
- end;
- procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef);
- begin
- if assigned(def.objname) then
- appenddef_record_named(list,def,def.objname^)
- else
- appenddef_record_named(list,def,'');
- end;
- procedure TDebugInfoDwarf.appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring);
- begin
- if (name<>'') then
- append_entry(DW_TAG_structure_type,true,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_byte_size,DW_FORM_udata,def.size
- ])
- else
- append_entry(DW_TAG_structure_type,true,[
- DW_AT_byte_size,DW_FORM_udata,def.size
- ]);
- finish_entry;
- def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
- { don't know whether external record declaration is allow but if it so then
- do the same as we do for other object types - skip procdef info generation
- for external defs (Paul Ishenin) }
- if not(oo_is_external in def.objectoptions) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
- finish_children;
- end;
- procedure TDebugInfoDwarf.appenddef_pointer(list:TAsmList;def:tpointerdef);
- begin
- append_entry(DW_TAG_pointer_type,false,[]);
- append_pointerclass(list,def);
- if not(is_voidpointer(def)) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointeddef));
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef);
- procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: asizeuint);
- var
- { maxlen can be > high(int64) }
- slen : asizeuint;
- arr : tasmlabel;
- begin
- { fix length of openshortstring }
- slen:=aword(def.len);
- if (slen=0) or
- (slen>maxlen) then
- slen:=maxlen;
- { create a structure with two elements }
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- current_asmdata.getglobaldatalabel(arr)
- else
- current_asmdata.getaddrlabel(arr);
- append_entry(DW_TAG_structure_type,true,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_byte_size,DW_FORM_udata,qword(lendef.size)+slen
- ]);
- finish_entry;
- { length entry }
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,'length'#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
- finish_entry;
- { string data entry }
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,'st'#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(lendef.size));
- append_labelentry_ref(DW_AT_type,arr);
- finish_entry;
- finish_children;
- { now the data array }
- if arr.bind=AB_GLOBAL then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(arr,0))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0));
- append_entry(DW_TAG_array_type,true,[
- DW_AT_byte_size,DW_FORM_udata,def.size,
- DW_AT_byte_stride,DW_FORM_udata,1
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype));
- finish_entry;
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_udata,1,
- DW_AT_upper_bound,DW_FORM_udata,qword(slen)
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef));
- finish_entry;
- finish_children;
- end;
- begin
- case def.stringtype of
- st_shortstring:
- begin
- addnormalstringdef('ShortString',u8inttype,255);
- end;
- st_longstring:
- begin
- { a) we don't actually support variables of this type currently
- b) this type is only used as the type for constant strings
- > 255 characters
- c) in such a case, gdb will allocate and initialise enough
- memory to hold the maximum size for such a string
- -> don't use high(qword)/high(cardinal) as maximum, since that
- will cause exhausting the VM space, but some "reasonably high"
- number that should be enough for most constant strings
- }
- {$ifdef cpu64bitaddr}
- addnormalstringdef('LongString',u64inttype,qword(1024*1024));
- {$endif cpu64bitaddr}
- {$ifdef cpu32bitaddr}
- addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
- {$endif cpu32bitaddr}
- {$ifdef cpu16bitaddr}
- addnormalstringdef('LongString',u16inttype,cardinal(1024));
- {$endif cpu16bitaddr}
- end;
- st_ansistring:
- begin
- { looks like a pchar }
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(cansichartype));
- finish_entry;
- end;
- st_unicodestring,
- st_widestring:
- begin
- { looks like a pwidechar }
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype));
- finish_entry;
- end;
- end;
- end;
- procedure TDebugInfoDwarf.appenddef_procvar(list:TAsmList;def:tprocvardef);
- procedure doappend;
- var
- i : longint;
- begin
- if assigned(def.typesym) then
- append_entry(DW_TAG_subroutine_type,true,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_prototyped,DW_FORM_flag,true
- ])
- else
- append_entry(DW_TAG_subroutine_type,true,[
- DW_AT_prototyped,DW_FORM_flag,true
- ]);
- if not(is_void(tprocvardef(def).returndef)) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef));
- finish_entry;
- { write parameters }
- for i:=0 to def.paras.count-1 do
- begin
- append_entry(DW_TAG_formal_parameter,false,[
- DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]), false)+#0
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
- finish_entry;
- end;
- finish_children;
- end;
- var
- proc : tasmlabel;
- begin
- if not def.is_addressonly then
- begin
- { create a structure with two elements }
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- current_asmdata.getglobaldatalabel(proc)
- else
- current_asmdata.getaddrlabel(proc);
- append_entry(DW_TAG_structure_type,true,[
- DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint)
- ]);
- finish_entry;
- { proc entry }
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,'Proc'#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
- append_labelentry_ref(DW_AT_type,proc);
- finish_entry;
- { self entry }
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,'Self'#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(pint))
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sizeof(pint)));
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject));
- finish_entry;
- finish_children;
- if proc.bind=AB_GLOBAL then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(proc,0))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0));
- doappend;
- end
- else
- doappend;
- end;
- procedure TDebugInfoDwarf.beforeappenddef(list:TAsmList;def:tdef);
- var
- labsym : tasmsymbol;
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename)));
- labsym:=def_dwarf_lab(def);
- case labsym.bind of
- AB_GLOBAL:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
- AB_LOCAL:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
- else
- internalerror(2013082001);
- end;
- { On Darwin, dwarf info is not linked in the final binary,
- but kept in the individual object files. This allows for
- faster linking, but means that you have to keep the object
- files for debugging and also that gdb only loads in the
- debug info of a particular object file once you step into
- or over a procedure in it.
- To solve this, there is a tool called dsymutil which can
- extract all the dwarf info from a program's object files.
- This utility however performs "smart linking" on the dwarf
- info and throws away all unreferenced dwarf entries. Since
- variables' types always point to the dwarfinfo for a tdef
- and never to that for a typesym, this means all debug
- entries generated for typesyms are thrown away.
- The problem with that is that we translate typesyms into
- DW_TAG_typedef, and gdb's dwarf-2 reader only makes types
- globally visibly if they are defined using a DW_TAG_typedef.
- So as a result, before running dsymutil types only become
- available once you stepped into/over a function in the object
- file where they are declared, and after running dsymutil they
- are all gone (printing variables still works because the
- tdef dwarf info is still available, but you cannot typecast
- anything outside the declaring units because the type names
- are not known there).
- The solution: if a tdef has an associated typesym, let the
- debug label for the tdef point to a DW_TAG_typedef instead
- of directly to the tdef itself. And don't write anything
- special for the typesym itself.
- Update: we now also do this for other platforms, because
- otherwise if you compile unit A without debug info and
- use one of its types in unit B, then no typedef will be
- generated and hence gdb will not be able to give a definition
- of the type.
- }
- if is_objc_class_or_protocol(def) then
- begin
- { for Objective-C classes, the typedef must refer to the
- struct itself, not to the pointer of the struct; Objective-C
- classes are not implicit pointers in Objective-C itself, only
- in FPC. So make the def label point to a pointer to the
- typedef, which in turn refers to the actual struct (for Delphi-
- style classes, the def points to the typedef, which refers to
- a pointer to the actual struct) }
- { implicit pointer }
- current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,labsym);
- finish_entry;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
- end;
- if assigned(def.typesym) and
- not(df_generic in def.defoptions) then
- begin
- current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym)));
- append_entry(DW_TAG_typedef,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
- ]);
- append_labelentry_ref(DW_AT_type,labsym);
- finish_entry;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
- end
- end;
- procedure TDebugInfoDwarf.afterappenddef(list:TAsmList;def:tdef);
- var
- labsym : tasmsymbol;
- begin
- { end of the symbol }
- labsym:=def_dwarf_lab(def);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol_end.Create(labsym));
- { create a derived reference type for pass-by-reference parameters }
- { (gdb doesn't support DW_AT_variable_parameter yet) }
- labsym:=def_dwarf_ref_lab(def);
- case labsym.bind of
- AB_GLOBAL:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0));
- AB_LOCAL:
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
- else
- internalerror(2013082002);
- end;
- append_entry(DW_TAG_reference_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appendprocdef(list:TAsmList; def:tprocdef);
- function dwarf_calling_convention(def: tprocdef): Tdwarf_calling_convention;
- begin
- case def.proccalloption of
- {$ifdef i386}
- pocall_register:
- result:=DW_CC_GNU_borland_fastcall_i386;
- {$else i386}
- pocall_register,
- {$endif i386}
- pocall_cdecl,
- pocall_stdcall,
- pocall_cppdecl,
- pocall_mwpascal:
- result:=DW_CC_normal;
- else
- result:=DW_CC_nocall;
- end
- end;
- var
- procendlabel : tasmlabel;
- procentry,s : string;
- cc : Tdwarf_calling_convention;
- st : tsymtable;
- vmtoffset : pint;
- in_currentunit : boolean;
- begin
- { only write debug info for procedures defined in the current module,
- except in case of methods (gcc-compatible)
- }
- in_currentunit:=def.in_currentunit;
- if not in_currentunit and
- not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
- exit;
- { happens for init procdef of units without init section }
- if in_currentunit and
- not assigned(def.procstarttai) then
- exit;
- if df_generic in def.defoptions then
- exit;
- { Procdefs are not handled by the regular def writing code, so
- dbg_state is not set/checked for them. Do it here. }
- if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then
- exit;
- defnumberlist.Add(def);
- { Write methods and only in the scope of their parent objectdefs. }
- if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- { this code can also work for nested procdefs, but is not yet
- activated for those because there is no clear advantage yet to
- limiting the scope of nested procedures to that of their parent,
- and it makes it impossible to set breakpoints in them by
- referring to their name. }
- st:=def.owner;
- while assigned(st.defowner) and
- (tdef(st.defowner).typ = procdef) do
- st:=tprocdef(st.defowner).owner;
- if assigned(st) and
- (tdef(st.defowner).dbg_state<>dbg_state_writing) then
- exit;
- end;
- def.dbg_state:=dbg_state_writing;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
- if not is_objc_class_or_protocol(def.struct) then
- append_entry(DW_TAG_subprogram,true,
- [DW_AT_name,DW_FORM_string,symname(def.procsym, false)+#0])
- else
- append_entry(DW_TAG_subprogram,true,
- [DW_AT_name,DW_FORM_string,def.mangledname+#0]);
- if (ds_dwarf_cpp in current_settings.debugswitches) and (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- { If C++ emulation is enabled, add DW_AT_linkage_name attribute for methods.
- LLDB uses it to display fully qualified method names.
- Add a simple C++ mangled name without params to achieve at least "Class::Method()"
- instead of just "Method" in LLDB. }
- s:=tabstractrecorddef(def.owner.defowner).objrealname^;
- procentry:=Format('_ZN%d%s', [Length(s), s]);
- s:=symname(def.procsym, false);
- procentry:=Format('%s%d%sEv'#0, [procentry, Length(s), s]);
- append_attribute(DW_AT_linkage_name,DW_FORM_string, [procentry]);
- end;
- append_proc_frame_base(list,def);
- { Append optional flags. }
- { All Pascal procedures are prototyped }
- append_attribute(DW_AT_prototyped,DW_FORM_flag,[true]);
- { Calling convention. }
- cc:=dwarf_calling_convention(def);
- if (cc<>DW_CC_normal) then
- append_attribute(DW_AT_calling_convention,DW_FORM_data1,[ord(cc)]);
- {$ifdef i8086}
- { Call model (near or far). Open Watcom compatible. }
- if tcpuprocdef(def).is_far then
- append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_far16])
- else
- append_attribute(DW_AT_address_class,DW_FORM_data1,[DW_ADDR_none]);
- {$endif i8086}
- { Externally visible. }
- if (po_global in def.procoptions) and
- (def.parast.symtablelevel<=normal_function_level) then
- append_attribute(DW_AT_external,DW_FORM_flag,[true]);
- { Abstract or virtual/overriding method. }
- if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and
- not is_objc_class_or_protocol(def.struct) and
- not is_objectpascal_helper(def.struct) then
- begin
- if not(po_abstractmethod in def.procoptions) then
- append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)])
- else
- append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_pure_virtual)]);
- { Element number in the vmt (needs to skip stuff coming before the
- actual method addresses in the vmt, so we use vmtmethodoffset()
- and then divide by sizeof(pint)). }
- vmtoffset:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber);
- append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[3+LengthUleb128(vmtoffset)]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_constu)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtoffset));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus)));
- end;
- { accessibility: public/private/protected }
- if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
- append_visibility(def.visibility);
- { Return type. }
- if not(is_void(tprocdef(def).returndef)) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
- { we can only write the start/end if this procedure is implemented in
- this module
- }
- if in_currentunit then
- begin
- { mark end of procedure }
- current_asmdata.getlabel(procendlabel,alt_dbgtype);
- current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
- if use_dotted_functions then
- procentry := '.' + def.mangledname
- else
- procentry := def.mangledname;
- {$ifdef i8086}
- append_seg_name(procentry);
- {$endif i8086}
- append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION));
- append_labelentry(DW_AT_high_pc,procendlabel);
- if not(target_info.system in systems_darwin) then
- begin
- current_asmdata.asmlists[al_dwarf_aranges].Concat(
- tai_const.create_type_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION)));
- {$ifdef i8086}
- { bits 16..31 of the offset }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
- { segment }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_seg_name(procentry));
- {$endif i8086}
- current_asmdata.asmlists[al_dwarf_aranges].Concat(
- tai_const.Create_rel_sym(aitconst_ptr_unaligned,current_asmdata.RefAsmSymbol(procentry,AT_FUNCTION),procendlabel));
- {$ifdef i8086}
- { bits 16..31 of length }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
- {$endif i8086}
- end;
- end;
- { Don't write the funcretsym explicitly, it's also in the
- localsymtable and/or parasymtable.
- }
- finish_entry;
- if assigned(def.parast) then
- begin
- { First insert self, because gdb uses the fact whether or not the
- first parameter of a method is artificial to distinguish static
- from regular methods. }
- { fortunately, self is the always the first parameter in the
- paralist, since it has the lowest paranr. Note that this is not
- true for Objective-C, but those methods are detected in
- another way (by reading the ObjC run time information) }
- write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras);
- end;
- { local type defs and vars should not be written
- inside the main proc }
- if in_currentunit and
- assigned(def.localst) and
- (def.localst.symtabletype=localsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
- { last write the types from this procdef }
- if assigned(def.parast) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
- { only try to write the localst if the routine is implemented here }
- if in_currentunit and
- assigned(def.localst) and
- (def.localst.symtabletype=localsymtable) then
- begin
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
- { Write nested procedures -- disabled, see scope check at the
- beginning; currently, these are still written in the global
- scope. }
- // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst);
- end;
- finish_children;
- end;
- function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
- var
- elesize : pint;
- currdef : tdef;
- indirection: boolean;
- begin
- result:=false;
- if not assigned(symlist) then
- exit;
- sym:=nil;
- offset:=0;
- currdef:=nil;
- indirection:=false;
- repeat
- case symlist^.sltype of
- sl_load:
- begin
- if assigned(sym) then
- internalerror(2009031203);
- if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
- { can't handle... }
- exit;
- sym:=tabstractvarsym(symlist^.sym);
- currdef:=tabstractvarsym(sym).vardef;
- if ((sym.typ=paravarsym) and
- paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then
- indirection:=true;
- end;
- sl_subscript:
- begin
- if not assigned(currdef) then
- internalerror(2009031301);
- if (symlist^.sym.typ<>fieldvarsym) then
- internalerror(2009031202);
- { can't handle offsets with indirections yet }
- if indirection then
- exit;
- if is_packed_record_or_object(currdef) then
- begin
- { can't calculate the address of a non-byte aligned field }
- if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then
- exit;
- inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8)
- end
- else
- inc(offset,tfieldvarsym(symlist^.sym).fieldoffset);
- currdef:=tfieldvarsym(symlist^.sym).vardef;
- end;
- sl_absolutetype,
- sl_typeconv:
- begin
- currdef:=symlist^.def;
- { ignore, these don't change the address }
- end;
- sl_vec:
- begin
- if not assigned(currdef) then
- internalerror(2009031201);
- { can't handle offsets with indirections yet }
- if indirection then
- exit;
- case currdef.typ of
- arraydef:
- begin
- if not is_packed_array(currdef) then
- elesize:=tarraydef(currdef).elesize
- else
- begin
- elesize:=tarraydef(currdef).elepackedbitsize;
- { can't calculate the address of a non-byte aligned element }
- if (elesize mod 8)<>0 then
- exit;
- elesize:=elesize div 8;
- end;
- inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
- currdef:=tarraydef(currdef).elementdef;
- end;
- stringdef:
- begin
- case tstringdef(currdef).stringtype of
- st_widestring,st_unicodestring:
- begin
- inc(offset,(symlist^.value.svalue-1)*2);
- currdef:=cwidechartype;
- end;
- st_shortstring:
- begin
- inc(offset,symlist^.value.svalue);
- currdef:=cansichartype;
- end;
- st_ansistring:
- begin
- inc(offset,symlist^.value.svalue-1);
- currdef:=cansichartype;
- end;
- else
- Internalerror(2022070502);
- end;
- end;
- else
- internalerror(2022070501);
- end;
- end;
- else
- internalerror(2009031403);
- end;
- symlist:=symlist^.next;
- until not assigned(symlist);
- if not assigned(sym) then
- internalerror(2009031205);
- result:=true;
- end;
- procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
- begin
- appendsym_var_with_name_type_offset(list,sym,symname(sym, false),sym.vardef,0,[]);
- end;
- procedure TDebugInfoDwarf.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags);
- var
- templist : TAsmList;
- blocksize,size_of_int : longint;
- tag : tdwarf_tag;
- has_high_reg : boolean;
- dreg,dreghigh : shortint;
- {$ifdef i8086}
- has_segment_sym_name : boolean=false;
- segment_sym_name : TSymStr='';
- segment_reg: TRegister=NR_NO;
- {$endif i8086}
- begin
- blocksize:=0;
- dreghigh:=0;
- { external symbols can't be resolved at link time, so we
- can't generate stabs for them
- not sure if this applies to dwarf as well (FK)
- }
- if vo_is_external in sym.varoptions then
- exit;
- { There is no space allocated for not referenced locals }
- if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
- exit;
- templist:=TAsmList.create;
- case sym.localloc.loc of
- LOC_REGISTER,
- LOC_CREGISTER,
- LOC_MMREGISTER,
- LOC_CMMREGISTER,
- LOC_FPUREGISTER,
- LOC_CFPUREGISTER :
- begin
- { dwarf_reg_no_error might return -1
- in case the register variable has been optimized out }
- dreg:=dwarf_reg_no_error(sym.localloc.register);
- has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO);
- if has_high_reg then
- dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi);
- if dreghigh=-1 then
- has_high_reg:=false;
- if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and
- (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) and (dreg>=0) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- templist.concat(tai_const.create_sleb128bit(0));
- blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(0);
- end
- else
- begin
- if has_high_reg then
- begin
- templist.concat(tai_comment.create(strpnew('high:low reg pair variable')));
- size_of_int:=sizeof(aint);
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
- templist.concat(tai_const.create_uleb128bit(size_of_int));
- blocksize:=blocksize+1+Lengthuleb128(size_of_int);
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreghigh));
- blocksize:=blocksize+1+Lengthuleb128(dreghigh);
- templist.concat(tai_const.create_8bit(ord(DW_OP_piece)));
- templist.concat(tai_const.create_uleb128bit(size_of_int));
- blocksize:=blocksize+1+Lengthuleb128(size_of_int);
- end
- else if (dreg>=0) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- blocksize:=1+Lengthuleb128(dreg);
- end;
- end;
- end;
- else
- begin
- case sym.typ of
- staticvarsym:
- begin
- if vo_is_thread_var in sym.varoptions then
- begin
- if tf_section_threadvars in target_info.flags then
- begin
- case sizeof(puint) of
- 2:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const2u)));
- 4:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const4u)));
- 8:
- templist.concat(tai_const.create_8bit(ord(DW_OP_const8u)));
- else
- Internalerror(2019100501);
- end;
- {$push}
- {$warn 6018 off} { Unreachable code due to compile time evaluation }
- templist.concat(tai_const.Create_type_name(aitconst_dtpoff,sym.mangledname,0));
- { so far, aitconst_dtpoff is solely 32 bit }
- if (sizeof(puint)=8) and (target_info.endian=endian_little) then
- templist.concat(tai_const.create_32bit(0));
- templist.concat(tai_const.create_8bit(ord(DW_OP_GNU_push_tls_address)));
- if (sizeof(puint)=8) and (target_info.endian=endian_big) then
- templist.concat(tai_const.create_32bit(0));
- {$pop}
- blocksize:=2+sizeof(puint);
- end
- else
- begin
- { TODO: !!! FIXME: dwarf for thread vars !!!}
- { This is only a minimal change to at least be able to get a value
- in only one thread is present PM 2014-11-21, like for stabs format }
- templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
- templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,
- offset+sizeof(pint)));
- blocksize:=1+sizeof(puint);
- end;
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
- templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset));
- blocksize:=1+sizeof(puint);
- {$ifdef i8086}
- segment_sym_name:=sym.mangledname;
- has_segment_sym_name:=true;
- {$endif i8086}
- end;
- end;
- paravarsym,
- localvarsym:
- begin
- { Happens when writing debug info for paras of procdefs not
- implemented in the current module. Can't add a general check
- for LOC_INVALID above, because staticvarsyms may also have it.
- }
- if sym.localloc.loc<> LOC_INVALID then
- begin
- if is_fbreg(sym.localloc.reference.base) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_fbreg)));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
- end
- else
- begin
- dreg:=dwarf_reg(sym.localloc.reference.base);
- if dreg<=31 then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthsleb128(sym.localloc.reference.offset+offset);
- end
- else
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
- templist.concat(tai_const.create_uleb128bit(dreg));
- templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
- blocksize:=1+Lengthuleb128(dreg)+LengthSleb128(sym.localloc.reference.offset+offset);
- end;
- end;
- {$ifdef i8086}
- segment_reg:=sym.localloc.reference.segment;
- {$endif i8086}
- {$ifndef gdb_supports_DW_AT_variable_parameter}
- { Parameters which are passed by reference. (var and the like)
- Hide the reference-pointer and dereference the pointer
- in the DW_AT_location block.
- }
- if (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) then
- begin
- templist.concat(tai_const.create_8bit(ord(DW_OP_deref)));
- inc(blocksize);
- end
- {$endif not gdb_supports_DW_AT_variable_parameter}
- end;
- end
- else
- internalerror(200601288);
- end;
- end;
- end;
- { function results must not be added to the parameter list,
- as they are not part of the signature of the function
- (gdb automatically adds them according to the ABI specifications
- when calling the function)
- }
- if (sym.typ=paravarsym) and
- not(dvf_force_local_var in flags) and
- not(vo_is_funcret in sym.varoptions) then
- tag:=DW_TAG_formal_parameter
- else
- tag:=DW_TAG_variable;
- { must be parasym of externally implemented procdef, but
- the parasymtable can con also contain e.g. absolutevarsyms
- -> check symtabletype}
- if (sym.owner.symtabletype=parasymtable) and
- (sym.localloc.loc=LOC_INVALID) then
- begin
- if (sym.owner.symtabletype<>parasymtable) then
- internalerror(2009101001);
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- ])
- end
- else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
- LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
- ((sym.owner.symtabletype = globalsymtable) or
- (sp_static in sym.symoptions) or
- (vo_is_public in sym.varoptions)) then
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- DW_AT_external,DW_FORM_flag,true,
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ])
- {$ifdef gdb_supports_DW_AT_variable_parameter}
- else if (sym.typ=paravarsym) and
- paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
- not(vo_has_local_copy in sym.varoptions) and
- not is_open_string(sym.vardef) then
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_variable_parameter,DW_FORM_flag,true,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ])
- {$endif gdb_supports_DW_AT_variable_parameter}
- else
- append_entry(tag,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ]);
- { append block data }
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- { Mark self as artificial for methods, because gdb uses the fact
- whether or not the first parameter of a method is artificial to
- distinguish regular from static methods (since there are no
- no vo_is_self parameters for static methods, we don't have to check
- that). }
- if (vo_is_self in sym.varoptions) then
- append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
- {$ifdef i8086}
- if has_segment_sym_name then
- append_seg_name(segment_sym_name)
- else if segment_reg<>NR_NO then
- append_seg_reg(segment_reg);
- {$endif i8086}
- templist.free;
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
- begin
- appendsym_var(list,sym);
- end;
- procedure TDebugInfoDwarf.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
- begin
- appendsym_var(list,sym);
- end;
- procedure TDebugInfoDwarf.appendsym_paravar(list:TAsmList;sym:tparavarsym);
- begin
- appendsym_var(list,sym);
- end;
- procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
- begin
- appendsym_fieldvar_with_name_offset(list,sym,symname(sym, false),sym.vardef,0);
- end;
- procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
- var
- bitoffset,
- fieldoffset,
- fieldnatsize: asizeint;
- begin
- if (sp_static in sym.symoptions) or
- (sym.visibility=vis_hidden) then
- exit;
- if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
- { only ordinals are bitpacked }
- not is_ordinal(sym.vardef) then
- begin
- { other kinds of fields can however also appear in a bitpacked }
- { record, and then their offset is also specified in bits rather }
- { than in bytes }
- if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
- fieldoffset:=sym.fieldoffset
- else
- fieldoffset:=sym.fieldoffset div 8;
- inc(fieldoffset,offset);
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
- ]);
- end
- else
- begin
- if (sym.vardef.packedbitsize > 255) then
- internalerror(2007061201);
- { we don't bitpack according to the ABI, but as close as }
- { possible, i.e., equivalent to gcc's }
- { __attribute__((__packed__)), which is also what gpc }
- { does. }
- fieldnatsize:=max(sizeof(pint),sym.vardef.size);
- fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
- inc(fieldoffset,offset);
- bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
- if (target_info.endian=endian_little) then
- bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- { gcc also generates both a bit and byte size attribute }
- { we don't support ordinals >= 256 bits }
- DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
- { nor >= 256 bits (not yet, anyway, see IE above) }
- DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
- { data1 and data2 are unsigned, bitoffset can also be negative }
- DW_AT_bit_offset,DW_FORM_data4,bitoffset,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
- ]);
- end;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
- if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
- append_visibility(sym.visibility);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym);
- begin
- appendsym_const_member(list,sym,false);
- end;
- procedure TDebugInfoDwarf.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean);
- var
- i,
- size: aint;
- usedef: tdef;
- begin
- { These are default values of parameters. These should be encoded
- via DW_AT_default_value, not as a separate sym. Moreover, their
- type is not available when writing the debug info for external
- procedures.
- }
- if (sym.owner.symtabletype=parasymtable) then
- exit;
- if ismember then
- append_entry(DW_TAG_member,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- { The DW_AT_declaration tag is invalid according to the DWARF specifications.
- But gcc adds this to static const members and gdb checks
- for this flag. So we have to set it also.
- }
- DW_AT_declaration,DW_FORM_flag,true,
- DW_AT_external,DW_FORM_flag,true
- ])
- else
- append_entry(DW_TAG_variable,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0
- ]);
- { for string constants, constdef isn't set because they have no real type }
- case sym.consttyp of
- conststring:
- begin
- { if DW_FORM_string is used below one day, this usedef should
- probably become nil }
- { note: < 255 instead of <= 255 because we have to store the
- entire length of the string as well, and 256 does not fit in
- a byte }
- if (sym.value.len<255) then
- usedef:=cshortstringtype
- else
- usedef:=clongstringtype;
- end;
- constresourcestring,
- constwstring:
- usedef:=nil;
- else
- usedef:=sym.constdef;
- end;
- if assigned(usedef) then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef));
- AddConstToAbbrev(ord(DW_AT_const_value));
- case sym.consttyp of
- conststring:
- begin
- { DW_FORM_string isn't supported yet by the Pascal value printer
- -> create a string using raw bytes }
- if (sym.value.len<255) then
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len+1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len));
- end
- else
- begin
- AddConstToAbbrev(ord(DW_FORM_block));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizesinttype.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_sizeint_unaligned(sym.value.len));
- end;
- i:=0;
- size:=sym.value.len;
- while(i<size) do
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
- inc(i);
- end;
- end;
- constguid,
- constset:
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(usedef.size));
- i:=0;
- size:=sym.constdef.size;
- while (i<size) do
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^)));
- inc(i);
- end;
- end;
- constwstring,
- constresourcestring:
- begin
- { write dummy for now }
- AddConstToAbbrev(ord(DW_FORM_string));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
- end;
- constord:
- begin
- if (sym.value.valueord<0) then
- begin
- AddConstToAbbrev(ord(DW_FORM_sdata));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
- end
- else
- begin
- AddConstToAbbrev(ord(DW_FORM_udata));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.valueord.uvalue));
- end;
- end;
- constnil:
- begin
- {$ifdef cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(0));
- {$else cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(0));
- {$endif cpu64bitaddr}
- end;
- constpointer:
- begin
- {$ifdef cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(int64(sym.value.valueordptr)));
- {$else cpu64bitaddr}
- AddConstToAbbrev(ord(DW_FORM_data4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint(sym.value.valueordptr)));
- {$endif cpu64bitaddr}
- end;
- constreal:
- begin
- AddConstToAbbrev(ord(DW_FORM_block1));
- case tfloatdef(sym.constdef).floattype of
- s32real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^));
- end;
- s64real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^));
- end;
- s64comp,
- s64currency:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit_unaligned(trunc(pbestreal(sym.value.valueptr)^)));
- end;
- s80real,
- sc80real:
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size));
- end;
- else
- internalerror(200601291);
- end;
- end;
- else
- internalerror(200601292);
- end;
- finish_entry;
- end;
- procedure TDebugInfoDwarf.appendsym_label(list:TAsmList;sym: tlabelsym);
- begin
- { ignore label syms for now, the problem is that a label sym
- can have more than one label associated e.g. in case of
- an inline procedure expansion }
- end;
- procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym);
- var
- symlist: ppropaccesslistitem;
- tosym: tabstractvarsym;
- offset: pint;
- begin
- if assigned(sym.propaccesslist[palt_read]) and
- not assigned(sym.propaccesslist[palt_read].procdef) then
- symlist:=sym.propaccesslist[palt_read].firstsym
- else
- { can't handle }
- exit;
- if not get_symlist_sym_offset(symlist,tosym,offset) then
- exit;
- if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- if (tosym.typ=fieldvarsym) then
- internalerror(2009031404);
- appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),sym.propdef,offset,[])
- end
- else
- appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym, false),sym.propdef,offset)
- end;
- function TDebugInfoDwarf.symdebugname(sym: tsym): String;
- begin
- result := sym.name;
- end;
- procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym);
- begin
- { just queue the def if needed, beforeappenddef will
- emit the typedef if necessary }
- def_dwarf_lab(sym.typedef);
- end;
- procedure TDebugInfoDwarf.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
- var
- templist : TAsmList;
- blocksize : longint;
- symlist : ppropaccesslistitem;
- tosym: tabstractvarsym;
- offset: pint;
- flags: tdwarfvarsymflags;
- begin
- templist:=TAsmList.create;
- case tabsolutevarsym(sym).abstyp of
- toaddr :
- begin
- { MWE: replaced ifdef i368 }
- (*
- if target_cpu = cpu_i386 then
- begin
- { in theory, we could write a DW_AT_segment entry here for sym.absseg,
- however I doubt that gdb supports this (FK) }
- end;
- *)
- templist.concat(tai_const.create_8bit(3));
- {$ifdef avr}
- // Add $800000 to indicate that the address is in memory space
- templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset + $800000, aitconst_ptr_unaligned));
- {$else}
- templist.concat(tai_const.create_int_dataptr_unaligned(sym.addroffset));
- {$endif}
- blocksize:=1+sizeof(puint);
- end;
- toasm :
- begin
- templist.concat(tai_const.create_8bit(3));
- templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0));
- blocksize:=1+sizeof(puint);
- end;
- tovar:
- begin
- symlist:=tabsolutevarsym(sym).ref.firstsym;
- if get_symlist_sym_offset(symlist,tosym,offset) then
- begin
- if (tosym.typ=fieldvarsym) then
- internalerror(2009031402);
- flags:=[];
- if (sym.owner.symtabletype=localsymtable) then
- include(flags,dvf_force_local_var);
- appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym, false),tabstractvarsym(sym).vardef,offset,flags);
- end;
- templist.free;
- exit;
- end;
- end;
- append_entry(DW_TAG_variable,false,[
- DW_AT_name,DW_FORM_string,symname(sym, false)+#0,
- {
- DW_AT_decl_file,DW_FORM_data1,0,
- DW_AT_decl_line,DW_FORM_data1,
- }
- DW_AT_external,DW_FORM_flag,true,
- { data continues below }
- DW_AT_location,DW_FORM_block1,blocksize
- ]);
- { append block data }
- current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
- templist.free;
- finish_entry;
- end;
- procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym);
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym, true))));
- end;
- procedure TDebugInfoDwarf.insertmoduleinfo;
- var
- templist: TAsmList;
- linelist: TAsmList;
- lbl : tasmlabel;
- n,m : Integer;
- ditem : TDirIndexItem;
- fitem : TFileIndexItem;
- flist : TFPList;
- dbgname : TSymStr;
- begin
- if not (target_info.system in systems_wasm) then
- begin
- { insert DEBUGSTART and DEBUGEND labels }
- dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
- { Darwin's linker does not like two global labels both pointing to the
- end of a section, which can happen in case of units without code ->
- make them local; we don't need the debugtable stuff there either,
- so it doesn't matter that they are not global.
- }
- if (target_info.system in systems_darwin) then
- dbgname:='L'+dbgname;
- new_section(current_asmdata.asmlists[al_start],sec_code,dbgname,0,secorder_begin);
- if not(target_info.system in systems_darwin) then
- current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype))
- else
- current_asmdata.asmlists[al_start].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype));
- dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
- { See above. }
- if (target_info.system in systems_darwin) then
- dbgname:='L'+dbgname;
- new_section(current_asmdata.asmlists[al_end],sec_code,dbgname,0,secorder_end);
- if not(target_info.system in systems_darwin) then
- current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(dbgname,AT_METADATA,0,voidpointertype))
- else
- current_asmdata.asmlists[al_end].concat(tai_symbol.Createname(dbgname,AT_METADATA,0,voidpointertype));
- end;
- { insert .Ldebug_abbrev0 label }
- templist:=TAsmList.create;
- new_section(templist,sec_debug_abbrev,'',0);
- templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrevsection0',AT_METADATA,0,voidpointertype));
- { add any extra stuff which needs to be in the abbrev section, but before }
- { the actual abbreviations, in between the symbol above and below, i.e. here }
- templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrev0',AT_METADATA,0,voidpointertype));
- current_asmdata.asmlists[al_start].insertlist(templist);
- templist.free;
- { insert .Ldebug_line0 label }
- templist:=TAsmList.create;
- new_section(templist,sec_debug_line,'',0);
- templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_linesection0',AT_METADATA,0,voidpointertype));
- { add any extra stuff which needs to be in the line section, but before }
- { the actual line info, in between the symbol above and below, i.e. here }
- templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_line0',AT_METADATA,0,voidpointertype));
- current_asmdata.asmlists[al_start].insertlist(templist);
- templist.free;
- { finalize line info if the unit doesn't contain any function/ }
- { procedure/init/final code }
- finish_lineinfo;
- { debug line header }
- linelist := current_asmdata.asmlists[al_dwarf_line];
- new_section(linelist,sec_debug_line,'',0);
- linelist.concat(tai_comment.Create(strpnew('=== header start ===')));
- { size }
- current_asmdata.getlabel(lbl,alt_dbgfile);
- if use_64bit_headers then
- linelist.concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
- linelist.concat(tai_const.create_rel_sym(offsetreltype,
- lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_line0',AB_LOCAL,AT_METADATA,voidpointertype)));
- linelist.concat(tai_label.create(lbl));
- { version }
- linelist.concat(tai_const.create_16bit_unaligned(dwarf_version));
- { header length }
- current_asmdata.getlabel(lbl,alt_dbgfile);
- linelist.concat(tai_const.create_rel_sym(offsetreltype,
- lbl,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'ehdebug_line0',AB_LOCAL,AT_METADATA,voidpointertype)));
- linelist.concat(tai_label.create(lbl));
- { minimum_instruction_length }
- linelist.concat(tai_const.create_8bit(1));
- { default_is_stmt }
- linelist.concat(tai_const.create_8bit(1));
- { line_base }
- linelist.concat(tai_const.create_8bit(LINE_BASE));
- { line_range }
- { only line increase, no adress }
- linelist.concat(tai_const.create_8bit(255));
- { opcode_base }
- linelist.concat(tai_const.create_8bit(OPCODE_BASE));
- { standard_opcode_lengths }
- { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) }
- { DW_LNS_copy }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_advance_pc }
- linelist.concat(tai_const.create_8bit(1));
- { DW_LNS_advance_line }
- linelist.concat(tai_const.create_8bit(1));
- { DW_LNS_set_file }
- linelist.concat(tai_const.create_8bit(1));
- { DW_LNS_set_column }
- linelist.concat(tai_const.create_8bit(1));
- { DW_LNS_negate_stmt }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_set_basic_block }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_const_add_pc }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_fixed_advance_pc }
- linelist.concat(tai_const.create_8bit(1));
- { DW_LNS_set_prologue_end }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_set_epilogue_begin }
- linelist.concat(tai_const.create_8bit(0));
- { DW_LNS_set_isa }
- linelist.concat(tai_const.create_8bit(1));
- { Create single list of filenames sorted in IndexNr }
- flist:=TFPList.Create;
- for n := 0 to dirlist.Count - 1 do
- begin
- ditem := TDirIndexItem(dirlist[n]);
- for m := 0 to ditem.Files.Count - 1 do
- flist.Add(ditem.Files[m]);
- end;
- flist.Sort(@FileListSortCompare);
- { include_directories }
- linelist.concat(tai_comment.Create(strpnew('include_directories')));
- for n := 0 to dirlist.Count - 1 do
- begin
- ditem := TDirIndexItem(dirlist[n]);
- if ditem.Name = '.' then
- Continue;
- { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist }
- linelist.concat(tai_string.create(ditem.Name+#0));
- end;
- linelist.concat(tai_const.create_8bit(0));
- { file_names }
- linelist.concat(tai_comment.Create(strpnew('file_names')));
- for n := 0 to flist.Count - 1 do
- begin
- fitem := TFileIndexItem(flist[n]);
- { file name }
- linelist.concat(tai_string.create(fitem.Name+#0));
- { directory index }
- linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex));
- { last modification }
- linelist.concat(tai_const.create_uleb128bit(0));
- { file length }
- linelist.concat(tai_const.create_uleb128bit(0));
- end;
- linelist.concat(tai_const.create_8bit(0));
- { end of debug line header }
- linelist.concat(tai_symbol.createname(target_asm.labelprefix+'ehdebug_line0',AT_METADATA,0,voidpointertype));
- linelist.concat(tai_comment.Create(strpnew('=== header end ===')));
- { add line program }
- linelist.concatList(asmline);
- { end of debug line table }
- linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_METADATA,0,voidpointertype));
- flist.free;
- end;
- procedure TDebugInfoDwarf.inserttypeinfo;
- var
- storefilepos : tfileposinfo;
- lenstartlabel,arangestartlabel: tasmlabel;
- i : longint;
- def: tdef;
- dbgname: string;
- vardatatype: ttypesym;
- bind: tasmsymbind;
- lang: tdwarf_source_language;
- begin
- include(current_module.moduleflags,mf_has_dwarf_debuginfo);
- storefilepos:=current_filepos;
- current_filepos:=current_module.mainfilepos;
- if assigned(dwarflabels) then
- internalerror(2015100301);
- { one item per def, plus some extra space in case of nested types,
- externally used types etc (it will grow further if necessary) }
- i:=current_module.localsymtable.DefList.count*4;
- if assigned(current_module.globalsymtable) then
- inc(i,current_module.globalsymtable.DefList.count*2);
- dwarflabels:=TDwarfLabHashSet.Create(i,true,false);
- currabbrevnumber:=0;
- defnumberlist:=TFPObjectList.create(false);
- deftowritelist:=TFPObjectList.create(false);
- { not exported (FK)
- FILEREC
- TEXTREC
- }
- vardatatype:=try_search_system_type('TVARDATA');
- if assigned(vardatatype) then
- vardatadef:=trecorddef(vardatatype.typedef);
- { write start labels }
- new_section(current_asmdata.asmlists[al_dwarf_info],sec_debug_info,'',0);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'debug_info0',AT_METADATA,0,voidpointertype));
- { start abbrev section }
- new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0);
- if not(target_info.system in systems_darwin) then
- begin
- { start aranges section }
- new_section(current_asmdata.asmlists[al_dwarf_aranges],sec_debug_aranges,'',0);
- current_asmdata.getlabel(arangestartlabel,alt_dbgfile);
- if use_64bit_headers then
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
- arangestartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'earanges0',AB_LOCAL,AT_METADATA,voidpointertype)));
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_label.create(arangestartlabel));
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_16bit_unaligned(2));
- if not(tf_dwarf_relative_addresses in target_info.flags) then
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_type_sym(offsetabstype,
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype)))
- else
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_rel_sym(offsetreltype,
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_infosection0',AB_LOCAL,AT_METADATA,voidpointertype),
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_info0',AB_LOCAL,AT_METADATA,voidpointertype)));
- {$ifdef i8086}
- { address_size }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(4));
- { segment_size }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(2));
- { no alignment/padding bytes on i8086 for Open Watcom compatibility }
- {$else i8086}
- { address_size }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(sizeof(pint)));
- { segment_size }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_8bit(0));
- { alignment }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.create_32bit_unaligned(0));
- {$endif i8086}
- { start ranges section }
- new_section(current_asmdata.asmlists[al_dwarf_ranges],sec_debug_ranges,'',0);
- end;
- { debug info header }
- current_asmdata.getlabel(lenstartlabel,alt_dbgfile);
- { size }
- if use_64bit_headers then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit_unaligned(longint($FFFFFFFF)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
- lenstartlabel,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'edebug_info0',AB_LOCAL,AT_METADATA,voidpointertype)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel));
- { version }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(dwarf_version));
- { abbrev table (=relative from section start)}
- if not(tf_dwarf_relative_addresses in target_info.flags) then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0',AB_LOCAL,AT_METADATA,voidpointertype),
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_abbrev0',AB_LOCAL,AT_METADATA,voidpointertype)));
- { address size }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint)));
- if (ds_dwarf_cpp in current_settings.debugswitches) then
- lang:=DW_LANG_C_plus_plus
- else
- lang:=DW_LANG_Pascal83;
- { first manadatory compilation unit TAG }
- append_entry(DW_TAG_compile_unit,true,[
- DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path+current_module.sourcefiles.get_file(1).name)+#0,
- DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
- DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0,
- DW_AT_language,DW_FORM_data1,lang,
- DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
- {$ifdef i8086}
- case current_settings.x86memorymodel of
- mm_tiny,
- mm_small:
- append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_small]);
- mm_medium:
- append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_medium]);
- mm_compact:
- append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_compact]);
- mm_large:
- append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_large]);
- mm_huge:
- append_attribute(DW_AT_WATCOM_memory_model,DW_FORM_data1,[DW_WATCOM_MEMORY_MODEL_huge]);
- end;
- {$endif i8086}
- { reference to line info section }
- if not(tf_dwarf_relative_addresses in target_info.flags) then
- append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype))
- else
- append_labelentry_dataptr_rel(DW_AT_stmt_list,
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_linesection0',AB_LOCAL,AT_METADATA,voidpointertype),
- current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'debug_line0',AB_LOCAL,AT_METADATA,voidpointertype));
- if (m_objectivec1 in current_settings.modeswitches) then
- append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]);
- if target_info.system in systems_wasm then
- begin
- append_attribute(DW_AT_low_pc,DW_FORM_data4,[0]);
- { todo: append DW_AT_ranges }
- end
- else
- begin
- dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,'');
- if (target_info.system in systems_darwin) then
- begin
- bind:=AB_LOCAL;
- dbgname:='L'+dbgname;
- end
- else
- bind:=AB_GLOBAL;
- append_labelentry(DW_AT_low_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
- dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,'');
- if (target_info.system in systems_darwin) then
- dbgname:='L'+dbgname;
- append_labelentry(DW_AT_high_pc,current_asmdata.DefineAsmSymbol(dbgname,bind,AT_METADATA,voidpointertype));
- end;
- finish_entry;
- { write all global/local variables. This will flag all required tdefs }
- if assigned(current_module.globalsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { write all procedures and methods. This will flag all required tdefs }
- if assigned(current_module.globalsymtable) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { reset unit type info flag }
- reset_unit_type_info;
- { write used types from the used units }
- write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
- { last write the types from this unit }
- if assigned(current_module.globalsymtable) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
- if assigned(current_module.localsymtable) then
- write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
- { write defs not written yet }
- write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]);
- { close compilation unit entry }
- finish_children;
- { end of debug info table }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_METADATA,0,voidpointertype));
- { end of abbrev table }
- current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0));
- if not(target_info.system in systems_darwin) then
- begin
- { end of aranges table }
- {$ifdef i8086}
- { 32-bit offset }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
- { 16-bit segment }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_16bit_unaligned(0));
- { 32-bit length }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_32bit_unaligned(0));
- {$else i8086}
- { offset }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
- { length }
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_const.Create_aint(0));
- {$endif i8086}
- current_asmdata.asmlists[al_dwarf_aranges].concat(tai_symbol.createname(target_asm.labelprefix+'earanges0',AT_METADATA,0,voidpointertype));
- end;
- { reset all def debug states }
- for i:=0 to defnumberlist.count-1 do
- begin
- def := tdef(defnumberlist[i]);
- if assigned(def) then
- def.dbg_state:=dbg_state_unused;
- end;
- dwarflabels.free;
- dwarflabels:=nil;
- defnumberlist.free;
- defnumberlist:=nil;
- deftowritelist.free;
- deftowritelist:=nil;
- current_filepos:=storefilepos;
- end;
- procedure TDebugInfoDwarf.referencesections(list:TAsmList);
- var
- hp : tmodule;
- begin
- { Reference all DEBUGINFO sections from the main .fpc section }
- { to prevent eliminating them by smartlinking }
- if (target_info.system in ([system_powerpc_macosclassic]+systems_darwin+systems_wasm)) then
- exit;
- new_section(list,sec_fpc,'links',0);
- { include reference to all debuginfo sections of used units }
- hp:=tmodule(loaded_units.first);
- while assigned(hp) do
- begin
- If (mf_has_dwarf_debuginfo in hp.moduleflags) and not assigned(hp.package) then
- begin
- list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
- list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
- end;
- hp:=tmodule(hp.next);
- end;
- end;
- function TDebugInfoDwarf.symname(sym: tsym; manglename: boolean): String;
- begin
- if (sym.typ=paravarsym) and
- (vo_is_self in tparavarsym(sym).varoptions) then
- { We use 'this' for regular methods because that's what gdb triggers
- on to automatically search fields. Don't do this for class methods,
- because search class fields is not supported, and gdb 7.0+ fails
- in this case because "this" is not a record in that case (it's a
- pointer to a vmt) }
- if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and
- not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
- result:='this'
- else
- result:='self'
- else if (sym.typ=typesym) and
- is_objc_class_or_protocol(ttypesym(sym).typedef) then
- result:=tobjectdef(ttypesym(sym).typedef).objextname^
- else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
- (sym.typ=procsym) and
- (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
- begin
- result:=tprocsym(sym).owner.name^+'__';
- if manglename then
- result := result + sym.name
- else
- result := result + symdebugname(sym);
- end
- else
- begin
- if manglename then
- result := sym.name
- else
- result := symdebugname(sym);
- end;
- end;
- procedure TDebugInfoDwarf.append_visibility(vis: tvisibility);
- begin
- case vis of
- vis_hidden,
- vis_private,
- vis_strictprivate:
- append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]);
- vis_protected,
- vis_strictprotected:
- append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]);
- vis_published,
- vis_public:
- { default };
- vis_none:
- internalerror(2019050720);
- end;
- end;
- procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
- var
- currfileinfo,
- lastfileinfo : tfileposinfo;
- currfuncname : pshortstring;
- currstatement: boolean;
- currsectype : TAsmSectiontype;
- hp, hpend : tai;
- infile : tinputfile;
- prevcolumn,
- diffline,
- prevline,
- prevfileidx,
- currfileidx,
- nolineinfolevel : Integer;
- prevlabel,
- currlabel : tasmlabel;
- begin
- {$ifdef OMFOBJSUPPORT}
- if ds_dwarf_omf_linnum in current_settings.debugswitches then
- dbgcodeview.InsertLineInfo_OMF_LINNUM_MsLink(list);
- {$endif OMFOBJSUPPORT}
- { this function will always terminate the lineinfo block }
- generated_lineinfo := true;
- { if this unit only contains code without debug info (implicit init
- or final etc), make sure the file table contains at least one entry
- (the main source of the unit), because normally this table gets
- populated via calls to get_file_index and that won't happen in this
- case }
- get_file_index(current_module.sourcefiles.get_file(1));
- FillChar(lastfileinfo,sizeof(lastfileinfo),0);
- currfuncname:=nil;
- currsectype:=sec_code;
- hp:=Tai(list.first);
- currstatement:=true;
- prevcolumn := 0;
- prevline := 1;
- prevfileidx := 1;
- prevlabel := nil;
- nolineinfolevel := 0;
- hpend := nil;
- while assigned(hp) do
- begin
- case hp.typ of
- ait_section :
- currsectype:=tai_section(hp).sectype;
- ait_function_name :
- begin
- currfuncname:=tai_function_name(hp).funcname;
- asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
- end;
- ait_force_line :
- begin
- lastfileinfo.line:=-1;
- end;
- ait_marker :
- begin
- case tai_marker(hp).kind of
- mark_NoLineInfoStart:
- inc(nolineinfolevel);
- mark_NoLineInfoEnd:
- dec(nolineinfolevel);
- else
- ;
- end;
- end;
- else
- ;
- end;
- if (currsectype=sec_code) and
- (hp.typ=ait_instruction) then
- begin
- currfileinfo:=tailineinfo(hp).fileinfo;
- { file changed ? (must be before line info) }
- if (currfileinfo.fileindex<>0) and
- ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
- (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
- begin
- infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
- if assigned(infile) then
- begin
- currfileidx := get_file_index(infile);
- if prevfileidx <> currfileidx then
- begin
- list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path)), hp);
- list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name)), hp);
- list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp);
- { set file }
- asmline.concat(tai_comment.Create(strpnew('path: '+infile.path)));
- asmline.concat(tai_comment.Create(strpnew('file: '+infile.name)));
- asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
- asmline.concat(tai_const.create_uleb128bit(currfileidx));
- prevfileidx := currfileidx;
- end;
- { force new line info }
- lastfileinfo.line:=-1;
- end;
- end;
- { Set the line-nr to 0 if the code does not corresponds to a particular line }
- if nolineinfolevel>0 then
- currfileinfo.line := 0;
- { line changed ? }
- if (lastfileinfo.line<>currfileinfo.line) and ((currfileinfo.line<>0) or (nolineinfolevel>0)) then
- begin
- { set address }
- current_asmdata.getlabel(currlabel, alt_dbgline);
- list.insertbefore(tai_label.create(currlabel), hp);
- asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']')));
- if (prevlabel = nil) or
- { darwin's assembler cannot create an uleb128 of the difference
- between to symbols
- same goes for Solaris native assembler
- ... and riscv }
- (target_info.system in systems_darwin+[system_riscv32_linux,system_riscv64_linux,
- system_riscv32_embedded,system_riscv64_embedded,
- system_riscv32_freertos]) or
- (target_asm.id=as_solaris_as) then
- begin
- asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
- asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
- asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel));
- {$ifdef i8086}
- { on i8086 we also emit an Open Watcom-specific 'set segment' op }
- asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.create_uleb128bit(3));
- asmline.concat(tai_const.create_8bit(DW_LNE_set_segment));
- asmline.concat(tai_const.Create_seg_name(currlabel.Name));
- {$endif i8086}
- end
- else
- begin
- asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc));
- asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel));
- end;
- prevlabel := currlabel;
- { set column }
- if prevcolumn <> currfileinfo.column then
- begin
- asmline.concat(tai_const.create_8bit(DW_LNS_set_column));
- asmline.concat(tai_const.create_uleb128bit(currfileinfo.column));
- prevcolumn := currfileinfo.column;
- end;
- { set statement }
- if (currfileinfo.line=0) and currstatement then
- begin
- currstatement := false;
- asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt));
- end;
- if not currstatement and (currfileinfo.line>0) then
- begin
- currstatement := true;
- asmline.concat(tai_const.create_8bit(DW_LNS_negate_stmt));
- end;
- { set line }
- diffline := currfileinfo.line - prevline;
- if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then
- begin
- { use special opcode, this also adds a row }
- asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE));
- end
- else
- begin
- if diffline <> 0 then
- begin
- asmline.concat(tai_const.create_8bit(DW_LNS_advance_line));
- asmline.concat(tai_const.create_sleb128bit(diffline));
- end;
- { no row added yet, do it manually }
- asmline.concat(tai_const.create_8bit(DW_LNS_copy));
- end;
- prevline := currfileinfo.line;
- end;
- lastfileinfo:=currfileinfo;
- end;
- hpend:=hp;
- hp:=tai(hp.next);
- end;
- if assigned(hpend) then
- begin
- { set address for end (see appendix 3 of dwarf 2 specs) }
- current_asmdata.getlabel(currlabel, alt_dbgline);
- list.insertafter(tai_label.create(currlabel), hpend);
- asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
- asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
- asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,currlabel));
- end;
- { end sequence }
- asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.Create_8bit(1));
- asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
- asmline.concat(tai_comment.Create(strpnew('###################')));
- end;
- procedure TDebugInfoDwarf.finish_lineinfo;
- var
- infile: tinputfile;
- begin
- { only needed if no line info at all has been generated }
- if generated_lineinfo then
- begin
- { reset for next module compilation }
- generated_lineinfo:=false;
- exit;
- end;
- { at least the Darwin linker is annoyed if you do not }
- { finish the lineinfo section, or if it doesn't }
- { contain at least one file name and set_address }
- infile:=current_module.sourcefiles.get_file(1);
- if not assigned(infile) then
- internalerror(2006020211);
- asmline.concat(tai_const.create_8bit(DW_LNS_set_file));
- asmline.concat(tai_const.create_uleb128bit(get_file_index(infile)));
- asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint)));
- asmline.concat(tai_const.create_8bit(DW_LNE_set_address));
- asmline.concat(tai_const.create_type_sym(aitconst_ptr_unaligned,nil));
- asmline.concat(tai_const.create_8bit(DW_LNS_extended_op));
- asmline.concat(tai_const.Create_8bit(1));
- asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence));
- asmline.concat(tai_comment.Create(strpnew('###################')));
- end;
- {****************************************************************************
- TDebugInfoDwarf2
- ****************************************************************************}
- procedure TDebugInfoDwarf2.appenddef_file(list:TAsmList;def: tfiledef);
- begin
- { gdb 6.4 doesn't support files so far so we use some fake recorddef
- file recs. are less than 1k so using data2 is enough }
- if assigned(def.typesym) then
- append_entry(DW_TAG_structure_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_size,DW_FORM_udata,def.size
- ])
- else
- append_entry(DW_TAG_structure_type,false,[
- DW_AT_byte_size,DW_FORM_udata,def.size
- ]);
- finish_entry;
- end;
- procedure TDebugInfoDwarf2.appenddef_formal(list:TAsmList;def: tformaldef);
- begin
- { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
- replace it with a unsigned type with size 0 (FK)
- }
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'FormalDef'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data1,0
- ]);
- finish_entry;
- end;
- procedure TDebugInfoDwarf2.append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString);
- begin
- if createlabel then
- begin
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(def_dwarf_class_struct_lab(def),0))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
- end;
- if assigned(objectname) then
- append_entry(DW_TAG_class_type,true,[
- DW_AT_name,DW_FORM_string,objectname^+#0,
- DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
- ])
- else
- append_entry(DW_TAG_class_type,true,[
- DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize
- ]);
- { Apple-specific tag that identifies it as an Objective-C class }
- if (def.objecttype=odt_objcclass) then
- append_attribute(DW_AT_APPLE_runtime_class,DW_FORM_data1,[DW_LANG_ObjC]);
- finish_entry;
- if assigned(def.childof) then
- begin
- append_entry(DW_TAG_inheritance,false,[
- DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
- if (def.childof.dbg_state=dbg_state_unused) then
- def.childof.dbg_state:=dbg_state_used;
- if is_implicit_pointer_object_type(def) then
- append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def.childof))
- else
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
- finish_entry;
- end;
- if (oo_has_vmt in def.objectoptions) and
- (not assigned(def.childof) or
- not(oo_has_vmt in def.childof.objectoptions)) then
- begin
- { vmt field }
- append_entry(DW_TAG_member,false,[
- DW_AT_artificial,DW_FORM_flag,true,
- DW_AT_name,DW_FORM_string,'_vptr$'+def.objname^+#0,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(def.vmt_offset)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(def.vmt_offset));
- { should be changed into a pointer to a function returning an }
- { int and with TAG_unspecified_parameters }
- if (voidpointertype.dbg_state=dbg_state_unused) then
- voidpointertype.dbg_state:=dbg_state_used;
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype));
- finish_entry;
- end;
- def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
- { Write the methods in the scope of the class/object, except for Objective-C. }
- if is_objc_class_or_protocol(def) then
- finish_children;
- { don't write procdefs of externally defined classes, gcc doesn't
- either (info is probably gotten from ObjC runtime) }
- if not(oo_is_external in def.objectoptions) then
- write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
- if not is_objc_class_or_protocol(def) then
- finish_children;
- end;
- procedure TDebugInfoDwarf2.appenddef_object(list:TAsmList;def: tobjectdef);
- begin
- case def.objecttype of
- odt_cppclass,
- odt_object:
- append_object_struct(def,false,def.objname);
- odt_interfacecom,
- odt_interfacecorba,
- odt_dispinterface,
- odt_helper,
- odt_class:
- begin
- { implicit pointer }
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def));
- finish_entry;
- append_object_struct(def,true,def.objname);
- end;
- odt_objcclass:
- { Objective-C class: same as regular class, except for
- a) Apple-specific tag that identifies it as an Objective-C class
- b) use extname^ instead of objname
- }
- append_object_struct(def,true,def.objextname);
- odt_objcprotocol:
- begin
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype));
- finish_entry;
- end;
- else
- internalerror(200602041);
- end;
- end;
- procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean);
- var
- lab: tasmlabel;
- begin
- if force_tag_set or
- (ds_dwarf_sets in current_settings.debugswitches) then
- begin
- { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types }
- if assigned(def.typesym) then
- append_entry(DW_TAG_set_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_size,DW_FORM_data2,def.size
- ])
- else
- append_entry(DW_TAG_set_type,false,[
- DW_AT_byte_size,DW_FORM_data2,def.size
- ]);
- if assigned(def.elementdef) then
- begin
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- current_asmdata.getglobaldatalabel(lab)
- else
- current_asmdata.getaddrlabel(lab);
- append_labelentry_ref(DW_AT_type,lab);
- finish_entry;
- if lab.bind=AB_GLOBAL then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(lab,0))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
- { Sets of e.g. [1..5] are actually stored as a set of [0..7],
- so write the exact boundaries of the set here. Let's hope no
- debugger ever rejects this because this "subrange" type can
- actually have a larger range than the original one. }
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_sdata,def.setbase,
- DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue
- ]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef))
- end
- end
- else
- begin
- { gdb versions which don't support sets refuse to load the debug }
- { info of modules that contain set tags }
- if assigned(def.typesym) then
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data2,def.size
- ])
- else
- append_entry(DW_TAG_base_type,false,[
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data2,def.size
- ]);
- end;
- finish_entry;
- end;
- procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
- begin
- appenddef_set_intern(list,def,false);
- end;
- procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef);
- begin
- { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
- replace it with a unsigned type with size 0 (FK)
- }
- append_entry(DW_TAG_base_type,false,[
- DW_AT_name,DW_FORM_string,'FormalDef'#0,
- DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned,
- DW_AT_byte_size,DW_FORM_data1,0
- ]);
- finish_entry;
- end;
- procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef);
- begin
- { variants aren't known to dwarf2 but writting tvardata should be enough }
- if assigned(vardatadef) then
- appenddef_record_named(list,trecorddef(vardatadef),'Variant');
- end;
- function TDebugInfoDwarf2.dwarf_version: Word;
- begin
- Result:=2;
- end;
- {****************************************************************************
- TDebugInfoDwarf3
- ****************************************************************************}
- procedure TDebugInfoDwarf3.append_labelentry_addr_ref(sym : tasmsymbol);
- begin
- AddConstToAbbrev(ord(DW_FORM_ref_addr));
- { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the
- target platform, but on the used Dwarf-format (32 bit or 64 bit) for the current compilation section. }
- if use_64bit_headers then
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_64bit_unaligned,sym))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_32bit_unaligned,sym));
- end;
- procedure tdebuginfodwarf3.appenddef_array(list: tasmlist; def: tarraydef);
- begin
- if not is_dynamic_array(def) then
- begin
- inherited appenddef_array(list,def);
- exit;
- end;
- if assigned(def.typesym) then
- append_entry(DW_TAG_array_type,true,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_stride,DW_FORM_udata,def.elesize,
- DW_AT_data_location,DW_FORM_block1,2
- ])
- else
- append_entry(DW_TAG_array_type,true,[
- DW_AT_byte_stride,DW_FORM_udata,def.elesize,
- DW_AT_data_location,DW_FORM_block1,2
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
- finish_entry;
- { to simplify things, we don't write a multidimensional array here }
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_udata,0,
- DW_AT_upper_bound,DW_FORM_block1,15
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup)));
- { pointer = nil? }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(5));
- { yes -> length = 0 }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_const1s)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(-1)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3));
- { no -> load length }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- { skip to past end is not allowed, thus use a nop here }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_nop)));
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));
- finish_entry;
- finish_children;
- end;
- procedure tdebuginfodwarf3.appenddef_string(list: tasmlist; def: tstringdef);
- procedure addstringdef(const name: shortstring; chardef: tdef; deref: boolean; lensize: aint);
- var
- upperopcodes: longint;
- begin
- { deref=true -> ansi/unicde/widestring; deref = false -> short/longstring }
- if assigned(def.typesym) then
- append_entry(DW_TAG_array_type,true,[
- DW_AT_name,DW_FORM_string,name+#0,
- DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
- ])
- else
- append_entry(DW_TAG_array_type,true,[
- DW_AT_data_location,DW_FORM_block1,2+ord(not(deref))
- ]);
- { in all cases we start with the address of the string }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- if deref then
- begin
- { ansi/unicode/widestring -> dereference the address of the string, and then
- we point to address of the string
- }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- end
- else
- begin
- { shortstring characters begin at string[1], so add one to the string's address }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+lensize));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus)))
- end;
- { reference to the element type of the string }
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(chardef));
- finish_entry;
- { now the information about the length of the string }
- if deref then
- begin
- if not (is_widestring(def) and (tf_winlikewidestring in target_info.flags)) then
- upperopcodes:=14
- else
- upperopcodes:=17;
- { lower bound is always 1, upper bound (length) needs to be calculated }
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_udata,1,
- DW_AT_upper_bound,DW_FORM_block1,upperopcodes
- ]);
- { high(string) is stored sizeof(sizeint) bytes before the string data }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup)));
- { pointer = nil? }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(4));
- { yes -> length = 0 }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip)));
- if upperopcodes=17 then
- { skip the extra deref_size argument and the division by two of the length }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(6))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3));
- { no -> load length }
- if upperopcodes=17 then
- { for Windows WideString the size is always a DWORD }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit4)))
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
- if upperopcodes=17 then
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
- end
- else
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- { for widestrings, the length is specified in bytes, so divide by two }
- if (upperopcodes=17) then
- begin
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr)));
- end;
- { skip to past end is not allowed, thus use a nop here }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_nop)));
- end
- else
- begin
- append_entry(DW_TAG_subrange_type,false,[
- DW_AT_lower_bound,DW_FORM_udata,1,
- DW_AT_upper_bound,DW_FORM_block1,3
- ]);
- { for shortstrings, the length is the first byte of the string }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- { load 1 byte }
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(lensize));
- end;
- finish_entry;
- finish_children;
- end;
- begin
- if (ds_dwarf_cpp in current_settings.debugswitches) then
- begin
- // At least LLDB 6.0.0 does not like this implementation of string types.
- // Call the inherited DWARF 2 implementation, which works fine.
- inherited;
- exit;
- end;
- case def.stringtype of
- st_shortstring:
- begin
- addstringdef('ShortString',cansichartype,false,1);
- end;
- st_longstring:
- begin
- {$ifdef cpu64bitaddr}
- addstringdef('LongString',cansichartype,false,8);
- {$else cpu64bitaddr}
- addstringdef('LongString',cansichartype,false,4);
- {$endif cpu64bitaddr}
- end;
- st_ansistring:
- begin
- addstringdef('AnsiString',cansichartype,true,-1);
- end;
- st_unicodestring:
- begin
- addstringdef('UnicodeString',cwidechartype,true,-1);
- end;
- st_widestring:
- begin
- addstringdef('WideString',cwidechartype,true,-1)
- end;
- end;
- end;
- procedure TDebugInfoDwarf3.appenddef_file(list:TAsmList;def: tfiledef);
- begin
- if assigned(def.typesym) then
- append_entry(DW_TAG_file_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0,
- DW_AT_byte_size,DW_FORM_data2,def.size
- ])
- else
- append_entry(DW_TAG_file_type,false,[
- DW_AT_byte_size,DW_FORM_data2,def.size
- ]);
- if tfiledef(def).filetyp=ft_typed then
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef));
- finish_entry;
- end;
- procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef);
- begin
- if (ds_dwarf_cpp in current_settings.debugswitches) then
- begin
- // Do not use DW_TAG_unspecified_type for C++ simulation.
- // At least LLDB 3.9.0 crashes in such case.
- // Call the inherited DWARF 2 implementation, which works fine.
- inherited;
- exit;
- end;
- append_entry(DW_TAG_unspecified_type,false,[]);
- finish_entry;
- end;
- procedure TDebugInfoDwarf3.appenddef_object(list:TAsmList;def: tobjectdef);
- procedure dostruct(tag: tdwarf_tag);
- begin
- if assigned(def.objname) then
- append_entry(tag,true,[
- DW_AT_name,DW_FORM_string,def.objrealname^+#0
- ])
- else
- append_entry(DW_TAG_structure_type,true,[]);
- append_attribute(DW_AT_byte_size,DW_FORM_udata,[tobjectsymtable(def.symtable).datasize]);
- { 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,
- see issue #36017 }
- if not(is_object(def) or is_cppclass(def)) then
- begin
- { The pointer to the class-structure is hidden. The debug-information
- does not contain an implicit pointer, but the data-adress is dereferenced here.
- In case of a nil-pointer, report the class as being unallocated.
- }
- append_block1(DW_AT_allocated,2);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- append_block1(DW_AT_data_location,2);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
- end;
- finish_entry;
- end;
- procedure doimplicitpointer;
- var
- obj : tasmlabel;
- begin
- if not(tf_dwarf_only_local_labels in target_info.flags) then
- current_asmdata.getglobaldatalabel(obj)
- else
- current_asmdata.getaddrlabel(obj);
- { implicit pointer }
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,obj);
- finish_entry;
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0));
- end;
- procedure doparent(isinterface: boolean);
- begin
- if not assigned(def.childof) then
- exit;
- if isinterface then
- begin
- append_entry(DW_TAG_inheritance,false,[]);
- end
- else
- begin
- append_entry(DW_TAG_inheritance,false,[
- DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public,
- DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0)
- ]);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
- current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0));
- end;
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof));
- finish_entry;
- end;
- var
- n: integer;
- begin
- case def.objecttype of
- odt_objcclass,
- odt_objcprotocol:
- begin
- inherited;
- exit
- end;
- odt_cppclass,
- odt_object:
- begin
- append_object_struct(def,false,def.objname);
- exit;
- end;
- odt_interfacecom,
- odt_interfacecorba,
- odt_dispinterface:
- begin
- dostruct(DW_TAG_interface_type);
- doparent(true);
- end;
- odt_helper,
- odt_class:
- begin
- append_entry(DW_TAG_pointer_type,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def));
- finish_entry;
- append_object_struct(def,true,def.objrealname);
- Exit;
- end;
- else
- internalerror(200609171);
- end;
- { add implemented interfaces }
- if assigned(def.ImplementedInterfaces) then
- for n := 0 to def.ImplementedInterfaces.count-1 do
- begin
- append_entry(DW_TAG_inheritance,false,[]);
- append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef));
- finish_entry;
- end;
- { add members }
- def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
- finish_children;
- end;
- procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef);
- begin
- appenddef_set_intern(list,def,true);
- end;
- procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef);
- begin
- { ??? can a undefined def have a typename ? }
- if assigned(def.typesym) then
- append_entry(DW_TAG_unspecified_type,false,[
- DW_AT_name,DW_FORM_string,symname(def.typesym, false)+#0
- ])
- else
- append_entry(DW_TAG_unspecified_type,false,[
- ]);
- finish_entry;
- end;
- procedure TDebugInfoDwarf3.appenddef_variant(list:TAsmList;def: tvariantdef);
- const
- VARIANTS: array[1..27] of record
- Value: Word;
- Name: String;
- { some fields are only supported by some features }
- features : tfeatures
- end = (
- (value:0; name:'';features: []),
- (value:1; name:'';features: []),
- (value:2; name:'VSMALLINT';features: []),
- (value:3; name:'VINTEGER';features: []),
- (value:4; name:'VSINGLE';features: [f_softfpu]),
- (value:5; name:'VDOUBLE';features: [f_softfpu]),
- (value:6; name:'VCURRENCY';features: [f_softfpu]),
- (value:7; name:'VDATE';features: [f_softfpu]),
- (value:8; name:'VOLESTR';features: []),
- (value:9; name:'VDISPATCH';features: []),
- (value:10; name:'VERROR';features: []),
- (value:11; name:'VBOOLEAN';features: []),
- (value:12; name:'';features: []),
- (value:13; name:'VUNKNOWN';features: []),
- (value:14; name:'';features: []),
- (value:16; name:'VSHORTINT';features: []),
- (value:17; name:'VBYTE';features: []),
- (value:18; name:'VWORD';features: []),
- (value:19; name:'VLONGWORD';features: []),
- (value:20; name:'VINT64';features: []),
- (value:21; name:'VQWORD';features: []),
- (value:36; name:'VRECORD';features: []),
- (value:$48; name:'';features: []),
- (value:$100; name:'VSTRING';features: []),
- (value:$101; name:'VANY';features: []),
- (value:$2000; name:'VARRAY';features: []),
- (value:$4000; name:'VPOINTER';features: [])
- );
- var
- fs: tfieldvarsym;
- lbl: tasmlabel;
- idx: integer;
- begin
- { it could be done with DW_TAG_variant for the union part (if that info was available)
- now we do it manually for variants (MWE) }
- { struct }
- append_entry(DW_TAG_structure_type,true,[
- DW_AT_name,DW_FORM_string,'Variant'#0,
- DW_AT_byte_size,DW_FORM_udata,vardatadef.size
- ]);
- finish_entry;
- append_entry(DW_TAG_variant_part,true,[
- ]);
- current_asmdata.getaddrlabel(lbl);
- append_labelentry_ref(DW_AT_discr,lbl);
- finish_entry;
- { discriminant }
- fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE'));
- if (fs = nil) or (fs.typ <> fieldvarsym) then
- internalerror(200609271);
- current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0));
- appendsym_fieldvar(list,fs);
- { variants }
- for idx := Low(VARIANTS) to High(VARIANTS) do
- begin
- if (features*VARIANTS[idx].features)=VARIANTS[idx].features then
- begin
- append_entry(DW_TAG_variant,true,[
- DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value
- ]);
- finish_entry;
- if VARIANTS[idx].name <> '' then
- begin
- fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name));
- if (fs = nil) or (fs.typ <> fieldvarsym) then
- internalerror(2006092702+idx);
- appendsym_fieldvar(list,fs);
- end;
- finish_children; { variant }
- end;
- end;
- finish_children; { variant part }
- finish_children; { struct }
- end;
- function TDebugInfoDwarf3.dwarf_version: Word;
- begin
- Result:=3;
- end;
- function TDebugInfoDwarf3.symdebugname(sym: tsym): String;
- begin
- Result:=sym.realname;
- end;
- { TDebugInfoDwarf4 }
- function TDebugInfoDwarf4.dwarf_version: Word;
- begin
- Result:=4;
- end;
- {****************************************************************************
- ****************************************************************************}
- const
- dbg_dwarf2_info : tdbginfo =
- (
- id : dbg_dwarf2;
- idtxt : 'DWARF2';
- );
- dbg_dwarf3_info : tdbginfo =
- (
- id : dbg_dwarf3;
- idtxt : 'DWARF3';
- );
- dbg_dwarf4_info : tdbginfo =
- (
- id : dbg_dwarf4;
- idtxt : 'DWARF4';
- );
- initialization
- RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2);
- RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3);
- RegisterDebugInfo(dbg_dwarf4_info,TDebugInfoDwarf4);
- end.
|