symtable.pas 124 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  3. This unit handles the symbol tables
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit symtable;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. { common }
  22. cutils,cclasses,
  23. { global }
  24. cpuinfo,globtype,tokens,
  25. { symtable }
  26. symconst,symbase,symtype,symdef,symsym,
  27. { ppu }
  28. ppu,
  29. { assembler }
  30. aasmtai,aasmdata
  31. ;
  32. {****************************************************************************
  33. Symtable types
  34. ****************************************************************************}
  35. type
  36. tstoredsymtable = class(TSymtable)
  37. private
  38. b_needs_init_final : boolean;
  39. procedure _needs_init_final(sym:TObject;arg:pointer);
  40. procedure check_forward(sym:TObject;arg:pointer);
  41. procedure labeldefined(sym:TObject;arg:pointer);
  42. procedure varsymbolused(sym:TObject;arg:pointer);
  43. procedure TestPrivate(sym:TObject;arg:pointer);
  44. procedure objectprivatesymbolused(sym:TObject;arg:pointer);
  45. procedure loaddefs(ppufile:tcompilerppufile);
  46. procedure loadsyms(ppufile:tcompilerppufile);
  47. procedure writedefs(ppufile:tcompilerppufile);
  48. procedure writesyms(ppufile:tcompilerppufile);
  49. public
  50. procedure insert(sym:TSymEntry;checkdup:boolean=true);override;
  51. procedure delete(sym:TSymEntry);override;
  52. { load/write }
  53. procedure ppuload(ppufile:tcompilerppufile);virtual;
  54. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  55. procedure buildderef;virtual;
  56. procedure buildderefimpl;virtual;
  57. procedure deref;virtual;
  58. procedure derefimpl;virtual;
  59. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  60. procedure allsymbolsused;
  61. procedure allprivatesused;
  62. procedure check_forwards;
  63. procedure checklabels;
  64. function needs_init_final : boolean;
  65. procedure testfordefaultproperty(sym:TObject;arg:pointer);
  66. end;
  67. tabstractrecordsymtable = class(tstoredsymtable)
  68. public
  69. usefieldalignment, { alignment to use for fields (PACKRECORDS value), C_alignment is C style }
  70. recordalignment, { alignment desired when inserting this record }
  71. fieldalignment, { alignment current alignment used when fields are inserted }
  72. padalignment : shortint; { size to a multiple of which the symtable has to be rounded up }
  73. constructor create(const n:string;usealign:shortint);
  74. procedure ppuload(ppufile:tcompilerppufile);override;
  75. procedure ppuwrite(ppufile:tcompilerppufile);override;
  76. procedure alignrecord(fieldoffset:asizeint;varalign:shortint);
  77. procedure addfield(sym:tfieldvarsym;vis:tvisibility);
  78. procedure addalignmentpadding;
  79. procedure insertdef(def:TDefEntry);override;
  80. function is_packed: boolean;
  81. function has_single_field(out sym:tfieldvarsym): boolean;
  82. function get_unit_symtable: tsymtable;
  83. protected
  84. { size in bytes including padding }
  85. _datasize : asizeint;
  86. { size in bits of the data in case of bitpacked record. Only important during construction, }
  87. { no need to save in/restore from ppu file. datasize is always (databitsize+7) div 8. }
  88. databitsize : asizeint;
  89. { size in bytes of padding }
  90. _paddingsize : word;
  91. procedure setdatasize(val: asizeint);
  92. public
  93. function iscurrentunit: boolean; override;
  94. property datasize : asizeint read _datasize write setdatasize;
  95. property paddingsize: word read _paddingsize write _paddingsize;
  96. end;
  97. trecordsymtable = class(tabstractrecordsymtable)
  98. public
  99. constructor create(const n:string;usealign:shortint);
  100. procedure insertunionst(unionst : trecordsymtable;offset : longint);
  101. end;
  102. tObjectSymtable = class(tabstractrecordsymtable)
  103. public
  104. constructor create(adefowner:tdef;const n:string;usealign:shortint);
  105. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  106. end;
  107. { tabstractlocalsymtable }
  108. tabstractlocalsymtable = class(tstoredsymtable)
  109. public
  110. procedure ppuwrite(ppufile:tcompilerppufile);override;
  111. function count_locals:longint;
  112. end;
  113. tlocalsymtable = class(tabstractlocalsymtable)
  114. public
  115. constructor create(adefowner:tdef;level:byte);
  116. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  117. end;
  118. { tparasymtable }
  119. tparasymtable = class(tabstractlocalsymtable)
  120. public
  121. readonly: boolean;
  122. constructor create(adefowner:tdef;level:byte);
  123. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  124. procedure insertdef(def:TDefEntry);override;
  125. end;
  126. tabstractuniTSymtable = class(tstoredsymtable)
  127. public
  128. constructor create(const n : string;id:word);
  129. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  130. function iscurrentunit:boolean;override;
  131. procedure insertunit(sym:TSymEntry);
  132. end;
  133. tglobalsymtable = class(tabstractuniTSymtable)
  134. public
  135. unittypecount : word;
  136. constructor create(const n : string;id:word);
  137. procedure ppuload(ppufile:tcompilerppufile);override;
  138. procedure ppuwrite(ppufile:tcompilerppufile);override;
  139. end;
  140. tstaticsymtable = class(tabstractuniTSymtable)
  141. public
  142. constructor create(const n : string;id:word);
  143. procedure ppuload(ppufile:tcompilerppufile);override;
  144. procedure ppuwrite(ppufile:tcompilerppufile);override;
  145. function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
  146. end;
  147. tspecializesymtable = class(tglobalsymtable)
  148. public
  149. constructor create(const n : string;id:word);
  150. function iscurrentunit:boolean;override;
  151. end;
  152. twithsymtable = class(TSymtable)
  153. withrefnode : tobject; { tnode }
  154. constructor create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode});
  155. destructor destroy;override;
  156. procedure clear;override;
  157. procedure insertdef(def:TDefEntry);override;
  158. end;
  159. tstt_excepTSymtable = class(TSymtable)
  160. public
  161. constructor create;
  162. end;
  163. tmacrosymtable = class(tstoredsymtable)
  164. public
  165. constructor create(exported: boolean);
  166. end;
  167. { tenumsymtable }
  168. tenumsymtable = class(tstoredsymtable)
  169. public
  170. procedure insert(sym: TSymEntry; checkdup: boolean = true); override;
  171. constructor create(adefowner:tdef);
  172. end;
  173. { tarraysymtable }
  174. tarraysymtable = class(tstoredsymtable)
  175. public
  176. procedure insertdef(def:TDefEntry);override;
  177. constructor create(adefowner:tdef);
  178. end;
  179. var
  180. systemunit : tglobalsymtable; { pointer to the system unit }
  181. {****************************************************************************
  182. Functions
  183. ****************************************************************************}
  184. {*** Misc ***}
  185. function FullTypeName(def,otherdef:tdef):string;
  186. function generate_nested_name(symtable:tsymtable;delimiter:string):string;
  187. procedure incompatibletypes(def1,def2:tdef);
  188. procedure hidesym(sym:TSymEntry);
  189. procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
  190. function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
  191. {*** Search ***}
  192. procedure addsymref(sym:tsym);
  193. function is_owned_by(childdef,ownerdef:tdef):boolean;
  194. function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
  195. function defs_belong_to_same_generic(def1,def2:tdef):boolean;
  196. function get_generic_in_hierarchy_by_name(srsym:tsym;def:tdef):tdef;
  197. function return_specialization_of_generic(nesteddef,genericdef:tdef;out resultdef:tdef):boolean;
  198. function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
  199. function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
  200. function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
  201. function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  202. function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
  203. { searches for a symbol with the given name that has the given option in
  204. symoptions set }
  205. function searchsym_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;option:tsymoption):boolean;
  206. function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  207. function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  208. function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
  209. function searchsym_in_class(classh: tobjectdef; contextclassh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
  210. function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  211. function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
  212. function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
  213. { searches symbols inside of a helper's implementation }
  214. function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
  215. function search_system_type(const s: TIDString): ttypesym;
  216. function try_search_system_type(const s: TIDString): ttypesym;
  217. function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
  218. function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
  219. function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
  220. function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
  221. { searches for the helper definition that's currently active for pd }
  222. function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
  223. { searches whether the symbol s is available in the currently active }
  224. { helper for pd }
  225. function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  226. function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  227. function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  228. {Looks for macro s (must be given in upper case) in the macrosymbolstack, }
  229. {and returns it if found. Returns nil otherwise.}
  230. function search_macro(const s : string):tsym;
  231. { Additionally to searching for a macro, also checks whether it's still }
  232. { actually defined (could be disable using "undef") }
  233. function defined_macro(const s : string):boolean;
  234. {*** Object Helpers ***}
  235. function search_default_property(pd : tabstractrecorddef) : tpropertysym;
  236. function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
  237. function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
  238. {*** Macro Helpers ***}
  239. {If called initially, the following procedures manipulate macros in }
  240. {initialmacrotable, otherwise they manipulate system macros local to a module.}
  241. {Name can be given in any case (it will be converted to upper case).}
  242. procedure def_system_macro(const name : string);
  243. procedure set_system_macro(const name, value : string);
  244. procedure set_system_compvar(const name, value : string);
  245. procedure undef_system_macro(const name : string);
  246. {*** symtable stack ***}
  247. { $ifdef DEBUG
  248. procedure test_symtablestack;
  249. procedure list_symtablestack;
  250. $endif DEBUG}
  251. {$ifdef UNITALIASES}
  252. type
  253. punit_alias = ^tunit_alias;
  254. tunit_alias = object(TNamedIndexItem)
  255. newname : pshortstring;
  256. constructor init(const n:string);
  257. destructor done;virtual;
  258. end;
  259. var
  260. unitaliases : pdictionary;
  261. procedure addunitalias(const n:string);
  262. function getunitalias(const n:string):string;
  263. {$endif UNITALIASES}
  264. {*** Init / Done ***}
  265. procedure IniTSymtable;
  266. procedure DoneSymtable;
  267. const
  268. overloaded_names : array [NOTOKEN..last_overloaded] of string[16] = (
  269. { NOTOKEN } 'error',
  270. { _PLUS } 'plus',
  271. { _MINUS } 'minus',
  272. { _STAR } 'star',
  273. { _SLASH } 'slash',
  274. { _EQ } 'equal',
  275. { _GT } 'greater',
  276. { _LT } 'lower',
  277. { _GTE } 'greater_or_equal',
  278. { _LTE } 'lower_or_equal',
  279. { _NE } 'not_equal',
  280. { _SYMDIF } 'sym_diff',
  281. { _STARSTAR } 'starstar',
  282. { _OP_AS } 'as',
  283. { _OP_IN } 'in',
  284. { _OP_IS } 'is',
  285. { _OP_OR } 'or',
  286. { _OP_AND } 'and',
  287. { _OP_DIV } 'div',
  288. { _OP_MOD } 'mod',
  289. { _OP_NOT } 'not',
  290. { _OP_SHL } 'shl',
  291. { _OP_SHR } 'shr',
  292. { _OP_XOR } 'xor',
  293. { _ASSIGNMENT } 'assign',
  294. { _OP_EXPLICIT } 'explicit',
  295. { _OP_ENUMERATOR } 'enumerator',
  296. { _OP_INC } 'inc',
  297. { _OP_DEC } 'dec');
  298. implementation
  299. uses
  300. { global }
  301. verbose,globals,
  302. { target }
  303. systems,
  304. { symtable }
  305. symutil,defcmp,defutil,
  306. { module }
  307. fmodule,
  308. { codegen }
  309. procinfo
  310. ;
  311. var
  312. dupnr : longint; { unique number for duplicate symbols }
  313. {*****************************************************************************
  314. TStoredSymtable
  315. *****************************************************************************}
  316. procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true);
  317. begin
  318. inherited insert(sym,checkdup);
  319. end;
  320. procedure tstoredsymtable.delete(sym:TSymEntry);
  321. begin
  322. inherited delete(sym);
  323. end;
  324. procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile);
  325. begin
  326. { load the table's flags }
  327. if ppufile.readentry<>ibsymtableoptions then
  328. Message(unit_f_ppu_read_error);
  329. ppufile.getsmallset(tableoptions);
  330. { load definitions }
  331. loaddefs(ppufile);
  332. { load symbols }
  333. loadsyms(ppufile);
  334. end;
  335. procedure tstoredsymtable.ppuwrite(ppufile:tcompilerppufile);
  336. begin
  337. { write the table's flags }
  338. ppufile.putsmallset(tableoptions);
  339. ppufile.writeentry(ibsymtableoptions);
  340. { write definitions }
  341. writedefs(ppufile);
  342. { write symbols }
  343. writesyms(ppufile);
  344. end;
  345. procedure tstoredsymtable.loaddefs(ppufile:tcompilerppufile);
  346. var
  347. def : tdef;
  348. b : byte;
  349. begin
  350. { load start of definition section, which holds the amount of defs }
  351. if ppufile.readentry<>ibstartdefs then
  352. Message(unit_f_ppu_read_error);
  353. { read definitions }
  354. repeat
  355. b:=ppufile.readentry;
  356. case b of
  357. ibpointerdef : def:=tpointerdef.ppuload(ppufile);
  358. ibarraydef : def:=tarraydef.ppuload(ppufile);
  359. iborddef : def:=torddef.ppuload(ppufile);
  360. ibfloatdef : def:=tfloatdef.ppuload(ppufile);
  361. ibprocdef : def:=tprocdef.ppuload(ppufile);
  362. ibshortstringdef : def:=tstringdef.loadshort(ppufile);
  363. iblongstringdef : def:=tstringdef.loadlong(ppufile);
  364. ibansistringdef : def:=tstringdef.loadansi(ppufile);
  365. ibwidestringdef : def:=tstringdef.loadwide(ppufile);
  366. ibunicodestringdef : def:=tstringdef.loadunicode(ppufile);
  367. ibrecorddef : def:=trecorddef.ppuload(ppufile);
  368. ibobjectdef : def:=tobjectdef.ppuload(ppufile);
  369. ibenumdef : def:=tenumdef.ppuload(ppufile);
  370. ibsetdef : def:=tsetdef.ppuload(ppufile);
  371. ibprocvardef : def:=tprocvardef.ppuload(ppufile);
  372. ibfiledef : def:=tfiledef.ppuload(ppufile);
  373. ibclassrefdef : def:=tclassrefdef.ppuload(ppufile);
  374. ibformaldef : def:=tformaldef.ppuload(ppufile);
  375. ibvariantdef : def:=tvariantdef.ppuload(ppufile);
  376. ibundefineddef : def:=tundefineddef.ppuload(ppufile);
  377. ibenddefs : break;
  378. ibend : Message(unit_f_ppu_read_error);
  379. else
  380. Message1(unit_f_ppu_invalid_entry,tostr(b));
  381. end;
  382. InsertDef(def);
  383. until false;
  384. end;
  385. procedure tstoredsymtable.loadsyms(ppufile:tcompilerppufile);
  386. var
  387. b : byte;
  388. sym : tsym;
  389. begin
  390. { load start of definition section, which holds the amount of defs }
  391. if ppufile.readentry<>ibstartsyms then
  392. Message(unit_f_ppu_read_error);
  393. { now read the symbols }
  394. repeat
  395. b:=ppufile.readentry;
  396. case b of
  397. ibtypesym : sym:=ttypesym.ppuload(ppufile);
  398. ibprocsym : sym:=tprocsym.ppuload(ppufile);
  399. ibconstsym : sym:=tconstsym.ppuload(ppufile);
  400. ibstaticvarsym : sym:=tstaticvarsym.ppuload(ppufile);
  401. iblocalvarsym : sym:=tlocalvarsym.ppuload(ppufile);
  402. ibparavarsym : sym:=tparavarsym.ppuload(ppufile);
  403. ibfieldvarsym : sym:=tfieldvarsym.ppuload(ppufile);
  404. ibabsolutevarsym : sym:=tabsolutevarsym.ppuload(ppufile);
  405. ibenumsym : sym:=tenumsym.ppuload(ppufile);
  406. ibpropertysym : sym:=tpropertysym.ppuload(ppufile);
  407. ibunitsym : sym:=tunitsym.ppuload(ppufile);
  408. iblabelsym : sym:=tlabelsym.ppuload(ppufile);
  409. ibsyssym : sym:=tsyssym.ppuload(ppufile);
  410. ibmacrosym : sym:=tmacro.ppuload(ppufile);
  411. ibnamespacesym : sym:=tnamespacesym.ppuload(ppufile);
  412. ibendsyms : break;
  413. ibend : Message(unit_f_ppu_read_error);
  414. else
  415. Message1(unit_f_ppu_invalid_entry,tostr(b));
  416. end;
  417. Insert(sym,false);
  418. until false;
  419. end;
  420. procedure tstoredsymtable.writedefs(ppufile:tcompilerppufile);
  421. var
  422. i : longint;
  423. def : tstoreddef;
  424. begin
  425. { each definition get a number, write then the amount of defs to the
  426. ibstartdef entry }
  427. ppufile.putlongint(DefList.count);
  428. ppufile.writeentry(ibstartdefs);
  429. { now write the definition }
  430. for i:=0 to DefList.Count-1 do
  431. begin
  432. def:=tstoreddef(DefList[i]);
  433. def.ppuwrite(ppufile);
  434. end;
  435. { write end of definitions }
  436. ppufile.writeentry(ibenddefs);
  437. end;
  438. procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
  439. var
  440. i : longint;
  441. sym : Tstoredsym;
  442. begin
  443. { each definition get a number, write then the amount of syms and the
  444. datasize to the ibsymdef entry }
  445. ppufile.putlongint(SymList.count);
  446. ppufile.writeentry(ibstartsyms);
  447. { foreach is used to write all symbols }
  448. for i:=0 to SymList.Count-1 do
  449. begin
  450. sym:=tstoredsym(SymList[i]);
  451. sym.ppuwrite(ppufile);
  452. end;
  453. { end of symbols }
  454. ppufile.writeentry(ibendsyms);
  455. end;
  456. procedure tstoredsymtable.buildderef;
  457. var
  458. i : longint;
  459. def : tstoreddef;
  460. sym : tstoredsym;
  461. begin
  462. { interface definitions }
  463. for i:=0 to DefList.Count-1 do
  464. begin
  465. def:=tstoreddef(DefList[i]);
  466. def.buildderef;
  467. end;
  468. { interface symbols }
  469. for i:=0 to SymList.Count-1 do
  470. begin
  471. sym:=tstoredsym(SymList[i]);
  472. sym.buildderef;
  473. end;
  474. end;
  475. procedure tstoredsymtable.buildderefimpl;
  476. var
  477. i : longint;
  478. def : tstoreddef;
  479. begin
  480. { implementation definitions }
  481. for i:=0 to DefList.Count-1 do
  482. begin
  483. def:=tstoreddef(DefList[i]);
  484. def.buildderefimpl;
  485. end;
  486. end;
  487. procedure tstoredsymtable.deref;
  488. var
  489. i : longint;
  490. def : tstoreddef;
  491. sym : tstoredsym;
  492. begin
  493. { first deref the interface ttype symbols. This is needs
  494. to be done before the interface defs are derefed, because
  495. the interface defs can contain references to the type symbols
  496. which then already need to contain a resolved typedef field (PFV) }
  497. for i:=0 to SymList.Count-1 do
  498. begin
  499. sym:=tstoredsym(SymList[i]);
  500. if sym.typ=typesym then
  501. sym.deref;
  502. end;
  503. { interface definitions }
  504. for i:=0 to DefList.Count-1 do
  505. begin
  506. def:=tstoreddef(DefList[i]);
  507. def.deref;
  508. end;
  509. { interface symbols }
  510. for i:=0 to SymList.Count-1 do
  511. begin
  512. sym:=tstoredsym(SymList[i]);
  513. if sym.typ<>typesym then
  514. sym.deref;
  515. end;
  516. end;
  517. procedure tstoredsymtable.derefimpl;
  518. var
  519. i : longint;
  520. def : tstoreddef;
  521. begin
  522. { implementation definitions }
  523. for i:=0 to DefList.Count-1 do
  524. begin
  525. def:=tstoreddef(DefList[i]);
  526. def.derefimpl;
  527. end;
  528. end;
  529. function tstoredsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  530. var
  531. hsym : tsym;
  532. begin
  533. hsym:=tsym(FindWithHash(hashedid));
  534. if assigned(hsym) then
  535. DuplicateSym(hashedid,sym,hsym);
  536. result:=assigned(hsym);
  537. end;
  538. {**************************************
  539. Callbacks
  540. **************************************}
  541. procedure TStoredSymtable.check_forward(sym:TObject;arg:pointer);
  542. begin
  543. if tsym(sym).typ=procsym then
  544. tprocsym(sym).check_forward
  545. { check also object method table }
  546. { we needn't to test the def list }
  547. { because each object has to have a type sym,
  548. only test objects declarations, not type renamings }
  549. else
  550. if (tsym(sym).typ=typesym) and
  551. assigned(ttypesym(sym).typedef) and
  552. (ttypesym(sym).typedef.typesym=ttypesym(sym)) and
  553. (ttypesym(sym).typedef.typ in [objectdef,recorddef]) then
  554. tabstractrecorddef(ttypesym(sym).typedef).check_forwards;
  555. end;
  556. procedure TStoredSymtable.labeldefined(sym:TObject;arg:pointer);
  557. begin
  558. if (tsym(sym).typ=labelsym) and
  559. not(tlabelsym(sym).defined) then
  560. begin
  561. if tlabelsym(sym).used then
  562. Message1(sym_e_label_used_and_not_defined,tlabelsym(sym).realname)
  563. else
  564. Message1(sym_w_label_not_defined,tlabelsym(sym).realname);
  565. end;
  566. end;
  567. procedure TStoredSymtable.varsymbolused(sym:TObject;arg:pointer);
  568. begin
  569. if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
  570. ((tsym(sym).owner.symtabletype in
  571. [parasymtable,localsymtable,ObjectSymtable,recordsymtable,staticsymtable])) then
  572. begin
  573. { unused symbol should be reported only if no }
  574. { error is reported }
  575. { if the symbol is in a register it is used }
  576. { also don't count the value parameters which have local copies }
  577. { also don't claim for high param of open parameters (PM) }
  578. { also don't complain about unused symbols in generic procedures }
  579. { and methods }
  580. if (Errorcount<>0) or
  581. ([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(sym).varoptions = [vo_is_hidden_para]) or
  582. (sp_internal in tsym(sym).symoptions) or
  583. ((assigned(tsym(sym).owner.defowner) and
  584. (tsym(sym).owner.defowner.typ=procdef) and
  585. (df_generic in tprocdef(tsym(sym).owner.defowner).defoptions))) then
  586. exit;
  587. if (tstoredsym(sym).refs=0) then
  588. begin
  589. if (vo_is_funcret in tabstractvarsym(sym).varoptions) then
  590. begin
  591. { don't warn about the result of constructors }
  592. { or the synthetic helper functions for class-attributes }
  593. if ((tsym(sym).owner.symtabletype<>localsymtable) or
  594. (tprocdef(tsym(sym).owner.defowner).proctypeoption<>potype_constructor)) and
  595. not(cs_opt_nodedfa in current_settings.optimizerswitches) and
  596. (tprocdef(tsym(sym).owner.defowner).synthetickind <> tsk_get_rttiattribute) then
  597. MessagePos(tsym(sym).fileinfo,sym_w_function_result_not_set)
  598. end
  599. else if (tsym(sym).owner.symtabletype=parasymtable) then
  600. MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname)
  601. else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  602. MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
  603. else
  604. MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname);
  605. end
  606. else if tabstractvarsym(sym).varstate in [vs_written,vs_initialised] then
  607. begin
  608. if (tsym(sym).owner.symtabletype=parasymtable) then
  609. begin
  610. if not(tabstractvarsym(sym).varspez in [vs_var,vs_out,vs_constref]) and
  611. not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
  612. MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
  613. end
  614. else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  615. MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
  616. else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
  617. MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname);
  618. end
  619. else if (tabstractvarsym(sym).varstate = vs_read_not_warned) and
  620. ([vo_is_public,vo_is_external] * tabstractvarsym(sym).varoptions = []) then
  621. MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).prettyname)
  622. end
  623. else if ((tsym(sym).owner.symtabletype in
  624. [ObjectSymtable,parasymtable,localsymtable,staticsymtable,recordsymtable])) then
  625. begin
  626. if (Errorcount<>0) or
  627. (sp_internal in tsym(sym).symoptions) then
  628. exit;
  629. { do not claim for inherited private fields !! }
  630. if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  631. case tsym(sym).typ of
  632. typesym:
  633. MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
  634. constsym:
  635. MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
  636. propertysym:
  637. MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
  638. else
  639. MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
  640. end
  641. { units references are problematic }
  642. else
  643. begin
  644. if (tsym(sym).refs=0) and
  645. not(tsym(sym).typ in [enumsym,unitsym,namespacesym]) and
  646. not(is_funcret_sym(tsym(sym))) and
  647. { don't complain about compiler generated syms for specializations, see also #13405 }
  648. not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and
  649. (pos('$',ttypesym(sym).Realname)<>0)) and
  650. (
  651. (tsym(sym).typ<>procsym) or
  652. ((tsym(sym).owner.symtabletype=staticsymtable) and
  653. not current_module.is_unit)
  654. ) and
  655. { don't complain about alias for hidden _cmd parameter to
  656. obj-c methods }
  657. not((tsym(sym).typ in [localvarsym,paravarsym,absolutevarsym]) and
  658. (vo_is_msgsel in tabstractvarsym(sym).varoptions)) then
  659. MessagePos2(tsym(sym).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(sym).typ],tsym(sym).prettyname);
  660. end;
  661. end;
  662. end;
  663. procedure TStoredSymtable.TestPrivate(sym:TObject;arg:pointer);
  664. begin
  665. if tsym(sym).visibility in [vis_private,vis_strictprivate] then
  666. varsymbolused(sym,arg);
  667. end;
  668. procedure TStoredSymtable.objectprivatesymbolused(sym:TObject;arg:pointer);
  669. begin
  670. {
  671. Don't test simple object aliases PM
  672. }
  673. if (tsym(sym).typ=typesym) and
  674. (ttypesym(sym).typedef.typ in [objectdef,recorddef]) and
  675. (ttypesym(sym).typedef.typesym=tsym(sym)) then
  676. tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
  677. end;
  678. procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
  679. begin
  680. if (tsym(sym).typ=propertysym) and
  681. (ppo_defaultproperty in tpropertysym(sym).propoptions) then
  682. ppointer(arg)^:=sym;
  683. end;
  684. {***********************************************
  685. Process all entries
  686. ***********************************************}
  687. { checks, if all procsyms and methods are defined }
  688. procedure tstoredsymtable.check_forwards;
  689. begin
  690. SymList.ForEachCall(@check_forward,nil);
  691. end;
  692. procedure tstoredsymtable.checklabels;
  693. begin
  694. SymList.ForEachCall(@labeldefined,nil);
  695. end;
  696. procedure tstoredsymtable.allsymbolsused;
  697. begin
  698. SymList.ForEachCall(@varsymbolused,nil);
  699. end;
  700. procedure tstoredsymtable.allprivatesused;
  701. begin
  702. SymList.ForEachCall(@objectprivatesymbolused,nil);
  703. end;
  704. procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer);
  705. begin
  706. if b_needs_init_final then
  707. exit;
  708. { don't check static symbols - they can be present in structures only and
  709. always have a reference to a symbol defined on unit level }
  710. if sp_static in tsym(sym).symoptions then
  711. exit;
  712. case tsym(sym).typ of
  713. fieldvarsym,
  714. staticvarsym,
  715. localvarsym,
  716. paravarsym :
  717. begin
  718. if assigned(tabstractvarsym(sym).vardef) and
  719. is_managed_type(tabstractvarsym(sym).vardef) then
  720. b_needs_init_final:=true;
  721. end;
  722. end;
  723. end;
  724. { returns true, if p contains data which needs init/final code }
  725. function tstoredsymtable.needs_init_final : boolean;
  726. begin
  727. b_needs_init_final:=false;
  728. SymList.ForEachCall(@_needs_init_final,nil);
  729. needs_init_final:=b_needs_init_final;
  730. end;
  731. {****************************************************************************
  732. TAbstractRecordSymtable
  733. ****************************************************************************}
  734. constructor tabstractrecordsymtable.create(const n:string;usealign:shortint);
  735. begin
  736. inherited create(n);
  737. moduleid:=current_module.moduleid;
  738. _datasize:=0;
  739. databitsize:=0;
  740. recordalignment:=1;
  741. usefieldalignment:=usealign;
  742. padalignment:=1;
  743. { recordalign C_alignment means C record packing, that starts
  744. with an alignment of 1 }
  745. case usealign of
  746. C_alignment,
  747. bit_alignment:
  748. fieldalignment:=1;
  749. mac68k_alignment:
  750. fieldalignment:=2;
  751. else
  752. fieldalignment:=usealign;
  753. end;
  754. end;
  755. procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
  756. begin
  757. if ppufile.readentry<>ibrecsymtableoptions then
  758. Message(unit_f_ppu_read_error);
  759. recordalignment:=shortint(ppufile.getbyte);
  760. usefieldalignment:=shortint(ppufile.getbyte);
  761. if (usefieldalignment=C_alignment) then
  762. fieldalignment:=shortint(ppufile.getbyte);
  763. inherited ppuload(ppufile);
  764. end;
  765. procedure tabstractrecordsymtable.ppuwrite(ppufile:tcompilerppufile);
  766. var
  767. oldtyp : byte;
  768. begin
  769. oldtyp:=ppufile.entrytyp;
  770. ppufile.entrytyp:=subentryid;
  771. { in case of classes using C alignment, the alignment of the parent
  772. affects the alignment of fields of the childs }
  773. ppufile.putbyte(byte(recordalignment));
  774. ppufile.putbyte(byte(usefieldalignment));
  775. if (usefieldalignment=C_alignment) then
  776. ppufile.putbyte(byte(fieldalignment));
  777. ppufile.writeentry(ibrecsymtableoptions);
  778. inherited ppuwrite(ppufile);
  779. ppufile.entrytyp:=oldtyp;
  780. end;
  781. function field2recordalignment(fieldoffs, fieldalign: asizeint): asizeint;
  782. begin
  783. { optimal alignment of the record when declaring a variable of this }
  784. { type is independent of the packrecords setting }
  785. if (fieldoffs mod fieldalign) = 0 then
  786. result:=fieldalign
  787. else if (fieldalign >= 16) and
  788. ((fieldoffs mod 16) = 0) and
  789. ((fieldalign mod 16) = 0) then
  790. result:=16
  791. else if (fieldalign >= 8) and
  792. ((fieldoffs mod 8) = 0) and
  793. ((fieldalign mod 8) = 0) then
  794. result:=8
  795. else if (fieldalign >= 4) and
  796. ((fieldoffs mod 4) = 0) and
  797. ((fieldalign mod 4) = 0) then
  798. result:=4
  799. else if (fieldalign >= 2) and
  800. ((fieldoffs mod 2) = 0) and
  801. ((fieldalign mod 2) = 0) then
  802. result:=2
  803. else
  804. result:=1;
  805. end;
  806. procedure tabstractrecordsymtable.alignrecord(fieldoffset:asizeint;varalign:shortint);
  807. var
  808. varalignrecord: shortint;
  809. begin
  810. case usefieldalignment of
  811. C_alignment:
  812. varalignrecord:=used_align(varalign,current_settings.alignment.recordalignmin,current_settings.alignment.maxCrecordalign);
  813. mac68k_alignment:
  814. varalignrecord:=2;
  815. else
  816. varalignrecord:=field2recordalignment(fieldoffset,varalign);
  817. end;
  818. recordalignment:=max(recordalignment,varalignrecord);
  819. end;
  820. procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
  821. var
  822. l : asizeint;
  823. varalignfield,
  824. varalign : shortint;
  825. vardef : tdef;
  826. begin
  827. if (sym.owner<>self) then
  828. internalerror(200602031);
  829. if sym.fieldoffset<>-1 then
  830. internalerror(200602032);
  831. { set visibility for the symbol }
  832. sym.visibility:=vis;
  833. { this symbol can't be loaded to a register }
  834. sym.varregable:=vr_none;
  835. { Calculate field offset }
  836. l:=sym.getsize;
  837. vardef:=sym.vardef;
  838. varalign:=vardef.alignment;
  839. {$if defined(powerpc) or defined(powerpc64)}
  840. { aix is really annoying: the recommended scalar alignment for both
  841. int64 and double is 64 bits, but in structs int64 has to be aligned
  842. to 8 bytes and double to 4 bytes }
  843. if (target_info.system in systems_aix) and
  844. is_double(vardef) then
  845. varalign:=4;
  846. {$endif powerpc or powerpc64}
  847. case usefieldalignment of
  848. bit_alignment:
  849. begin
  850. { bitpacking only happens for ordinals, the rest is aligned at }
  851. { 1 byte (compatible with GPC/GCC) }
  852. if is_ordinal(vardef) then
  853. begin
  854. sym.fieldoffset:=databitsize;
  855. l:=sym.getpackedbitsize;
  856. end
  857. else
  858. begin
  859. databitsize:=_datasize*8;
  860. sym.fieldoffset:=databitsize;
  861. if (l>high(asizeint) div 8) then
  862. Message(sym_e_segment_too_large);
  863. l:=l*8;
  864. end;
  865. if varalign=0 then
  866. varalign:=size_2_align(l);
  867. recordalignment:=max(recordalignment,field2recordalignment(databitsize mod 8,varalign));
  868. { bit packed records are limited to high(aint) bits }
  869. { instead of bytes to avoid double precision }
  870. { arithmetic in offset calculations }
  871. if int64(l)>high(asizeint)-sym.fieldoffset then
  872. begin
  873. Message(sym_e_segment_too_large);
  874. _datasize:=high(asizeint);
  875. databitsize:=high(asizeint);
  876. end
  877. else
  878. begin
  879. databitsize:=sym.fieldoffset+l;
  880. _datasize:=(databitsize+7) div 8;
  881. end;
  882. { rest is not applicable }
  883. exit;
  884. end;
  885. { Calc the alignment size for C style records }
  886. C_alignment:
  887. begin
  888. if (varalign>4) and
  889. ((varalign mod 4)<>0) and
  890. (vardef.typ=arraydef) then
  891. Message1(sym_w_wrong_C_pack,vardef.typename);
  892. if varalign=0 then
  893. varalign:=l;
  894. if (fieldalignment<current_settings.alignment.maxCrecordalign) then
  895. begin
  896. if (varalign>16) and (fieldalignment<32) then
  897. fieldalignment:=32
  898. else if (varalign>12) and (fieldalignment<16) then
  899. fieldalignment:=16
  900. { 12 is needed for long double }
  901. else if (varalign>8) and (fieldalignment<12) then
  902. fieldalignment:=12
  903. else if (varalign>4) and (fieldalignment<8) then
  904. fieldalignment:=8
  905. else if (varalign>2) and (fieldalignment<4) then
  906. fieldalignment:=4
  907. else if (varalign>1) and (fieldalignment<2) then
  908. fieldalignment:=2;
  909. end;
  910. fieldalignment:=min(fieldalignment,current_settings.alignment.maxCrecordalign);
  911. end;
  912. mac68k_alignment:
  913. begin
  914. { mac68k alignment (C description):
  915. * char is aligned to 1 byte
  916. * everything else (except vector) is aligned to 2 bytes
  917. * vector is aligned to 16 bytes
  918. }
  919. if l>1 then
  920. fieldalignment:=2
  921. else
  922. fieldalignment:=1;
  923. varalign:=2;
  924. end;
  925. end;
  926. if varalign=0 then
  927. varalign:=size_2_align(l);
  928. varalignfield:=used_align(varalign,current_settings.alignment.recordalignmin,fieldalignment);
  929. sym.fieldoffset:=align(_datasize,varalignfield);
  930. if l>high(asizeint)-sym.fieldoffset then
  931. begin
  932. Message(sym_e_segment_too_large);
  933. _datasize:=high(asizeint);
  934. end
  935. else
  936. _datasize:=sym.fieldoffset+l;
  937. { Calc alignment needed for this record }
  938. alignrecord(sym.fieldoffset,varalign);
  939. end;
  940. procedure tabstractrecordsymtable.addalignmentpadding;
  941. var
  942. padded_datasize: asizeint;
  943. begin
  944. { make the record size aligned correctly so it can be
  945. used as elements in an array. For C records we
  946. use the fieldalignment, because that is updated with the
  947. used alignment. }
  948. if (padalignment = 1) then
  949. case usefieldalignment of
  950. C_alignment:
  951. padalignment:=fieldalignment;
  952. { bitpacked }
  953. bit_alignment:
  954. padalignment:=1;
  955. { mac68k: always round to multiple of 2 }
  956. mac68k_alignment:
  957. padalignment:=2;
  958. { default/no packrecords specified }
  959. 0:
  960. padalignment:=recordalignment
  961. { specific packrecords setting -> use as upper limit }
  962. else
  963. padalignment:=min(recordalignment,usefieldalignment);
  964. end;
  965. padded_datasize:=align(_datasize,padalignment);
  966. _paddingsize:=padded_datasize-_datasize;
  967. _datasize:=padded_datasize;
  968. end;
  969. procedure tabstractrecordsymtable.insertdef(def:TDefEntry);
  970. begin
  971. { Enums must also be available outside the record scope,
  972. insert in the owner of this symtable }
  973. if def.typ=enumdef then
  974. defowner.owner.insertdef(def)
  975. else
  976. inherited insertdef(def);
  977. end;
  978. function tabstractrecordsymtable.is_packed: boolean;
  979. begin
  980. result:=usefieldalignment=bit_alignment;
  981. end;
  982. function tabstractrecordsymtable.has_single_field(out sym: tfieldvarsym): boolean;
  983. var
  984. i: longint;
  985. begin
  986. result:=false;
  987. { If a record contains a union, it does not contain a "single
  988. non-composite field" in the context of certain ABIs requiring
  989. special treatment for such records }
  990. if (defowner.typ=recorddef) and
  991. trecorddef(defowner).isunion then
  992. exit;
  993. { a record/object can contain other things than fields }
  994. for i:=0 to SymList.Count-1 do
  995. begin
  996. if tsym(symlist[i]).typ=fieldvarsym then
  997. begin
  998. if result then
  999. begin
  1000. result:=false;
  1001. exit;
  1002. end;
  1003. result:=true;
  1004. sym:=tfieldvarsym(symlist[i])
  1005. end;
  1006. end;
  1007. end;
  1008. function tabstractrecordsymtable.get_unit_symtable: tsymtable;
  1009. begin
  1010. result:=defowner.owner;
  1011. while assigned(result) and (result.symtabletype in [ObjectSymtable,recordsymtable]) do
  1012. result:=result.defowner.owner;
  1013. end;
  1014. procedure tabstractrecordsymtable.setdatasize(val: asizeint);
  1015. begin
  1016. _datasize:=val;
  1017. if (usefieldalignment=bit_alignment) then
  1018. { can overflow in non bitpacked records }
  1019. databitsize:=val*8;
  1020. end;
  1021. function tabstractrecordsymtable.iscurrentunit: boolean;
  1022. begin
  1023. Result := Assigned(current_module) and (current_module.moduleid=moduleid);
  1024. end;
  1025. {****************************************************************************
  1026. TRecordSymtable
  1027. ****************************************************************************}
  1028. constructor trecordsymtable.create(const n:string;usealign:shortint);
  1029. begin
  1030. inherited create(n,usealign);
  1031. symtabletype:=recordsymtable;
  1032. end;
  1033. { this procedure is reserved for inserting case variant into
  1034. a record symtable }
  1035. { the offset is the location of the start of the variant
  1036. and datasize and dataalignment corresponds to
  1037. the complete size (see code in pdecl unit) PM }
  1038. procedure trecordsymtable.insertunionst(unionst : trecordsymtable;offset : longint);
  1039. var
  1040. sym : tsym;
  1041. def : tdef;
  1042. i : integer;
  1043. varalignrecord,varalign,
  1044. storesize,storealign : aint;
  1045. bitsize: tcgint;
  1046. begin
  1047. storesize:=_datasize;
  1048. storealign:=fieldalignment;
  1049. _datasize:=offset;
  1050. if (usefieldalignment=bit_alignment) then
  1051. databitsize:=offset*8;
  1052. { We move the ownership of the defs and symbols to the new recordsymtable.
  1053. The old unionsymtable keeps the references, but doesn't own the
  1054. objects anymore }
  1055. unionst.DefList.OwnsObjects:=false;
  1056. unionst.SymList.OwnsObjects:=false;
  1057. { copy symbols }
  1058. for i:=0 to unionst.SymList.Count-1 do
  1059. begin
  1060. sym:=TSym(unionst.SymList[i]);
  1061. if sym.typ<>fieldvarsym then
  1062. internalerror(200601272);
  1063. if tfieldvarsym(sym).fieldoffset=0 then
  1064. include(tfieldvarsym(sym).varoptions,vo_is_first_field);
  1065. { add to this record symtable }
  1066. // unionst.SymList.List.List^[i].Data:=nil;
  1067. sym.ChangeOwner(self);
  1068. varalign:=tfieldvarsym(sym).vardef.alignment;
  1069. if varalign=0 then
  1070. varalign:=size_2_align(tfieldvarsym(sym).getsize);
  1071. { retrieve size }
  1072. if (usefieldalignment=bit_alignment) then
  1073. begin
  1074. { bit packed records are limited to high(aint) bits }
  1075. { instead of bytes to avoid double precision }
  1076. { arithmetic in offset calculations }
  1077. if is_ordinal(tfieldvarsym(sym).vardef) then
  1078. bitsize:=tfieldvarsym(sym).getpackedbitsize
  1079. else
  1080. begin
  1081. bitsize:=tfieldvarsym(sym).getsize;
  1082. if (bitsize>high(asizeint) div 8) then
  1083. Message(sym_e_segment_too_large);
  1084. bitsize:=bitsize*8;
  1085. end;
  1086. if bitsize>high(asizeint)-databitsize then
  1087. begin
  1088. Message(sym_e_segment_too_large);
  1089. _datasize:=high(asizeint);
  1090. databitsize:=high(asizeint);
  1091. end
  1092. else
  1093. begin
  1094. databitsize:=tfieldvarsym(sym).fieldoffset+offset*8;
  1095. _datasize:=(databitsize+7) div 8;
  1096. end;
  1097. tfieldvarsym(sym).fieldoffset:=databitsize;
  1098. varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset div 8,varalign);
  1099. end
  1100. else
  1101. begin
  1102. if tfieldvarsym(sym).getsize>high(asizeint)-_datasize then
  1103. begin
  1104. Message(sym_e_segment_too_large);
  1105. _datasize:=high(asizeint);
  1106. end
  1107. else
  1108. _datasize:=tfieldvarsym(sym).fieldoffset+offset;
  1109. { update address }
  1110. tfieldvarsym(sym).fieldoffset:=_datasize;
  1111. varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset,varalign);
  1112. end;
  1113. { update alignment of this record }
  1114. if (usefieldalignment<>C_alignment) and
  1115. (usefieldalignment<>mac68k_alignment) then
  1116. recordalignment:=max(recordalignment,varalignrecord);
  1117. end;
  1118. { update alignment for C records }
  1119. if (usefieldalignment=C_alignment) and
  1120. (usefieldalignment<>mac68k_alignment) then
  1121. recordalignment:=max(recordalignment,unionst.recordalignment);
  1122. { Register defs in the new record symtable }
  1123. for i:=0 to unionst.DefList.Count-1 do
  1124. begin
  1125. def:=TDef(unionst.DefList[i]);
  1126. def.ChangeOwner(self);
  1127. end;
  1128. _datasize:=storesize;
  1129. fieldalignment:=storealign;
  1130. { If a record contains a union, it does not contain a "single
  1131. non-composite field" in the context of certain ABIs requiring
  1132. special treatment for such records }
  1133. if defowner.typ=recorddef then
  1134. trecorddef(defowner).isunion:=true;
  1135. end;
  1136. {****************************************************************************
  1137. TObjectSymtable
  1138. ****************************************************************************}
  1139. constructor tObjectSymtable.create(adefowner:tdef;const n:string;usealign:shortint);
  1140. begin
  1141. inherited create(n,usealign);
  1142. symtabletype:=ObjectSymtable;
  1143. defowner:=adefowner;
  1144. end;
  1145. function tObjectSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  1146. var
  1147. hsym : tsym;
  1148. begin
  1149. result:=false;
  1150. if not assigned(defowner) then
  1151. internalerror(200602061);
  1152. { procsym and propertysym have special code
  1153. to override values in inherited classes. For other
  1154. symbols check for duplicates }
  1155. if not(sym.typ in [procsym,propertysym]) then
  1156. begin
  1157. { but private ids can be reused }
  1158. hsym:=search_struct_member(tobjectdef(defowner),hashedid.id);
  1159. if assigned(hsym) and
  1160. (
  1161. (
  1162. not(m_delphi in current_settings.modeswitches) and
  1163. is_visible_for_object(hsym,tobjectdef(defowner))
  1164. ) or
  1165. (
  1166. { In Delphi, you can repeat members of a parent class. You can't }
  1167. { do this for objects however, and you (obviouly) can't }
  1168. { declare two fields with the same name in a single class }
  1169. (m_delphi in current_settings.modeswitches) and
  1170. (
  1171. is_object(tdef(defowner)) or
  1172. (hsym.owner = self)
  1173. )
  1174. )
  1175. ) then
  1176. begin
  1177. DuplicateSym(hashedid,sym,hsym);
  1178. result:=true;
  1179. end;
  1180. end
  1181. else
  1182. result:=inherited checkduplicate(hashedid,sym);
  1183. end;
  1184. {****************************************************************************
  1185. TAbstractLocalSymtable
  1186. ****************************************************************************}
  1187. procedure tabstractlocalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1188. var
  1189. oldtyp : byte;
  1190. begin
  1191. oldtyp:=ppufile.entrytyp;
  1192. ppufile.entrytyp:=subentryid;
  1193. inherited ppuwrite(ppufile);
  1194. ppufile.entrytyp:=oldtyp;
  1195. end;
  1196. function tabstractlocalsymtable.count_locals:longint;
  1197. var
  1198. i : longint;
  1199. sym : tsym;
  1200. begin
  1201. result:=0;
  1202. for i:=0 to SymList.Count-1 do
  1203. begin
  1204. sym:=tsym(SymList[i]);
  1205. { Count only varsyms, but ignore the funcretsym }
  1206. if (tsym(sym).typ in [localvarsym,paravarsym]) and
  1207. (tsym(sym)<>current_procinfo.procdef.funcretsym) and
  1208. (not(vo_is_parentfp in tabstractvarsym(sym).varoptions) or
  1209. (tstoredsym(sym).refs>0)) then
  1210. inc(result);
  1211. end;
  1212. end;
  1213. {****************************************************************************
  1214. TLocalSymtable
  1215. ****************************************************************************}
  1216. constructor tlocalsymtable.create(adefowner:tdef;level:byte);
  1217. begin
  1218. inherited create('');
  1219. defowner:=adefowner;
  1220. symtabletype:=localsymtable;
  1221. symtablelevel:=level;
  1222. end;
  1223. function tlocalsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  1224. var
  1225. hsym : tsym;
  1226. begin
  1227. if not assigned(defowner) or
  1228. (defowner.typ<>procdef) then
  1229. internalerror(200602042);
  1230. result:=false;
  1231. hsym:=tsym(FindWithHash(hashedid));
  1232. if assigned(hsym) then
  1233. begin
  1234. { a local and the function can have the same
  1235. name in TP and Delphi, but RESULT not }
  1236. if (m_duplicate_names in current_settings.modeswitches) and
  1237. (hsym.typ in [absolutevarsym,localvarsym]) and
  1238. (vo_is_funcret in tabstractvarsym(hsym).varoptions) and
  1239. not((m_result in current_settings.modeswitches) and
  1240. (vo_is_result in tabstractvarsym(hsym).varoptions)) then
  1241. HideSym(hsym)
  1242. else
  1243. DuplicateSym(hashedid,sym,hsym);
  1244. result:=true;
  1245. exit;
  1246. end;
  1247. { check also parasymtable, this needs to be done here because
  1248. of the special situation with the funcret sym that needs to be
  1249. hidden for tp and delphi modes }
  1250. hsym:=tsym(tabstractprocdef(defowner).parast.FindWithHash(hashedid));
  1251. if assigned(hsym) then
  1252. begin
  1253. { a local and the function can have the same
  1254. name in TP and Delphi, but RESULT not }
  1255. if (m_duplicate_names in current_settings.modeswitches) and
  1256. (sym.typ in [absolutevarsym,localvarsym]) and
  1257. (vo_is_funcret in tabstractvarsym(sym).varoptions) and
  1258. not((m_result in current_settings.modeswitches) and
  1259. (vo_is_result in tabstractvarsym(sym).varoptions)) then
  1260. Hidesym(sym)
  1261. else
  1262. DuplicateSym(hashedid,sym,hsym);
  1263. result:=true;
  1264. exit;
  1265. end;
  1266. { check ObjectSymtable, skip this for funcret sym because
  1267. that will always be positive because it has the same name
  1268. as the procsym }
  1269. if not is_funcret_sym(sym) and
  1270. (defowner.typ=procdef) and
  1271. assigned(tprocdef(defowner).struct) and
  1272. (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
  1273. (
  1274. not(m_delphi in current_settings.modeswitches) or
  1275. is_object(tprocdef(defowner).struct)
  1276. ) then
  1277. result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
  1278. end;
  1279. {****************************************************************************
  1280. TParaSymtable
  1281. ****************************************************************************}
  1282. constructor tparasymtable.create(adefowner:tdef;level:byte);
  1283. begin
  1284. inherited create('');
  1285. readonly:=false;
  1286. defowner:=adefowner;
  1287. symtabletype:=parasymtable;
  1288. symtablelevel:=level;
  1289. end;
  1290. function tparasymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  1291. begin
  1292. result:=inherited checkduplicate(hashedid,sym);
  1293. if result then
  1294. exit;
  1295. if not(m_duplicate_names in current_settings.modeswitches) and
  1296. assigned(defowner) and (defowner.typ=procdef) and
  1297. assigned(tprocdef(defowner).struct) and
  1298. (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
  1299. (
  1300. not(m_delphi in current_settings.modeswitches) or
  1301. is_object(tprocdef(defowner).struct)
  1302. ) then
  1303. result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
  1304. end;
  1305. procedure tparasymtable.insertdef(def: TDefEntry);
  1306. begin
  1307. if readonly then
  1308. defowner.owner.insertdef(def)
  1309. else
  1310. inherited insertdef(def);
  1311. end;
  1312. {****************************************************************************
  1313. TAbstractUniTSymtable
  1314. ****************************************************************************}
  1315. constructor tabstractuniTSymtable.create(const n : string;id:word);
  1316. begin
  1317. inherited create(n);
  1318. moduleid:=id;
  1319. end;
  1320. function tabstractuniTSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  1321. var
  1322. hsym : tsym;
  1323. begin
  1324. result:=false;
  1325. hsym:=tsym(FindWithHash(hashedid));
  1326. if assigned(hsym) then
  1327. begin
  1328. if (sym is tstoredsym) and handle_generic_dummysym(hsym,tstoredsym(sym).symoptions) then
  1329. exit;
  1330. if hsym.typ=symconst.namespacesym then
  1331. begin
  1332. case sym.typ of
  1333. symconst.namespacesym:;
  1334. symconst.unitsym:
  1335. begin
  1336. HideSym(sym); { if we add a unit and there is a namespace with the same name then hide the unit name and not the namespace }
  1337. tnamespacesym(hsym).unitsym:=tsym(sym);
  1338. end
  1339. else
  1340. HideSym(hsym);
  1341. end;
  1342. end
  1343. else
  1344. { In delphi (contrary to TP) you can have a symbol with the same name as the
  1345. unit, the unit can then not be accessed anymore using
  1346. <unit>.<id>, so we can hide the symbol.
  1347. Do the same if we add a namespace and there is a unit with the same name }
  1348. if (hsym.typ=symconst.unitsym) and
  1349. ((m_delphi in current_settings.modeswitches) or (sym.typ=symconst.namespacesym)) then
  1350. begin
  1351. HideSym(hsym);
  1352. if sym.typ=symconst.namespacesym then
  1353. tnamespacesym(sym).unitsym:=tsym(hsym);
  1354. end
  1355. else
  1356. DuplicateSym(hashedid,sym,hsym);
  1357. result:=true;
  1358. exit;
  1359. end;
  1360. end;
  1361. function tabstractuniTSymtable.iscurrentunit:boolean;
  1362. begin
  1363. result:=assigned(current_module) and
  1364. (
  1365. (current_module.globalsymtable=self) or
  1366. (current_module.localsymtable=self)
  1367. );
  1368. end;
  1369. procedure tabstractuniTSymtable.insertunit(sym:TSymEntry);
  1370. var
  1371. p:integer;
  1372. n,ns:string;
  1373. oldsym:TSymEntry;
  1374. begin
  1375. insert(sym);
  1376. n:=sym.realname;
  1377. p:=pos('.',n);
  1378. ns:='';
  1379. while p>0 do
  1380. begin
  1381. if ns='' then
  1382. ns:=copy(n,1,p-1)
  1383. else
  1384. ns:=ns+'.'+copy(n,1,p-1);
  1385. system.delete(n,1,p);
  1386. oldsym:=Find(upper(ns));
  1387. if not Assigned(oldsym) or (oldsym.typ<>namespacesym) then
  1388. insert(tnamespacesym.create(ns));
  1389. p:=pos('.',n);
  1390. end;
  1391. end;
  1392. {****************************************************************************
  1393. TStaticSymtable
  1394. ****************************************************************************}
  1395. constructor tstaticsymtable.create(const n : string;id:word);
  1396. begin
  1397. inherited create(n,id);
  1398. symtabletype:=staticsymtable;
  1399. symtablelevel:=main_program_level;
  1400. currentvisibility:=vis_private;
  1401. end;
  1402. procedure tstaticsymtable.ppuload(ppufile:tcompilerppufile);
  1403. begin
  1404. inherited ppuload(ppufile);
  1405. { now we can deref the syms and defs }
  1406. deref;
  1407. end;
  1408. procedure tstaticsymtable.ppuwrite(ppufile:tcompilerppufile);
  1409. begin
  1410. inherited ppuwrite(ppufile);
  1411. end;
  1412. function tstaticsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;
  1413. begin
  1414. result:=inherited checkduplicate(hashedid,sym);
  1415. if not result and
  1416. (current_module.localsymtable=self) and
  1417. assigned(current_module.globalsymtable) then
  1418. result:=tglobalsymtable(current_module.globalsymtable).checkduplicate(hashedid,sym);
  1419. end;
  1420. {****************************************************************************
  1421. TGlobalSymtable
  1422. ****************************************************************************}
  1423. constructor tglobalsymtable.create(const n : string;id:word);
  1424. begin
  1425. inherited create(n,id);
  1426. symtabletype:=globalsymtable;
  1427. symtablelevel:=main_program_level;
  1428. end;
  1429. procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile);
  1430. begin
  1431. inherited ppuload(ppufile);
  1432. { now we can deref the syms and defs }
  1433. deref;
  1434. end;
  1435. procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1436. begin
  1437. { write the symtable entries }
  1438. inherited ppuwrite(ppufile);
  1439. end;
  1440. {*****************************************************************************
  1441. tspecializesymtable
  1442. *****************************************************************************}
  1443. constructor tspecializesymtable.create(const n : string;id:word);
  1444. begin
  1445. inherited create(n,id);
  1446. { the specialize symtable does not own the syms and defs as they are all
  1447. moved to a different symtable before the symtable is destroyed; this
  1448. avoids calls to "extract" }
  1449. symlist.ownsobjects:=false;
  1450. deflist.ownsobjects:=false;
  1451. end;
  1452. function tspecializesymtable.iscurrentunit: boolean;
  1453. begin
  1454. Result := true;
  1455. end;
  1456. {****************************************************************************
  1457. TWITHSYMTABLE
  1458. ****************************************************************************}
  1459. constructor twithsymtable.create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode});
  1460. begin
  1461. inherited create('');
  1462. symtabletype:=withsymtable;
  1463. withrefnode:=refnode;
  1464. { Replace SymList with the passed symlist }
  1465. SymList.free;
  1466. SymList:=ASymList;
  1467. defowner:=aowner;
  1468. end;
  1469. destructor twithsymtable.destroy;
  1470. begin
  1471. withrefnode.free;
  1472. { Disable SymList because we don't Own it }
  1473. SymList:=nil;
  1474. inherited destroy;
  1475. end;
  1476. procedure twithsymtable.clear;
  1477. begin
  1478. { remove no entry from a withsymtable as it is only a pointer to the
  1479. recorddef or objectdef symtable }
  1480. end;
  1481. procedure twithsymtable.insertdef(def:TDefEntry);
  1482. begin
  1483. { Definitions can't be registered in the withsymtable
  1484. because the withsymtable is removed after the with block.
  1485. We can't easily solve it here because the next symtable in the
  1486. stack is not known. }
  1487. internalerror(200602046);
  1488. end;
  1489. {****************************************************************************
  1490. TSTT_ExceptionSymtable
  1491. ****************************************************************************}
  1492. constructor tstt_excepTSymtable.create;
  1493. begin
  1494. inherited create('');
  1495. symtabletype:=stt_excepTSymtable;
  1496. end;
  1497. {****************************************************************************
  1498. TMacroSymtable
  1499. ****************************************************************************}
  1500. constructor tmacrosymtable.create(exported: boolean);
  1501. begin
  1502. inherited create('');
  1503. if exported then
  1504. symtabletype:=exportedmacrosymtable
  1505. else
  1506. symtabletype:=localmacrosymtable;
  1507. symtablelevel:=main_program_level;
  1508. end;
  1509. {****************************************************************************
  1510. TEnumSymtable
  1511. ****************************************************************************}
  1512. procedure tenumsymtable.insert(sym: TSymEntry; checkdup: boolean);
  1513. var
  1514. value: longint;
  1515. def: tenumdef;
  1516. begin
  1517. // defowner = nil only when we are loading from ppu
  1518. if defowner<>nil then
  1519. begin
  1520. { First entry? Then we need to set the minval }
  1521. value:=tenumsym(sym).value;
  1522. def:=tenumdef(defowner);
  1523. if SymList.count=0 then
  1524. begin
  1525. if value>0 then
  1526. def.has_jumps:=true;
  1527. def.setmin(value);
  1528. def.setmax(value);
  1529. end
  1530. else
  1531. begin
  1532. { check for jumps }
  1533. if value>def.max+1 then
  1534. def.has_jumps:=true;
  1535. { update low and high }
  1536. if def.min>value then
  1537. def.setmin(value);
  1538. if def.max<value then
  1539. def.setmax(value);
  1540. end;
  1541. end;
  1542. inherited insert(sym, checkdup);
  1543. end;
  1544. constructor tenumsymtable.create(adefowner: tdef);
  1545. begin
  1546. inherited Create('');
  1547. symtabletype:=enumsymtable;
  1548. defowner:=adefowner;
  1549. end;
  1550. {****************************************************************************
  1551. TArraySymtable
  1552. ****************************************************************************}
  1553. procedure tarraysymtable.insertdef(def: TDefEntry);
  1554. begin
  1555. { Enums must also be available outside the record scope,
  1556. insert in the owner of this symtable }
  1557. if def.typ=enumdef then
  1558. defowner.owner.insertdef(def)
  1559. else
  1560. inherited insertdef(def);
  1561. end;
  1562. constructor tarraysymtable.create(adefowner: tdef);
  1563. begin
  1564. inherited Create('');
  1565. symtabletype:=arraysymtable;
  1566. defowner:=adefowner;
  1567. end;
  1568. {*****************************************************************************
  1569. Helper Routines
  1570. *****************************************************************************}
  1571. function FullTypeName(def,otherdef:tdef):string;
  1572. var
  1573. s1,s2 : string;
  1574. begin
  1575. if def.typ in [objectdef,recorddef] then
  1576. s1:=tabstractrecorddef(def).RttiName
  1577. else
  1578. s1:=def.typename;
  1579. { When the names are the same try to include the unit name }
  1580. if assigned(otherdef) and
  1581. (def.owner.symtabletype in [globalsymtable,staticsymtable]) then
  1582. begin
  1583. s2:=otherdef.typename;
  1584. if upper(s1)=upper(s2) then
  1585. s1:=def.owner.realname^+'.'+s1;
  1586. end;
  1587. FullTypeName:=s1;
  1588. end;
  1589. function generate_nested_name(symtable:tsymtable;delimiter:string):string;
  1590. begin
  1591. result:='';
  1592. while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
  1593. begin
  1594. if (result='') then
  1595. result:=symtable.name^
  1596. else
  1597. result:=symtable.name^+delimiter+result;
  1598. symtable:=symtable.defowner.owner;
  1599. end;
  1600. end;
  1601. procedure incompatibletypes(def1,def2:tdef);
  1602. begin
  1603. { When there is an errordef there is already an error message show }
  1604. if (def2.typ=errordef) or
  1605. (def1.typ=errordef) then
  1606. exit;
  1607. CGMessage2(type_e_incompatible_types,FullTypeName(def1,def2),FullTypeName(def2,def1));
  1608. end;
  1609. procedure hidesym(sym:TSymEntry);
  1610. begin
  1611. sym.realname:='$hidden'+sym.realname;
  1612. tsym(sym).visibility:=vis_hidden;
  1613. end;
  1614. procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry);
  1615. var
  1616. st : TSymtable;
  1617. begin
  1618. Message1(sym_e_duplicate_id,tsym(origsym).realname);
  1619. { Write hint where the original symbol was found }
  1620. st:=finduniTSymtable(origsym.owner);
  1621. with tsym(origsym).fileinfo do
  1622. begin
  1623. if assigned(st) and
  1624. (st.symtabletype=globalsymtable) and
  1625. st.iscurrentunit then
  1626. Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line))
  1627. else if assigned(st.name) then
  1628. Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line));
  1629. end;
  1630. { Rename duplicate sym to an unreachable name, but it can be
  1631. inserted in the symtable without errors }
  1632. inc(dupnr);
  1633. hashedid.id:='dup'+tostr(dupnr)+hashedid.id;
  1634. if assigned(dupsym) then
  1635. include(tsym(dupsym).symoptions,sp_implicitrename);
  1636. end;
  1637. function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean;
  1638. begin
  1639. result:=false;
  1640. if not assigned(sym) or not (sym is tstoredsym) then
  1641. Internalerror(2011081101);
  1642. { For generics a dummy symbol without the parameter count is created
  1643. if such a symbol not yet exists so that different parts of the
  1644. parser can find that symbol. If that symbol is still a
  1645. undefineddef we replace the generic dummy symbol's
  1646. name with a "dup" name and use the new symbol as the generic dummy
  1647. symbol }
  1648. if (sp_generic_dummy in tstoredsym(sym).symoptions) and
  1649. (sym.typ=typesym) and (ttypesym(sym).typedef.typ=undefineddef) and
  1650. (m_delphi in current_settings.modeswitches) then
  1651. begin
  1652. inc(dupnr);
  1653. sym.Owner.SymList.Rename(upper(sym.realname),'dup_'+tostr(dupnr)+sym.realname);
  1654. include(tsym(sym).symoptions,sp_implicitrename);
  1655. { we need to find the new symbol now if checking for a dummy }
  1656. include(symoptions,sp_generic_dummy);
  1657. result:=true;
  1658. end;
  1659. end;
  1660. {*****************************************************************************
  1661. Search
  1662. *****************************************************************************}
  1663. procedure addsymref(sym:tsym);
  1664. var
  1665. owner: tsymtable;
  1666. begin
  1667. { symbol uses count }
  1668. sym.IncRefCount;
  1669. { unit uses count }
  1670. owner:=sym.owner;
  1671. while owner.symtabletype in [objectsymtable,recordsymtable,enumsymtable] do
  1672. owner:=tdef(owner.defowner).owner;
  1673. if assigned(current_module) and
  1674. (owner.symtabletype=globalsymtable) then
  1675. begin
  1676. if tglobalsymtable(owner).moduleid>=current_module.unitmapsize then
  1677. internalerror(200501152);
  1678. inc(current_module.unitmap[tglobalsymtable(owner).moduleid].refs);
  1679. end;
  1680. end;
  1681. function is_owned_by(childdef,ownerdef:tdef):boolean;
  1682. begin
  1683. result:=childdef=ownerdef;
  1684. if not result and assigned(childdef.owner.defowner) then
  1685. result:=is_owned_by(tdef(childdef.owner.defowner),ownerdef);
  1686. end;
  1687. function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean;
  1688. begin
  1689. result:=assigned(childsym) and (childsym.owner=symtable);
  1690. if not result and assigned(childsym) and
  1691. (childsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
  1692. result:=sym_is_owned_by(tabstractrecorddef(childsym.owner.defowner).typesym,symtable);
  1693. end;
  1694. function defs_belong_to_same_generic(def1, def2: tdef): boolean;
  1695. begin
  1696. result:=false;
  1697. if not assigned(def1) or not assigned(def2) then
  1698. exit;
  1699. { for both defs walk to the topmost generic }
  1700. while assigned(def1.owner.defowner) and (df_generic in tstoreddef(def1.owner.defowner).defoptions) do
  1701. def1:=tdef(def1.owner.defowner);
  1702. while assigned(def2.owner.defowner) and (df_generic in tstoreddef(def2.owner.defowner).defoptions) do
  1703. def2:=tdef(def2.owner.defowner);
  1704. result:=def1=def2;
  1705. end;
  1706. function get_generic_in_hierarchy_by_name(srsym: tsym; def: tdef): tdef;
  1707. var
  1708. uname : string;
  1709. begin
  1710. { TODO : check regarding arrays and records declared as their type }
  1711. if not (def.typ in [recorddef,objectdef]) then
  1712. internalerror(2012051501);
  1713. uname:=upper(srsym.realname);
  1714. repeat
  1715. if uname=copy(tabstractrecorddef(def).objname^,1,pos('$',tabstractrecorddef(def).objname^)-1) then
  1716. begin
  1717. result:=def;
  1718. exit;
  1719. end;
  1720. def:=tdef(def.owner.defowner);
  1721. until not (def.typ in [recorddef,objectdef]);
  1722. result:=nil;
  1723. end;
  1724. function return_specialization_of_generic(nesteddef,genericdef:tdef; out resultdef:tdef):boolean;
  1725. begin
  1726. { TODO : check regarding arrays and records declared as their type }
  1727. if not (nesteddef.typ in [recorddef,objectdef]) then
  1728. internalerror(2012051601);
  1729. repeat
  1730. if tstoreddef(nesteddef).genericdef=genericdef then
  1731. begin
  1732. resultdef:=nesteddef;
  1733. result:=true;
  1734. exit;
  1735. end;
  1736. nesteddef:=tdef(nesteddef.owner.defowner);
  1737. until not assigned(nesteddef) or not (nesteddef.typ in [recorddef,objectdef]);
  1738. resultdef:=nil;
  1739. result:=false;
  1740. end;
  1741. function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
  1742. var
  1743. symownerdef : tabstractrecorddef;
  1744. begin
  1745. result:=false;
  1746. { Get objdectdef owner of the symtable for the is_related checks }
  1747. if not assigned(symst) or
  1748. not (symst.symtabletype in [objectsymtable,recordsymtable]) then
  1749. internalerror(200810285);
  1750. symownerdef:=tabstractrecorddef(symst.defowner);
  1751. case symvisibility of
  1752. vis_private :
  1753. begin
  1754. { private symbols are allowed when we are in the same
  1755. module as they are defined }
  1756. result:=(
  1757. (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
  1758. (symownerdef.owner.iscurrentunit)
  1759. ) or
  1760. ( // the case of specialize inside the generic declaration and nested types
  1761. (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
  1762. (
  1763. assigned(current_structdef) and
  1764. (
  1765. (current_structdef=symownerdef) or
  1766. (current_structdef.owner.iscurrentunit)
  1767. )
  1768. ) or
  1769. (
  1770. not assigned(current_structdef) and
  1771. (symownerdef.owner.iscurrentunit)
  1772. )
  1773. );
  1774. end;
  1775. vis_strictprivate :
  1776. begin
  1777. result:=assigned(current_structdef) and
  1778. is_owned_by(current_structdef,symownerdef);
  1779. end;
  1780. vis_strictprotected :
  1781. begin
  1782. result:=(
  1783. assigned(current_structdef) and
  1784. (current_structdef.is_related(symownerdef) or
  1785. is_owned_by(current_structdef,symownerdef))
  1786. ) or
  1787. (
  1788. { helpers can access strict protected symbols }
  1789. is_objectpascal_helper(contextobjdef) and
  1790. tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
  1791. );
  1792. end;
  1793. vis_protected :
  1794. begin
  1795. { protected symbols are visible in the module that defines them and
  1796. also visible to related objects. The related object must be defined
  1797. in the current module }
  1798. result:=(
  1799. (
  1800. (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
  1801. (symownerdef.owner.iscurrentunit)
  1802. ) or
  1803. (
  1804. assigned(contextobjdef) and
  1805. (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable]) and
  1806. (contextobjdef.owner.iscurrentunit) and
  1807. contextobjdef.is_related(symownerdef)
  1808. ) or
  1809. ( // the case of specialize inside the generic declaration and nested types
  1810. (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
  1811. (
  1812. assigned(current_structdef) and
  1813. (
  1814. (current_structdef=symownerdef) or
  1815. (current_structdef.owner.iscurrentunit)
  1816. )
  1817. ) or
  1818. (
  1819. not assigned(current_structdef) and
  1820. (symownerdef.owner.iscurrentunit)
  1821. ) or
  1822. (
  1823. { helpers can access protected symbols }
  1824. is_objectpascal_helper(contextobjdef) and
  1825. tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
  1826. )
  1827. )
  1828. );
  1829. end;
  1830. vis_public,
  1831. vis_published :
  1832. result:=true;
  1833. end;
  1834. end;
  1835. function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
  1836. begin
  1837. result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef);
  1838. end;
  1839. function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
  1840. var
  1841. i : longint;
  1842. pd : tprocdef;
  1843. begin
  1844. if sym.typ=procsym then
  1845. begin
  1846. { A procsym is visible, when there is at least one of the procdefs visible }
  1847. result:=false;
  1848. for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
  1849. begin
  1850. pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
  1851. if (pd.owner=sym.owner) and
  1852. is_visible_for_object(pd,contextobjdef) then
  1853. begin
  1854. result:=true;
  1855. exit;
  1856. end;
  1857. end;
  1858. end
  1859. else
  1860. result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
  1861. end;
  1862. function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  1863. begin
  1864. result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,false,sp_none);
  1865. end;
  1866. function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean;
  1867. var
  1868. hashedid : THashedIDString;
  1869. contextstructdef : tabstractrecorddef;
  1870. stackitem : psymtablestackitem;
  1871. begin
  1872. result:=false;
  1873. hashedid.id:=s;
  1874. stackitem:=symtablestack.stack;
  1875. while assigned(stackitem) do
  1876. begin
  1877. srsymtable:=stackitem^.symtable;
  1878. if (srsymtable.symtabletype=objectsymtable) then
  1879. begin
  1880. { TODO : implement the search for an option in classes as well }
  1881. if searchoption then
  1882. begin
  1883. result:=false;
  1884. exit;
  1885. end;
  1886. if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
  1887. begin
  1888. result:=true;
  1889. exit;
  1890. end;
  1891. end
  1892. else
  1893. begin
  1894. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  1895. if assigned(srsym) then
  1896. begin
  1897. { use the class from withsymtable only when it is
  1898. defined in this unit }
  1899. if (srsymtable.symtabletype=withsymtable) and
  1900. assigned(srsymtable.defowner) and
  1901. (srsymtable.defowner.typ in [recorddef,objectdef]) and
  1902. (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and
  1903. (srsymtable.defowner.owner.iscurrentunit) then
  1904. contextstructdef:=tabstractrecorddef(srsymtable.defowner)
  1905. else
  1906. contextstructdef:=current_structdef;
  1907. if not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or
  1908. is_visible_for_object(srsym,contextstructdef) and
  1909. (not searchoption or (option in srsym.symoptions)) then
  1910. begin
  1911. { we need to know if a procedure references symbols
  1912. in the static symtable, because then it can't be
  1913. inlined from outside this unit }
  1914. if assigned(current_procinfo) and
  1915. (srsym.owner.symtabletype=staticsymtable) then
  1916. include(current_procinfo.flags,pi_uses_static_symtable);
  1917. addsymref(srsym);
  1918. result:=true;
  1919. exit;
  1920. end;
  1921. end;
  1922. end;
  1923. stackitem:=stackitem^.next;
  1924. end;
  1925. srsym:=nil;
  1926. srsymtable:=nil;
  1927. end;
  1928. function searchsym_with_symoption(const s: TIDString;out srsym:tsym;out
  1929. srsymtable:TSymtable;option:tsymoption):boolean;
  1930. begin
  1931. result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,true,option);
  1932. end;
  1933. function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  1934. var
  1935. hashedid : THashedIDString;
  1936. stackitem : psymtablestackitem;
  1937. classh : tobjectdef;
  1938. begin
  1939. result:=false;
  1940. hashedid.id:=s;
  1941. stackitem:=symtablestack.stack;
  1942. while assigned(stackitem) do
  1943. begin
  1944. {
  1945. It is not possible to have type symbols in:
  1946. parameters
  1947. Exception are classes, objects, records, generic definitions and specializations
  1948. that have the parameterized types inserted in the symtable.
  1949. }
  1950. srsymtable:=stackitem^.symtable;
  1951. if (srsymtable.symtabletype=ObjectSymtable) then
  1952. begin
  1953. classh:=tobjectdef(srsymtable.defowner);
  1954. while assigned(classh) do
  1955. begin
  1956. srsymtable:=classh.symtable;
  1957. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  1958. if assigned(srsym) and
  1959. not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
  1960. is_visible_for_object(srsym,current_structdef) then
  1961. begin
  1962. addsymref(srsym);
  1963. result:=true;
  1964. exit;
  1965. end;
  1966. classh:=classh.childof;
  1967. end;
  1968. end
  1969. else
  1970. begin
  1971. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  1972. if assigned(srsym) and
  1973. not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
  1974. (not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or is_visible_for_object(srsym,current_structdef)) then
  1975. begin
  1976. { we need to know if a procedure references symbols
  1977. in the static symtable, because then it can't be
  1978. inlined from outside this unit }
  1979. if assigned(current_procinfo) and
  1980. (srsym.owner.symtabletype=staticsymtable) then
  1981. include(current_procinfo.flags,pi_uses_static_symtable);
  1982. addsymref(srsym);
  1983. result:=true;
  1984. exit;
  1985. end;
  1986. end;
  1987. stackitem:=stackitem^.next;
  1988. end;
  1989. result:=false;
  1990. srsym:=nil;
  1991. srsymtable:=nil;
  1992. end;
  1993. function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  1994. var
  1995. pmod : tmodule;
  1996. begin
  1997. pmod:=tmodule(pm);
  1998. result:=false;
  1999. if assigned(pmod.globalsymtable) then
  2000. begin
  2001. srsym:=tsym(pmod.globalsymtable.Find(s));
  2002. if assigned(srsym) then
  2003. begin
  2004. srsymtable:=pmod.globalsymtable;
  2005. addsymref(srsym);
  2006. result:=true;
  2007. exit;
  2008. end;
  2009. end;
  2010. { If the module is the current unit we also need
  2011. to search the local symtable }
  2012. if (pmod=current_module) and
  2013. assigned(pmod.localsymtable) then
  2014. begin
  2015. srsym:=tsym(pmod.localsymtable.Find(s));
  2016. if assigned(srsym) then
  2017. begin
  2018. srsymtable:=pmod.localsymtable;
  2019. addsymref(srsym);
  2020. result:=true;
  2021. exit;
  2022. end;
  2023. end;
  2024. srsym:=nil;
  2025. srsymtable:=nil;
  2026. end;
  2027. function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
  2028. var
  2029. stackitem : psymtablestackitem;
  2030. begin
  2031. result:=false;
  2032. stackitem:=symtablestack.stack;
  2033. while assigned(stackitem) do
  2034. begin
  2035. srsymtable:=stackitem^.symtable;
  2036. if (srsymtable.symtabletype=globalsymtable) and
  2037. (srsymtable.name^=unitname) then
  2038. begin
  2039. srsym:=tsym(srsymtable.find(symname));
  2040. if not assigned(srsym) then
  2041. break;
  2042. result:=true;
  2043. exit;
  2044. end;
  2045. stackitem:=stackitem^.next;
  2046. end;
  2047. { If the module is the current unit we also need
  2048. to search the local symtable }
  2049. if assigned(current_module.localsymtable) and
  2050. (current_module.localsymtable.name^=unitname) then
  2051. begin
  2052. srsymtable:=current_module.localsymtable;
  2053. srsym:=tsym(srsymtable.find(symname));
  2054. if assigned(srsym) then
  2055. begin
  2056. result:=true;
  2057. exit;
  2058. end;
  2059. end;
  2060. end;
  2061. function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef;
  2062. begin
  2063. result:=pd;
  2064. if pd.typ<>objectdef then
  2065. exit;
  2066. result:=find_real_class_definition(tobjectdef(pd),erroronfailure);
  2067. end;
  2068. function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
  2069. var
  2070. hashedid : THashedIDString;
  2071. stackitem : psymtablestackitem;
  2072. srsymtable : tsymtable;
  2073. srsym : tsym;
  2074. formalname,
  2075. foundname : shortstring;
  2076. formalnameptr,
  2077. foundnameptr: pshortstring;
  2078. begin
  2079. { not a formal definition -> return it }
  2080. if not(oo_is_formal in pd.objectoptions) then
  2081. begin
  2082. result:=pd;
  2083. exit;
  2084. end;
  2085. hashedid.id:=pd.typesym.name;
  2086. stackitem:=symtablestack.stack;
  2087. while assigned(stackitem) do
  2088. begin
  2089. srsymtable:=stackitem^.symtable;
  2090. { ObjC classes can't appear in generics or as nested class
  2091. definitions. Java classes can. }
  2092. if not(srsymtable.symtabletype in [recordsymtable,parasymtable]) or
  2093. (is_java_class_or_interface(pd) and
  2094. (srsymtable.symtabletype=ObjectSymtable)) then
  2095. begin
  2096. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2097. if assigned(srsym) and
  2098. (srsym.typ=typesym) and
  2099. (ttypesym(srsym).typedef.typ=objectdef) and
  2100. (tobjectdef(ttypesym(srsym).typedef).objecttype=pd.objecttype) and
  2101. not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
  2102. begin
  2103. if not(oo_is_forward in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
  2104. begin
  2105. { the external name for the formal and the real
  2106. definition must match }
  2107. if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) or
  2108. assigned(pd.import_lib) then
  2109. begin
  2110. if assigned(pd.import_lib) then
  2111. formalname:=pd.import_lib^+'.'
  2112. else
  2113. formalname:='';
  2114. formalname:=formalname+pd.objextname^;
  2115. if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) then
  2116. foundname:=tobjectdef(ttypesym(srsym).typedef).import_lib^+'.'
  2117. else
  2118. foundname:='';
  2119. foundname:=foundname+tobjectdef(ttypesym(srsym).typedef).objextname^;
  2120. formalnameptr:=@formalname;
  2121. foundnameptr:=@foundname;
  2122. end
  2123. else
  2124. begin
  2125. formalnameptr:=pd.objextname;
  2126. foundnameptr:=tobjectdef(ttypesym(srsym).typedef).objextname;
  2127. end;
  2128. if foundnameptr^<>formalnameptr^ then
  2129. begin
  2130. MessagePos2(pd.typesym.fileinfo,sym_e_external_class_name_mismatch1,formalnameptr^,pd.typename);
  2131. MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,foundnameptr^);
  2132. end;
  2133. end;
  2134. result:=tobjectdef(ttypesym(srsym).typedef);
  2135. if assigned(current_procinfo) and
  2136. (srsym.owner.symtabletype=staticsymtable) then
  2137. include(current_procinfo.flags,pi_uses_static_symtable);
  2138. addsymref(srsym);
  2139. exit;
  2140. end;
  2141. end;
  2142. stackitem:=stackitem^.next;
  2143. end;
  2144. { nothing found: optionally give an error and return the original
  2145. (empty) one }
  2146. if erroronfailure then
  2147. Message1(sym_e_formal_class_not_resolved,pd.objrealname^);
  2148. result:=pd;
  2149. end;
  2150. function searchsym_in_class(classh: tobjectdef;contextclassh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
  2151. var
  2152. hashedid : THashedIDString;
  2153. orgclass : tobjectdef;
  2154. i : longint;
  2155. hlpsrsym : tsym;
  2156. hlpsrsymtable : tsymtable;
  2157. begin
  2158. orgclass:=classh;
  2159. { in case this is a formal class, first find the real definition }
  2160. if assigned(classh) then
  2161. begin
  2162. if (oo_is_formal in classh.objectoptions) then
  2163. classh:=find_real_class_definition(classh,true);
  2164. { The contextclassh is used for visibility. The classh must be equal to
  2165. or be a parent of contextclassh. E.g. for inherited searches the classh is the
  2166. parent or a class helper. }
  2167. if not (contextclassh.is_related(classh) or
  2168. (is_classhelper(contextclassh) and
  2169. assigned(tobjectdef(contextclassh).extendeddef) and
  2170. (tobjectdef(contextclassh).extendeddef.typ=objectdef) and
  2171. tobjectdef(contextclassh).extendeddef.is_related(classh))) then
  2172. internalerror(200811161);
  2173. end;
  2174. result:=false;
  2175. hashedid.id:=s;
  2176. { an Objective-C protocol or Java interface can inherit from multiple
  2177. other protocols/interfaces -> use ImplementedInterfaces instead }
  2178. if is_objcprotocol(classh) or
  2179. is_javainterface(classh) then
  2180. begin
  2181. srsymtable:=classh.symtable;
  2182. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2183. if assigned(srsym) and
  2184. is_visible_for_object(srsym,contextclassh) then
  2185. begin
  2186. addsymref(srsym);
  2187. result:=true;
  2188. exit;
  2189. end;
  2190. for i:=0 to classh.ImplementedInterfaces.count-1 do
  2191. begin
  2192. if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,false) then
  2193. begin
  2194. result:=true;
  2195. exit;
  2196. end;
  2197. end;
  2198. end
  2199. else
  2200. if is_objectpascal_helper(classh) then
  2201. begin
  2202. { helpers have their own obscure search logic... }
  2203. result:=searchsym_in_helper(classh,tobjectdef(contextclassh),s,srsym,srsymtable,false);
  2204. if result then
  2205. exit;
  2206. end
  2207. else
  2208. begin
  2209. hlpsrsym:=nil;
  2210. hlpsrsymtable:=nil;
  2211. while assigned(classh) do
  2212. begin
  2213. { search for a class helper method first if this is an Object
  2214. Pascal class and we haven't yet found a helper symbol }
  2215. if is_class(classh) and searchhelper and not assigned(hlpsrsym) then
  2216. begin
  2217. result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
  2218. if result then
  2219. { if the procsym is overloaded we need to use the
  2220. "original" symbol; the helper symbol will be found when
  2221. searching for overloads }
  2222. if (srsym.typ<>procsym) or
  2223. not (sp_has_overloaded in tprocsym(srsym).symoptions) then
  2224. exit
  2225. else
  2226. begin
  2227. { remember the found symbol if the class hierarchy
  2228. should not contain the a method with that name }
  2229. hlpsrsym:=srsym;
  2230. hlpsrsymtable:=srsymtable;
  2231. end;
  2232. end;
  2233. srsymtable:=classh.symtable;
  2234. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2235. if assigned(srsym) and
  2236. is_visible_for_object(srsym,contextclassh) then
  2237. begin
  2238. addsymref(srsym);
  2239. result:=true;
  2240. exit;
  2241. end;
  2242. classh:=classh.childof;
  2243. end;
  2244. { did we find a helper symbol, but no symbol with the same name in
  2245. the extended object's hierarchy? }
  2246. if assigned(hlpsrsym) then
  2247. begin
  2248. srsym:=hlpsrsym;
  2249. srsymtable:=hlpsrsymtable;
  2250. result:=true;
  2251. exit;
  2252. end;
  2253. end;
  2254. if is_objcclass(orgclass) then
  2255. result:=search_objc_helper(orgclass,s,srsym,srsymtable)
  2256. else
  2257. begin
  2258. srsym:=nil;
  2259. srsymtable:=nil;
  2260. end;
  2261. end;
  2262. function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
  2263. var
  2264. hashedid : THashedIDString;
  2265. hlpsrsym : tsym;
  2266. hlpsrsymtable : tsymtable;
  2267. begin
  2268. result:=false;
  2269. hlpsrsym:=nil;
  2270. hlpsrsymtable:=nil;
  2271. hashedid.id:=s;
  2272. { search for a record helper method first }
  2273. result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
  2274. if result then
  2275. { if the procsym is overloaded we need to use the
  2276. "original" symbol; the helper symbol will be found when
  2277. searching for overloads }
  2278. if (srsym.typ<>procsym) or
  2279. not (sp_has_overloaded in tprocsym(srsym).symoptions) then
  2280. exit
  2281. else
  2282. begin
  2283. { remember the found symbol if we should not find a symbol with
  2284. the same name in the extended record }
  2285. hlpsrsym:=srsym;
  2286. hlpsrsymtable:=srsymtable;
  2287. end;
  2288. srsymtable:=recordh.symtable;
  2289. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2290. if assigned(srsym) and is_visible_for_object(srsym,recordh) then
  2291. begin
  2292. addsymref(srsym);
  2293. result:=true;
  2294. exit;
  2295. end;
  2296. srsym:=hlpsrsym;
  2297. srsymtable:=hlpsrsymtable;
  2298. result:=assigned(srsym);
  2299. end;
  2300. function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
  2301. var
  2302. def : tdef;
  2303. i : longint;
  2304. begin
  2305. { in case this is a formal class, first find the real definition }
  2306. if assigned(classh) and
  2307. (oo_is_formal in classh.objectoptions) then
  2308. classh:=find_real_class_definition(classh,true);
  2309. result:=false;
  2310. def:=nil;
  2311. while assigned(classh) do
  2312. begin
  2313. for i:=0 to classh.symtable.DefList.Count-1 do
  2314. begin
  2315. def:=tstoreddef(classh.symtable.DefList[i]);
  2316. { Find also all hidden private methods to
  2317. be compatible with delphi, see tw6203 (PFV) }
  2318. if (def.typ=procdef) and
  2319. (po_msgint in tprocdef(def).procoptions) and
  2320. (tprocdef(def).messageinf.i=msgid) then
  2321. begin
  2322. srdef:=def;
  2323. srsym:=tprocdef(def).procsym;
  2324. srsymtable:=classh.symtable;
  2325. addsymref(srsym);
  2326. result:=true;
  2327. exit;
  2328. end;
  2329. end;
  2330. classh:=classh.childof;
  2331. end;
  2332. srdef:=nil;
  2333. srsym:=nil;
  2334. srsymtable:=nil;
  2335. end;
  2336. function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
  2337. var
  2338. def : tdef;
  2339. i : longint;
  2340. begin
  2341. { in case this is a formal class, first find the real definition }
  2342. if assigned(classh) and
  2343. (oo_is_formal in classh.objectoptions) then
  2344. classh:=find_real_class_definition(classh,true);
  2345. result:=false;
  2346. def:=nil;
  2347. while assigned(classh) do
  2348. begin
  2349. for i:=0 to classh.symtable.DefList.Count-1 do
  2350. begin
  2351. def:=tstoreddef(classh.symtable.DefList[i]);
  2352. { Find also all hidden private methods to
  2353. be compatible with delphi, see tw6203 (PFV) }
  2354. if (def.typ=procdef) and
  2355. (po_msgstr in tprocdef(def).procoptions) and
  2356. (tprocdef(def).messageinf.str^=s) then
  2357. begin
  2358. srsym:=tprocdef(def).procsym;
  2359. srsymtable:=classh.symtable;
  2360. addsymref(srsym);
  2361. result:=true;
  2362. exit;
  2363. end;
  2364. end;
  2365. classh:=classh.childof;
  2366. end;
  2367. srsym:=nil;
  2368. srsymtable:=nil;
  2369. end;
  2370. function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
  2371. var
  2372. hashedid : THashedIDString;
  2373. parentclassh : tobjectdef;
  2374. begin
  2375. result:=false;
  2376. if not is_objectpascal_helper(classh) then
  2377. Internalerror(2011030101);
  2378. hashedid.id:=s;
  2379. { in a helper things are a bit more complex:
  2380. 1. search the symbol in the helper (if not "inherited")
  2381. 2. search the symbol in the extended type
  2382. 3. search the symbol in the parent helpers
  2383. 4. only classes: search the symbol in the parents of the extended type
  2384. }
  2385. if not aHasInherited then
  2386. begin
  2387. { search in the helper itself }
  2388. srsymtable:=classh.symtable;
  2389. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2390. if assigned(srsym) and
  2391. is_visible_for_object(srsym,contextclassh) then
  2392. begin
  2393. addsymref(srsym);
  2394. result:=true;
  2395. exit;
  2396. end;
  2397. end;
  2398. { now search in the extended type itself }
  2399. if classh.extendeddef.typ in [recorddef,objectdef] then
  2400. begin
  2401. srsymtable:=tabstractrecorddef(classh.extendeddef).symtable;
  2402. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2403. if assigned(srsym) and
  2404. is_visible_for_object(srsym,contextclassh) then
  2405. begin
  2406. addsymref(srsym);
  2407. result:=true;
  2408. exit;
  2409. end;
  2410. end;
  2411. { now search in the parent helpers }
  2412. parentclassh:=classh.childof;
  2413. while assigned(parentclassh) do
  2414. begin
  2415. srsymtable:=parentclassh.symtable;
  2416. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2417. if assigned(srsym) and
  2418. is_visible_for_object(srsym,contextclassh) then
  2419. begin
  2420. addsymref(srsym);
  2421. result:=true;
  2422. exit;
  2423. end;
  2424. parentclassh:=parentclassh.childof;
  2425. end;
  2426. if is_class(classh.extendeddef) then
  2427. { now search in the parents of the extended class (with helpers!) }
  2428. result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,true);
  2429. { addsymref is already called by searchsym_in_class }
  2430. end;
  2431. function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef;
  2432. var
  2433. sym : Tprocsym;
  2434. hashedid : THashedIDString;
  2435. curreq,
  2436. besteq : tequaltype;
  2437. currpd,
  2438. bestpd : tprocdef;
  2439. stackitem : psymtablestackitem;
  2440. begin
  2441. hashedid.id:=overloaded_names[assignment_type];
  2442. besteq:=te_incompatible;
  2443. bestpd:=nil;
  2444. stackitem:=symtablestack.stack;
  2445. while assigned(stackitem) do
  2446. begin
  2447. sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid));
  2448. if sym<>nil then
  2449. begin
  2450. if sym.typ<>procsym then
  2451. internalerror(200402031);
  2452. { if the source type is an alias then this is only the second choice,
  2453. if you mess with this code, check tw4093 }
  2454. currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq);
  2455. if curreq>besteq then
  2456. begin
  2457. besteq:=curreq;
  2458. bestpd:=currpd;
  2459. if (besteq=te_exact) then
  2460. break;
  2461. end;
  2462. end;
  2463. stackitem:=stackitem^.next;
  2464. end;
  2465. result:=bestpd;
  2466. end;
  2467. function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
  2468. begin
  2469. { search record/object symtable first for a suitable operator }
  2470. if from_def.typ in [recorddef,objectdef] then
  2471. symtablestack.push(tabstractrecorddef(from_def).symtable);
  2472. if to_def.typ in [recorddef,objectdef] then
  2473. symtablestack.push(tabstractrecorddef(to_def).symtable);
  2474. { if type conversion is explicit then search first for explicit
  2475. operator overload and if not found then use implicit operator }
  2476. if explicit then
  2477. result:=search_specific_assignment_operator(_OP_EXPLICIT,from_def,to_def)
  2478. else
  2479. result:=nil;
  2480. if result=nil then
  2481. result:=search_specific_assignment_operator(_ASSIGNMENT,from_def,to_def);
  2482. { restore symtable stack }
  2483. if to_def.typ in [recorddef,objectdef] then
  2484. symtablestack.pop(tabstractrecorddef(to_def).symtable);
  2485. if from_def.typ in [recorddef,objectdef] then
  2486. symtablestack.pop(tabstractrecorddef(from_def).symtable);
  2487. end;
  2488. function search_enumerator_operator(from_def,to_def:Tdef): Tprocdef;
  2489. var
  2490. sym : Tprocsym;
  2491. hashedid : THashedIDString;
  2492. curreq,
  2493. besteq : tequaltype;
  2494. currpd,
  2495. bestpd : tprocdef;
  2496. stackitem : psymtablestackitem;
  2497. begin
  2498. hashedid.id:='enumerator';
  2499. besteq:=te_incompatible;
  2500. bestpd:=nil;
  2501. stackitem:=symtablestack.stack;
  2502. while assigned(stackitem) do
  2503. begin
  2504. sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid));
  2505. if sym<>nil then
  2506. begin
  2507. if sym.typ<>procsym then
  2508. internalerror(200910241);
  2509. { if the source type is an alias then this is only the second choice,
  2510. if you mess with this code, check tw4093 }
  2511. currpd:=sym.find_procdef_enumerator_operator(from_def,to_def,curreq);
  2512. if curreq>besteq then
  2513. begin
  2514. besteq:=curreq;
  2515. bestpd:=currpd;
  2516. if (besteq=te_exact) then
  2517. break;
  2518. end;
  2519. end;
  2520. stackitem:=stackitem^.next;
  2521. end;
  2522. result:=bestpd;
  2523. end;
  2524. function search_system_type(const s: TIDString): ttypesym;
  2525. var
  2526. sym : tsym;
  2527. begin
  2528. sym:=tsym(systemunit.Find(s));
  2529. if not assigned(sym) or
  2530. (sym.typ<>typesym) then
  2531. cgmessage1(cg_f_unknown_system_type,s);
  2532. result:=ttypesym(sym);
  2533. end;
  2534. function try_search_system_type(const s: TIDString): ttypesym;
  2535. var
  2536. sym : tsym;
  2537. begin
  2538. sym:=tsym(systemunit.Find(s));
  2539. if not assigned(sym) then
  2540. result:=nil
  2541. else
  2542. begin
  2543. if sym.typ<>typesym then
  2544. cgmessage1(cg_f_unknown_system_type,s);
  2545. result:=ttypesym(sym);
  2546. end;
  2547. end;
  2548. function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
  2549. var
  2550. srsymtable: tsymtable;
  2551. sym: tsym;
  2552. begin
  2553. if searchsym_in_named_module(unitname,typename,sym,srsymtable) and
  2554. (sym.typ=typesym) then
  2555. begin
  2556. result:=ttypesym(sym);
  2557. exit;
  2558. end
  2559. else
  2560. begin
  2561. if throwerror then
  2562. cgmessage2(cg_f_unknown_type_in_unit,typename,unitname);
  2563. result:=nil;
  2564. end;
  2565. end;
  2566. function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
  2567. var
  2568. s: string;
  2569. list: TFPObjectList;
  2570. i: integer;
  2571. st: tsymtable;
  2572. begin
  2573. result:=false;
  2574. odef:=nil;
  2575. { when there are no helpers active currently then we don't need to do
  2576. anything }
  2577. if current_module.extendeddefs.count=0 then
  2578. exit;
  2579. { no helpers for anonymous types }
  2580. if not assigned(pd.objrealname) or (pd.objrealname^='') then
  2581. exit;
  2582. { if pd is defined inside a procedure we must not use make_mangledname
  2583. (as a helper may not be defined in a procedure this is no problem...)}
  2584. st:=pd.owner;
  2585. while st.symtabletype in [objectsymtable,recordsymtable] do
  2586. st:=st.defowner.owner;
  2587. if st.symtabletype=localsymtable then
  2588. exit;
  2589. { the mangled name is used as the key for tmodule.extendeddefs }
  2590. s:=make_mangledname('',pd.symtable,'');
  2591. list:=TFPObjectList(current_module.extendeddefs.Find(s));
  2592. if assigned(list) and (list.count>0) then
  2593. begin
  2594. i:=list.count-1;
  2595. repeat
  2596. odef:=tobjectdef(list[list.count-1]);
  2597. result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
  2598. is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
  2599. dec(i);
  2600. until result or (i<0);
  2601. if not result then
  2602. { just to be sure that noone uses odef }
  2603. odef:=nil;
  2604. end;
  2605. end;
  2606. function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  2607. var
  2608. hashedid : THashedIDString;
  2609. classh : tobjectdef;
  2610. i : integer;
  2611. pdef : tprocdef;
  2612. begin
  2613. result:=false;
  2614. { if there is no class helper for the class then there is no need to
  2615. search further }
  2616. if not search_last_objectpascal_helper(pd,contextclassh,classh) then
  2617. exit;
  2618. hashedid.id:=s;
  2619. repeat
  2620. srsymtable:=classh.symtable;
  2621. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2622. if srsym<>nil then
  2623. begin
  2624. if srsym.typ=propertysym then
  2625. begin
  2626. result:=true;
  2627. exit;
  2628. end;
  2629. for i:=0 to tprocsym(srsym).procdeflist.count-1 do
  2630. begin
  2631. pdef:=tprocdef(tprocsym(srsym).procdeflist[i]);
  2632. if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then
  2633. continue;
  2634. { we need to know if a procedure references symbols
  2635. in the static symtable, because then it can't be
  2636. inlined from outside this unit }
  2637. if assigned(current_procinfo) and
  2638. (srsym.owner.symtabletype=staticsymtable) then
  2639. include(current_procinfo.flags,pi_uses_static_symtable);
  2640. { the first found method wins }
  2641. srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
  2642. srsymtable:=srsym.owner;
  2643. addsymref(srsym);
  2644. result:=true;
  2645. exit;
  2646. end;
  2647. end;
  2648. { try the helper parent if available }
  2649. classh:=classh.childof;
  2650. until classh=nil;
  2651. srsym:=nil;
  2652. srsymtable:=nil;
  2653. end;
  2654. function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  2655. var
  2656. hashedid : THashedIDString;
  2657. stackitem : psymtablestackitem;
  2658. i : longint;
  2659. defowner : tobjectdef;
  2660. begin
  2661. hashedid.id:=class_helper_prefix+s;
  2662. stackitem:=symtablestack.stack;
  2663. while assigned(stackitem) do
  2664. begin
  2665. srsymtable:=stackitem^.symtable;
  2666. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2667. if assigned(srsym) then
  2668. begin
  2669. if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or
  2670. not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or
  2671. (srsym.typ<>procsym) then
  2672. internalerror(2009111505);
  2673. { check whether this procsym includes a helper for this particular class }
  2674. for i:=0 to tprocsym(srsym).procdeflist.count-1 do
  2675. begin
  2676. { does pd inherit from (or is the same as) the class
  2677. that this method's category extended?
  2678. Warning: this list contains both category and objcclass methods
  2679. (for id.randommethod), so only check category methods here
  2680. }
  2681. defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner);
  2682. if (oo_is_classhelper in defowner.objectoptions) and
  2683. pd.is_related(defowner.childof) then
  2684. begin
  2685. { we need to know if a procedure references symbols
  2686. in the static symtable, because then it can't be
  2687. inlined from outside this unit }
  2688. if assigned(current_procinfo) and
  2689. (srsym.owner.symtabletype=staticsymtable) then
  2690. include(current_procinfo.flags,pi_uses_static_symtable);
  2691. { no need to keep looking. There might be other
  2692. categories that extend this, a parent or child
  2693. class with a method with the same name (either
  2694. overriding this one, or overridden by this one),
  2695. but that doesn't matter as far as the basic
  2696. procsym is concerned.
  2697. }
  2698. srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
  2699. srsymtable:=srsym.owner;
  2700. addsymref(srsym);
  2701. result:=true;
  2702. exit;
  2703. end;
  2704. end;
  2705. end;
  2706. stackitem:=stackitem^.next;
  2707. end;
  2708. srsym:=nil;
  2709. srsymtable:=nil;
  2710. result:=false;
  2711. end;
  2712. function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
  2713. var
  2714. hashedid : THashedIDString;
  2715. stackitem : psymtablestackitem;
  2716. i : longint;
  2717. begin
  2718. hashedid.id:=class_helper_prefix+s;
  2719. stackitem:=symtablestack.stack;
  2720. while assigned(stackitem) do
  2721. begin
  2722. srsymtable:=stackitem^.symtable;
  2723. srsym:=tsym(srsymtable.FindWithHash(hashedid));
  2724. if assigned(srsym) then
  2725. begin
  2726. if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or
  2727. not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or
  2728. (srsym.typ<>procsym) then
  2729. internalerror(2009112005);
  2730. { check whether this procsym includes a helper for this particular class }
  2731. for i:=0 to tprocsym(srsym).procdeflist.count-1 do
  2732. begin
  2733. { we need to know if a procedure references symbols
  2734. in the static symtable, because then it can't be
  2735. inlined from outside this unit }
  2736. if assigned(current_procinfo) and
  2737. (srsym.owner.symtabletype=staticsymtable) then
  2738. include(current_procinfo.flags,pi_uses_static_symtable);
  2739. { no need to keep looking. There might be other
  2740. methods with the same name, but that doesn't matter
  2741. as far as the basic procsym is concerned.
  2742. }
  2743. srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
  2744. { We need the symtable in which the classhelper-like sym
  2745. is located, not the objectdef. The reason is that the
  2746. callnode will climb the symtablestack until it encounters
  2747. this symtable to start looking for overloads (and it won't
  2748. find the objectsymtable in which this method sym is
  2749. located
  2750. srsymtable:=srsym.owner;
  2751. }
  2752. addsymref(srsym);
  2753. result:=true;
  2754. exit;
  2755. end;
  2756. end;
  2757. stackitem:=stackitem^.next;
  2758. end;
  2759. srsym:=nil;
  2760. srsymtable:=nil;
  2761. result:=false;
  2762. end;
  2763. function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
  2764. { searches n in symtable of pd and all anchestors }
  2765. var
  2766. hashedid : THashedIDString;
  2767. srsym : tsym;
  2768. orgpd : tabstractrecorddef;
  2769. srsymtable : tsymtable;
  2770. begin
  2771. { in case this is a formal class, first find the real definition }
  2772. if (oo_is_formal in pd.objectoptions) then
  2773. pd:=find_real_class_definition(tobjectdef(pd),true);
  2774. if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
  2775. exit;
  2776. hashedid.id:=s;
  2777. orgpd:=pd;
  2778. while assigned(pd) do
  2779. begin
  2780. srsym:=tsym(pd.symtable.FindWithHash(hashedid));
  2781. if assigned(srsym) then
  2782. begin
  2783. search_struct_member:=srsym;
  2784. exit;
  2785. end;
  2786. if pd.typ=objectdef then
  2787. pd:=tobjectdef(pd).childof
  2788. else
  2789. pd:=nil;
  2790. end;
  2791. { not found, now look for class helpers }
  2792. if is_objcclass(pd) then
  2793. search_objc_helper(tobjectdef(orgpd),s,result,srsymtable)
  2794. else
  2795. result:=nil;
  2796. end;
  2797. function search_macro(const s : string):tsym;
  2798. var
  2799. stackitem : psymtablestackitem;
  2800. hashedid : THashedIDString;
  2801. srsym : tsym;
  2802. begin
  2803. hashedid.id:=s;
  2804. { First search the localmacrosymtable before searching the
  2805. global macrosymtables from the units }
  2806. if assigned(current_module) then
  2807. begin
  2808. srsym:=tsym(current_module.localmacrosymtable.FindWithHash(hashedid));
  2809. if assigned(srsym) then
  2810. begin
  2811. result:= srsym;
  2812. exit;
  2813. end;
  2814. end;
  2815. stackitem:=macrosymtablestack.stack;
  2816. while assigned(stackitem) do
  2817. begin
  2818. srsym:=tsym(stackitem^.symtable.FindWithHash(hashedid));
  2819. if assigned(srsym) then
  2820. begin
  2821. result:= srsym;
  2822. exit;
  2823. end;
  2824. stackitem:=stackitem^.next;
  2825. end;
  2826. result:= nil;
  2827. end;
  2828. function defined_macro(const s : string):boolean;
  2829. var
  2830. mac: tmacro;
  2831. begin
  2832. mac:=tmacro(search_macro(s));
  2833. if assigned(mac) then
  2834. begin
  2835. mac.is_used:=true;
  2836. defined_macro:=mac.defined;
  2837. end
  2838. else
  2839. defined_macro:=false;
  2840. end;
  2841. {****************************************************************************
  2842. Object Helpers
  2843. ****************************************************************************}
  2844. function search_default_property(pd : tabstractrecorddef) : tpropertysym;
  2845. { returns the default property of a class, searches also anchestors }
  2846. var
  2847. _defaultprop : tpropertysym;
  2848. helperpd : tobjectdef;
  2849. begin
  2850. _defaultprop:=nil;
  2851. { first search in helper's hierarchy }
  2852. if search_last_objectpascal_helper(pd,nil,helperpd) then
  2853. while assigned(helperpd) do
  2854. begin
  2855. helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
  2856. if assigned(_defaultprop) then
  2857. break;
  2858. helperpd:=helperpd.childof;
  2859. end;
  2860. if assigned(_defaultprop) then
  2861. begin
  2862. search_default_property:=_defaultprop;
  2863. exit;
  2864. end;
  2865. { now search in the type's hierarchy itself }
  2866. while assigned(pd) do
  2867. begin
  2868. pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
  2869. if assigned(_defaultprop) then
  2870. break;
  2871. if (pd.typ=objectdef) then
  2872. pd:=tobjectdef(pd).childof
  2873. else
  2874. break;
  2875. end;
  2876. search_default_property:=_defaultprop;
  2877. end;
  2878. {****************************************************************************
  2879. Macro Helpers
  2880. ****************************************************************************}
  2881. procedure def_system_macro(const name : string);
  2882. var
  2883. mac : tmacro;
  2884. s: string;
  2885. begin
  2886. if name = '' then
  2887. internalerror(2004121202);
  2888. s:= upper(name);
  2889. mac:=tmacro(search_macro(s));
  2890. if not assigned(mac) then
  2891. begin
  2892. mac:=tmacro.create(s);
  2893. if assigned(current_module) then
  2894. current_module.localmacrosymtable.insert(mac)
  2895. else
  2896. initialmacrosymtable.insert(mac);
  2897. end;
  2898. Message1(parser_c_macro_defined,mac.name);
  2899. mac.defined:=true;
  2900. end;
  2901. procedure set_system_macro(const name, value : string);
  2902. var
  2903. mac : tmacro;
  2904. s: string;
  2905. begin
  2906. if name = '' then
  2907. internalerror(2004121203);
  2908. s:= upper(name);
  2909. mac:=tmacro(search_macro(s));
  2910. if not assigned(mac) then
  2911. begin
  2912. mac:=tmacro.create(s);
  2913. if assigned(current_module) then
  2914. current_module.localmacrosymtable.insert(mac)
  2915. else
  2916. initialmacrosymtable.insert(mac);
  2917. end
  2918. else
  2919. begin
  2920. mac.is_compiler_var:=false;
  2921. if assigned(mac.buftext) then
  2922. freemem(mac.buftext,mac.buflen);
  2923. end;
  2924. Message2(parser_c_macro_set_to,mac.name,value);
  2925. mac.buflen:=length(value);
  2926. getmem(mac.buftext,mac.buflen);
  2927. move(value[1],mac.buftext^,mac.buflen);
  2928. mac.defined:=true;
  2929. end;
  2930. procedure set_system_compvar(const name, value : string);
  2931. var
  2932. mac : tmacro;
  2933. s: string;
  2934. begin
  2935. if name = '' then
  2936. internalerror(2004121204);
  2937. s:= upper(name);
  2938. mac:=tmacro(search_macro(s));
  2939. if not assigned(mac) then
  2940. begin
  2941. mac:=tmacro.create(s);
  2942. mac.is_compiler_var:=true;
  2943. if assigned(current_module) then
  2944. current_module.localmacrosymtable.insert(mac)
  2945. else
  2946. initialmacrosymtable.insert(mac);
  2947. end
  2948. else
  2949. begin
  2950. mac.is_compiler_var:=true;
  2951. if assigned(mac.buftext) then
  2952. freemem(mac.buftext,mac.buflen);
  2953. end;
  2954. Message2(parser_c_macro_set_to,mac.name,value);
  2955. mac.buflen:=length(value);
  2956. getmem(mac.buftext,mac.buflen);
  2957. move(value[1],mac.buftext^,mac.buflen);
  2958. mac.defined:=true;
  2959. end;
  2960. procedure undef_system_macro(const name : string);
  2961. var
  2962. mac : tmacro;
  2963. s: string;
  2964. begin
  2965. if name = '' then
  2966. internalerror(2004121205);
  2967. s:= upper(name);
  2968. mac:=tmacro(search_macro(s));
  2969. if not assigned(mac) then
  2970. {If not found, then it's already undefined.}
  2971. else
  2972. begin
  2973. Message1(parser_c_macro_undefined,mac.name);
  2974. mac.defined:=false;
  2975. mac.is_compiler_var:=false;
  2976. { delete old definition }
  2977. if assigned(mac.buftext) then
  2978. begin
  2979. freemem(mac.buftext,mac.buflen);
  2980. mac.buftext:=nil;
  2981. end;
  2982. end;
  2983. end;
  2984. {$ifdef UNITALIASES}
  2985. {****************************************************************************
  2986. TUNIT_ALIAS
  2987. ****************************************************************************}
  2988. constructor tunit_alias.create(const n:string);
  2989. var
  2990. i : longint;
  2991. begin
  2992. i:=pos('=',n);
  2993. if i=0 then
  2994. fail;
  2995. inherited createname(Copy(n,1,i-1));
  2996. newname:=stringdup(Copy(n,i+1,255));
  2997. end;
  2998. destructor tunit_alias.destroy;
  2999. begin
  3000. stringdispose(newname);
  3001. inherited destroy;
  3002. end;
  3003. procedure addunitalias(const n:string);
  3004. begin
  3005. unitaliases^.insert(tunit_alias,init(Upper(n))));
  3006. end;
  3007. function getunitalias(const n:string):string;
  3008. var
  3009. p : punit_alias;
  3010. begin
  3011. p:=punit_alias(unitaliases^.Find(Upper(n)));
  3012. if assigned(p) then
  3013. getunitalias:=punit_alias(p).newname^
  3014. else
  3015. getunitalias:=n;
  3016. end;
  3017. {$endif UNITALIASES}
  3018. {****************************************************************************
  3019. Init/Done Symtable
  3020. ****************************************************************************}
  3021. procedure InitSymtable;
  3022. begin
  3023. { Reset symbolstack }
  3024. symtablestack:=nil;
  3025. systemunit:=nil;
  3026. { create error syms and def }
  3027. generrorsym:=terrorsym.create;
  3028. generrordef:=terrordef.create;
  3029. { macros }
  3030. initialmacrosymtable:=tmacrosymtable.create(false);
  3031. macrosymtablestack:=TSymtablestack.create;
  3032. macrosymtablestack.push(initialmacrosymtable);
  3033. {$ifdef UNITALIASES}
  3034. { unit aliases }
  3035. unitaliases:=TFPHashObjectList.create;
  3036. {$endif}
  3037. { set some global vars to nil, might be important for the ide }
  3038. class_tobject:=nil;
  3039. interface_iunknown:=nil;
  3040. interface_idispatch:=nil;
  3041. rec_tguid:=nil;
  3042. dupnr:=0;
  3043. end;
  3044. procedure DoneSymtable;
  3045. begin
  3046. generrorsym.owner:=nil;
  3047. generrorsym.free;
  3048. generrordef.owner:=nil;
  3049. generrordef.free;
  3050. initialmacrosymtable.free;
  3051. macrosymtablestack.free;
  3052. {$ifdef UNITALIASES}
  3053. unitaliases.free;
  3054. {$endif}
  3055. end;
  3056. end.