symsym.pas 89 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  3. Implementation for the symbols types of the symtable
  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 symsym;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. { common }
  22. cutils,
  23. { target }
  24. globtype,globals,widestr,constexp,
  25. { symtable }
  26. symconst,symbase,symtype,symdef,defcmp,
  27. { ppu }
  28. ppu,finput,
  29. cclasses,symnot,
  30. { aasm }
  31. aasmbase,
  32. cpuinfo,cpubase,cgbase,cgutils,parabase
  33. ;
  34. type
  35. { this class is the base for all symbol objects }
  36. tstoredsym = class(tsym)
  37. private
  38. procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
  39. protected
  40. procedure ppuwrite_platform(ppufile: tcompilerppufile);virtual;
  41. procedure ppuload_platform(ppufile: tcompilerppufile);virtual;
  42. public
  43. constructor create(st:tsymtyp;const n : string);
  44. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  45. destructor destroy;override;
  46. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  47. end;
  48. tlabelsym = class(tstoredsym)
  49. used,
  50. defined,
  51. nonlocal : boolean;
  52. { points to the matching node, only valid resultdef pass is run and
  53. the goto<->label relation in the node tree is created, should
  54. be a tnode }
  55. code : pointer;
  56. { points to the jump buffer }
  57. jumpbuf : tstoredsym;
  58. { when the label is defined in an asm block, this points to the
  59. generated asmlabel }
  60. asmblocklabel : tasmlabel;
  61. constructor create(const n : string);virtual;
  62. constructor ppuload(ppufile:tcompilerppufile);
  63. { do not override this routine in platform-specific subclasses,
  64. override ppuwrite_platform instead }
  65. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  66. function mangledname:TSymStr;override;
  67. end;
  68. tlabelsymclass = class of tlabelsym;
  69. tunitsym = class(Tstoredsym)
  70. module : tobject; { tmodule }
  71. constructor create(const n : string;amodule : tobject);virtual;
  72. constructor ppuload(ppufile:tcompilerppufile);
  73. destructor destroy;override;
  74. { do not override this routine in platform-specific subclasses,
  75. override ppuwrite_platform instead }
  76. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  77. end;
  78. tunitsymclass = class of tunitsym;
  79. tnamespacesym = class(Tstoredsym)
  80. unitsym:tsym;
  81. unitsymderef:tderef;
  82. constructor create(const n : string);virtual;
  83. constructor ppuload(ppufile:tcompilerppufile);
  84. { do not override this routine in platform-specific subclasses,
  85. override ppuwrite_platform instead }
  86. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  87. procedure buildderef;override;
  88. procedure deref;override;
  89. end;
  90. tnamespacesymclass = class of tnamespacesym;
  91. terrorsym = class(Tsym)
  92. constructor create;
  93. end;
  94. { tprocsym }
  95. tprocsym = class(tstoredsym)
  96. protected
  97. FProcdefList : TFPObjectList;
  98. FProcdefDerefList : TFPList;
  99. public
  100. constructor create(const n : string);virtual;
  101. constructor ppuload(ppufile:tcompilerppufile);
  102. destructor destroy;override;
  103. { writes all declarations except the specified one }
  104. procedure write_parameter_lists(skipdef:tprocdef);
  105. { tests, if all procedures definitions are defined and not }
  106. { only forward }
  107. procedure check_forward; virtual;
  108. { do not override this routine in platform-specific subclasses,
  109. override ppuwrite_platform instead }
  110. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  111. procedure buildderef;override;
  112. procedure deref;override;
  113. function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  114. function find_bytype_parameterless(pt:Tproctypeoption):Tprocdef;
  115. function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  116. function find_procdef_bytype_and_para(pt:Tproctypeoption;para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  117. function find_procdef_byoptions(ops:tprocoptions): Tprocdef;
  118. function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  119. function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  120. function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  121. property ProcdefList:TFPObjectList read FProcdefList;
  122. end;
  123. tprocsymclass = class of tprocsym;
  124. ttypesym = class(Tstoredsym)
  125. public
  126. typedef : tdef;
  127. typedefderef : tderef;
  128. fprettyname : ansistring;
  129. constructor create(const n : string;def:tdef);virtual;
  130. destructor destroy;override;
  131. constructor ppuload(ppufile:tcompilerppufile);
  132. { do not override this routine in platform-specific subclasses,
  133. override ppuwrite_platform instead }
  134. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  135. procedure buildderef;override;
  136. procedure deref;override;
  137. function prettyname : string;override;
  138. end;
  139. ttypesymclass = class of ttypesym;
  140. tabstractvarsym = class(tstoredsym)
  141. varoptions : tvaroptions;
  142. notifications : Tlinkedlist;
  143. varspez : tvarspez; { sets the type of access }
  144. varregable : tvarregable;
  145. varstate : tvarstate;
  146. { Has the address of this variable potentially escaped the }
  147. { block in which is was declared? }
  148. { could also be part of tabstractnormalvarsym, but there's }
  149. { one byte left here till the next 4 byte alignment }
  150. addr_taken : boolean;
  151. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  152. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  153. destructor destroy;override;
  154. procedure ppuwrite(ppufile:tcompilerppufile);override;
  155. procedure buildderef;override;
  156. procedure deref;override;
  157. function getsize : asizeint;
  158. function getpackedbitsize : longint;
  159. function is_regvar(refpara: boolean):boolean;
  160. procedure trigger_notifications(what:Tnotification_flag);
  161. function register_notification(flags:Tnotification_flags;
  162. callback:Tnotification_callback):cardinal;
  163. procedure unregister_notification(id:cardinal);
  164. private
  165. _vardef : tdef;
  166. vardefderef : tderef;
  167. procedure setvardef(def:tdef);
  168. public
  169. property vardef: tdef read _vardef write setvardef;
  170. end;
  171. tfieldvarsym = class(tabstractvarsym)
  172. { offset in record/object, for bitpacked fields the offset is
  173. given in bit, else in bytes }
  174. fieldoffset : asizeint;
  175. externalname : pshortstring;
  176. {$ifdef symansistr}
  177. cachedmangledname: TSymStr; { mangled name for ObjC or Java }
  178. {$else symansistr}
  179. cachedmangledname: pshortstring; { mangled name for ObjC or Java }
  180. {$endif symansistr}
  181. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  182. constructor ppuload(ppufile:tcompilerppufile);
  183. { do not override this routine in platform-specific subclasses,
  184. override ppuwrite_platform instead }
  185. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  186. procedure set_externalname(const s:string);virtual;
  187. function mangledname:TSymStr;override;
  188. destructor destroy;override;
  189. end;
  190. tfieldvarsymclass = class of tfieldvarsym;
  191. tabstractnormalvarsym = class(tabstractvarsym)
  192. defaultconstsym : tsym;
  193. defaultconstsymderef : tderef;
  194. { register/reference for local var }
  195. localloc : TLocation;
  196. { initial location so it can still be initialized later after the location was changed by SSA }
  197. initialloc : TLocation;
  198. { current registers for register variables with moving register numbers }
  199. currentregloc : TLocation;
  200. { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
  201. inparentfpstruct : boolean;
  202. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  203. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  204. function globalasmsym: boolean;
  205. procedure ppuwrite(ppufile:tcompilerppufile);override;
  206. procedure buildderef;override;
  207. procedure deref;override;
  208. end;
  209. tlocalvarsym = class(tabstractnormalvarsym)
  210. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  211. constructor ppuload(ppufile:tcompilerppufile);
  212. { do not override this routine in platform-specific subclasses,
  213. override ppuwrite_platform instead }
  214. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  215. end;
  216. tlocalvarsymclass = class of tlocalvarsym;
  217. tparavarsym = class(tabstractnormalvarsym)
  218. paraloc : array[tcallercallee] of TCGPara;
  219. paranr : word; { position of this parameter }
  220. { in MacPas mode, "univ" parameters mean that type checking should
  221. be disabled, except that the size of the passed parameter must
  222. match the size of the formal parameter }
  223. univpara : boolean;
  224. {$ifdef EXTDEBUG}
  225. eqval : tequaltype;
  226. {$endif EXTDEBUG}
  227. constructor create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  228. constructor ppuload(ppufile:tcompilerppufile);
  229. destructor destroy;override;
  230. { do not override this routine in platform-specific subclasses,
  231. override ppuwrite_platform instead }
  232. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  233. function needs_finalization: boolean;
  234. end;
  235. tparavarsymclass = class of tparavarsym;
  236. tstaticvarsym = class(tabstractnormalvarsym)
  237. protected
  238. {$ifdef symansistr}
  239. _mangledbasename,
  240. _mangledname : TSymStr;
  241. {$else symansistr}
  242. _mangledbasename,
  243. _mangledname : pshortstring;
  244. {$endif symansistr}
  245. public
  246. section : ansistring;
  247. { if a text buffer has been defined as being initialized from command line
  248. parameters as it is done by iso pascal with the program symbols,
  249. isoindex contains the parameter number }
  250. isoindex : dword;
  251. { if this static variable was created based on a class field variable then this is set
  252. to the symbol of the corresponding class field }
  253. fieldvarsym : tfieldvarsym;
  254. fieldvarsymderef : tderef;
  255. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  256. constructor create_dll(const n : string;vsp:tvarspez;def:tdef);virtual;
  257. constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
  258. constructor create_from_fieldvar(const n:string;fieldvar:tfieldvarsym);virtual;
  259. constructor ppuload(ppufile:tcompilerppufile);
  260. destructor destroy;override;
  261. { do not override this routine in platform-specific subclasses,
  262. override ppuwrite_platform instead }
  263. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  264. procedure buildderef;override;
  265. procedure deref;override;
  266. function mangledname:TSymStr;override;
  267. procedure set_mangledbasename(const s: TSymStr);
  268. function mangledbasename: TSymStr;
  269. procedure set_mangledname(const s:TSymStr);virtual;
  270. procedure set_raw_mangledname(const s:TSymStr);
  271. end;
  272. tstaticvarsymclass = class of tstaticvarsym;
  273. tabsolutevarsym = class(tabstractvarsym)
  274. public
  275. abstyp : absolutetyp;
  276. asmname : pshortstring;
  277. addroffset : aword;
  278. ref : tpropaccesslist;
  279. constructor create(const n : string;def:tdef);virtual;
  280. constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist);virtual;
  281. destructor destroy;override;
  282. constructor ppuload(ppufile:tcompilerppufile);
  283. procedure buildderef;override;
  284. procedure deref;override;
  285. function mangledname : TSymStr;override;
  286. { do not override this routine in platform-specific subclasses,
  287. override ppuwrite_platform instead }
  288. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  289. end;
  290. tabsolutevarsymclass = class of tabsolutevarsym;
  291. tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
  292. tpropertysym = class(Tstoredsym)
  293. protected
  294. procedure finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef); virtual;
  295. public
  296. propoptions : tpropertyoptions;
  297. overriddenpropsym : tpropertysym;
  298. overriddenpropsymderef : tderef;
  299. propdef : tdef;
  300. propdefderef : tderef;
  301. indexdef : tdef;
  302. indexdefderef : tderef;
  303. index,
  304. default : longint;
  305. dispid : longint;
  306. propaccesslist: array[tpropaccesslisttypes] of tpropaccesslist;
  307. parast : tsymtable;
  308. constructor create(const n : string);virtual;
  309. destructor destroy;override;
  310. constructor ppuload(ppufile:tcompilerppufile);
  311. function getsize : asizeint;
  312. { do not override this routine in platform-specific subclasses,
  313. override ppuwrite_platform instead }
  314. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  315. procedure buildderef;override;
  316. procedure deref;override;
  317. function getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
  318. { copies the settings of the current propertysym to p; a bit like
  319. a form of getcopy, but without the name }
  320. procedure makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
  321. procedure add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
  322. procedure add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
  323. { set up the accessors for this property }
  324. procedure add_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
  325. procedure register_override(overriddenprop: tpropertysym);
  326. { inherit the read/write property }
  327. procedure inherit_accessor(getset: tpropaccesslisttypes); virtual;
  328. end;
  329. tpropertysymclass = class of tpropertysym;
  330. tconstvalue = record
  331. case integer of
  332. 0: (valueord : tconstexprint);
  333. 1: (valueordptr : tconstptruint);
  334. 2: (valueptr : pointer; len : longint);
  335. end;
  336. tconstsym = class(tstoredsym)
  337. constdef : tdef;
  338. constdefderef : tderef;
  339. consttyp : tconsttyp;
  340. value : tconstvalue;
  341. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);virtual;
  342. constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);virtual;
  343. constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
  344. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
  345. constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
  346. constructor ppuload(ppufile:tcompilerppufile);
  347. destructor destroy;override;
  348. procedure buildderef;override;
  349. procedure deref;override;
  350. { do not override this routine in platform-specific subclasses,
  351. override ppuwrite_platform instead }
  352. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  353. end;
  354. tconstsymclass = class of tconstsym;
  355. tenumsym = class(Tstoredsym)
  356. value : longint;
  357. definition : tenumdef;
  358. definitionderef : tderef;
  359. constructor create(const n : string;def : tenumdef;v : longint);virtual;
  360. constructor ppuload(ppufile:tcompilerppufile);
  361. { do not override this routine in platform-specific subclasses,
  362. override ppuwrite_platform instead }
  363. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  364. procedure buildderef;override;
  365. procedure deref;override;
  366. end;
  367. tenumsymclass = class of tenumsym;
  368. tsyssym = class(Tstoredsym)
  369. number : longint;
  370. constructor create(const n : string;l : longint);virtual;
  371. constructor ppuload(ppufile:tcompilerppufile);
  372. destructor destroy;override;
  373. { do not override this routine in platform-specific subclasses,
  374. override ppuwrite_platform instead }
  375. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  376. end;
  377. tsyssymclass = class of tsyssym;
  378. const
  379. maxmacrolen=16*1024;
  380. type
  381. pmacrobuffer = ^tmacrobuffer;
  382. tmacrobuffer = array[0..maxmacrolen-1] of char;
  383. tmacro = class(tstoredsym)
  384. {Normally true, but false when a previously defined macro is undef-ed}
  385. defined : boolean;
  386. {True if this is a mac style compiler variable, in which case no macro
  387. substitutions shall be done.}
  388. is_compiler_var : boolean;
  389. {Whether the macro was used. NOTE: A use of a macro which was never defined}
  390. {e. g. an IFDEF which returns false, will not be registered as used,}
  391. {since there is no place to register its use. }
  392. is_used : boolean;
  393. buftext : pchar;
  394. buflen : longint;
  395. constructor create(const n : string);
  396. constructor ppuload(ppufile:tcompilerppufile);
  397. { do not override this routine in platform-specific subclasses,
  398. override ppuwrite_platform instead }
  399. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  400. destructor destroy;override;
  401. function GetCopy:tmacro;
  402. end;
  403. { tPtrDefHashSet }
  404. tPtrDefHashSet = class(THashSet)
  405. public
  406. constructor Create;virtual;
  407. end;
  408. tPtrDefHashSetClass = class of tPtrDefHashSet;
  409. var
  410. generrorsym : tsym;
  411. clabelsym: tlabelsymclass;
  412. cunitsym: tunitsymclass;
  413. cnamespacesym: tnamespacesymclass;
  414. cprocsym: tprocsymclass;
  415. ctypesym: ttypesymclass;
  416. cfieldvarsym: tfieldvarsymclass;
  417. clocalvarsym: tlocalvarsymclass;
  418. cparavarsym: tparavarsymclass;
  419. cstaticvarsym: tstaticvarsymclass;
  420. cabsolutevarsym: tabsolutevarsymclass;
  421. cpropertysym: tpropertysymclass;
  422. cconstsym: tconstsymclass;
  423. cenumsym: tenumsymclass;
  424. csyssym: tsyssymclass;
  425. cPtrDefHashSet : tPtrDefHashSetClass = tPtrDefHashSet;
  426. { generate internal static field name based on regular field name }
  427. function internal_static_field_name(const fieldname: TSymStr): TSymStr;
  428. function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
  429. procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
  430. implementation
  431. uses
  432. { global }
  433. verbose,
  434. { target }
  435. systems,
  436. { symtable }
  437. defutil,symtable,
  438. fmodule,
  439. { tree }
  440. node,
  441. { aasm }
  442. aasmtai,aasmdata,
  443. { codegen }
  444. paramgr,
  445. procinfo
  446. ;
  447. {****************************************************************************
  448. Helpers
  449. ****************************************************************************}
  450. function internal_static_field_name(const fieldname: TSymStr): TSymStr;
  451. begin
  452. result:='$_static_'+fieldname;
  453. end;
  454. function get_high_value_sym(vs: tparavarsym):tsym;
  455. begin
  456. result := tsym(vs.owner.Find('high'+vs.name));
  457. end;
  458. procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
  459. begin
  460. if not assigned(srsym) then
  461. internalerror(200602051);
  462. if sp_hint_deprecated in symoptions then
  463. if (sp_has_deprecated_msg in symoptions) and (deprecatedmsg <> nil) then
  464. Message2(sym_w_deprecated_symbol_with_msg,srsym.realname,deprecatedmsg^)
  465. else
  466. Message1(sym_w_deprecated_symbol,srsym.realname);
  467. if sp_hint_experimental in symoptions then
  468. Message1(sym_w_experimental_symbol,srsym.realname);
  469. if sp_hint_platform in symoptions then
  470. Message1(sym_w_non_portable_symbol,srsym.realname);
  471. if sp_hint_library in symoptions then
  472. Message1(sym_w_library_symbol,srsym.realname);
  473. if sp_hint_unimplemented in symoptions then
  474. Message1(sym_w_non_implemented_symbol,srsym.realname);
  475. end;
  476. {****************************************************************************
  477. TSYM (base for all symtypes)
  478. ****************************************************************************}
  479. constructor tstoredsym.create(st:tsymtyp;const n : string);
  480. begin
  481. inherited create(st,n);
  482. { Register in current_module }
  483. if assigned(current_module) then
  484. begin
  485. current_module.symlist.Add(self);
  486. SymId:=current_module.symlist.Count-1;
  487. end;
  488. end;
  489. constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  490. begin
  491. SymId:=ppufile.getlongint;
  492. inherited Create(st,ppufile.getstring);
  493. { Register symbol }
  494. current_module.symlist[SymId]:=self;
  495. ppufile.getposinfo(fileinfo);
  496. visibility:=tvisibility(ppufile.getbyte);
  497. ppufile.getsmallset(symoptions);
  498. if sp_has_deprecated_msg in symoptions then
  499. deprecatedmsg:=stringdup(ppufile.getstring)
  500. else
  501. deprecatedmsg:=nil;
  502. end;
  503. procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
  504. var
  505. oldintfcrc : boolean;
  506. begin
  507. ppufile.putlongint(SymId);
  508. ppufile.putstring(realname);
  509. ppufile.putposinfo(fileinfo);
  510. ppufile.putbyte(byte(visibility));
  511. { symoptions can differ between interface and implementation, except
  512. for overload (this is checked in pdecsub.proc_add_definition() )
  513. These differences can lead to compiler crashes, so ignore them.
  514. This does mean that changing e.g. the "deprecated" state of a symbol
  515. by itself will not trigger a recompilation of dependent units.
  516. }
  517. oldintfcrc:=ppufile.do_interface_crc;
  518. ppufile.do_interface_crc:=false;
  519. ppufile.putsmallset(symoptions);
  520. if sp_has_deprecated_msg in symoptions then
  521. ppufile.putstring(deprecatedmsg^);
  522. ppufile.do_interface_crc:=oldintfcrc;
  523. end;
  524. procedure tstoredsym.writeentry(ppufile: tcompilerppufile; ibnr: byte);
  525. begin
  526. ppuwrite_platform(ppufile);
  527. ppufile.writeentry(ibnr);
  528. end;
  529. procedure tstoredsym.ppuwrite_platform(ppufile: tcompilerppufile);
  530. begin
  531. { by default: do nothing }
  532. end;
  533. procedure tstoredsym.ppuload_platform(ppufile: tcompilerppufile);
  534. begin
  535. { by default: do nothing }
  536. end;
  537. destructor tstoredsym.destroy;
  538. begin
  539. inherited destroy;
  540. end;
  541. {****************************************************************************
  542. TLABELSYM
  543. ****************************************************************************}
  544. constructor tlabelsym.create(const n : string);
  545. begin
  546. inherited create(labelsym,n);
  547. used:=false;
  548. defined:=false;
  549. nonlocal:=false;
  550. code:=nil;
  551. end;
  552. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  553. begin
  554. inherited ppuload(labelsym,ppufile);
  555. code:=nil;
  556. used:=false;
  557. nonlocal:=false;
  558. defined:=true;
  559. ppuload_platform(ppufile);
  560. end;
  561. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  562. begin
  563. if owner.symtabletype=globalsymtable then
  564. Message(sym_e_ill_label_decl)
  565. else
  566. begin
  567. inherited ppuwrite(ppufile);
  568. writeentry(ppufile,iblabelsym);
  569. end;
  570. end;
  571. function tlabelsym.mangledname:TSymStr;
  572. begin
  573. if (asmblocklabel=nil) then
  574. begin
  575. if nonlocal then
  576. current_asmdata.getglobaljumplabel(asmblocklabel)
  577. else
  578. current_asmdata.getjumplabel(asmblocklabel);
  579. end;
  580. result:=asmblocklabel.name;
  581. end;
  582. {****************************************************************************
  583. TUNITSYM
  584. ****************************************************************************}
  585. constructor tunitsym.create(const n : string;amodule : tobject);
  586. begin
  587. inherited create(unitsym,n);
  588. module:=amodule;
  589. end;
  590. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  591. begin
  592. inherited ppuload(unitsym,ppufile);
  593. module:=nil;
  594. ppuload_platform(ppufile);
  595. end;
  596. destructor tunitsym.destroy;
  597. begin
  598. inherited destroy;
  599. end;
  600. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  601. begin
  602. inherited ppuwrite(ppufile);
  603. writeentry(ppufile,ibunitsym);
  604. end;
  605. {****************************************************************************
  606. TNAMESPACESYM
  607. ****************************************************************************}
  608. constructor tnamespacesym.create(const n : string);
  609. begin
  610. inherited create(namespacesym,n);
  611. unitsym:=nil;
  612. end;
  613. constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
  614. begin
  615. inherited ppuload(namespacesym,ppufile);
  616. ppufile.getderef(unitsymderef);
  617. ppuload_platform(ppufile);
  618. end;
  619. procedure tnamespacesym.ppuwrite(ppufile:tcompilerppufile);
  620. begin
  621. inherited ppuwrite(ppufile);
  622. ppufile.putderef(unitsymderef);
  623. writeentry(ppufile,ibnamespacesym);
  624. end;
  625. procedure tnamespacesym.buildderef;
  626. begin
  627. inherited buildderef;
  628. unitsymderef.build(unitsym);
  629. end;
  630. procedure tnamespacesym.deref;
  631. begin
  632. inherited deref;
  633. unitsym:=tsym(unitsymderef.resolve);
  634. end;
  635. {****************************************************************************
  636. TPROCSYM
  637. ****************************************************************************}
  638. constructor tprocsym.create(const n : string);
  639. var
  640. i: longint;
  641. begin
  642. if not(ts_lowercase_proc_start in current_settings.targetswitches) or
  643. (n='') then
  644. inherited create(procsym,n)
  645. else
  646. begin
  647. { YToX -> yToX
  648. RC64Encode -> rc64Encode
  649. Test -> test
  650. }
  651. i:=2;
  652. while i<=length(n) do
  653. begin
  654. if not(n[i] in ['A'..'Z']) then
  655. begin
  656. if (i>2) and
  657. (n[i] in ['a'..'z']) then
  658. dec(i);
  659. break;
  660. end;
  661. inc(i);
  662. end;
  663. inherited create(procsym,lower(copy(n,1,i-1))+copy(n,i,length(n)));
  664. end;
  665. FProcdefList:=TFPObjectList.Create(false);
  666. FProcdefderefList:=nil;
  667. { the tprocdef have their own symoptions, make the procsym
  668. always visible }
  669. visibility:=vis_public;
  670. end;
  671. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  672. var
  673. pdderef : tderef;
  674. i,
  675. pdcnt : longint;
  676. begin
  677. inherited ppuload(procsym,ppufile);
  678. FProcdefList:=TFPObjectList.Create(false);
  679. FProcdefDerefList:=TFPList.Create;
  680. pdcnt:=ppufile.getword;
  681. for i:=1 to pdcnt do
  682. begin
  683. ppufile.getderef(pdderef);
  684. FProcdefDerefList.Add(Pointer(PtrInt(pdderef.dataidx)));
  685. end;
  686. ppuload_platform(ppufile);
  687. end;
  688. destructor tprocsym.destroy;
  689. begin
  690. FProcdefList.Free;
  691. if assigned(FProcdefDerefList) then
  692. FProcdefDerefList.Free;
  693. inherited destroy;
  694. end;
  695. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  696. var
  697. i : longint;
  698. d : tderef;
  699. begin
  700. inherited ppuwrite(ppufile);
  701. if fprocdefdereflist=nil then
  702. internalerror(2013121801);
  703. ppufile.putword(FProcdefDerefList.Count);
  704. for i:=0 to FProcdefDerefList.Count-1 do
  705. begin
  706. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  707. ppufile.putderef(d);
  708. end;
  709. writeentry(ppufile,ibprocsym);
  710. end;
  711. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  712. var
  713. i : longint;
  714. pd : tprocdef;
  715. begin
  716. for i:=0 to ProcdefList.Count-1 do
  717. begin
  718. pd:=tprocdef(ProcdefList[i]);
  719. if pd<>skipdef then
  720. MessagePos1(pd.fileinfo,sym_e_param_list,pd.fullprocname(false));
  721. end;
  722. end;
  723. procedure tprocsym.check_forward;
  724. var
  725. i : longint;
  726. pd : tprocdef;
  727. begin
  728. for i:=0 to ProcdefList.Count-1 do
  729. begin
  730. pd:=tprocdef(ProcdefList[i]);
  731. if (pd.owner=owner) and (pd.forwarddef) then
  732. begin
  733. { For mode macpas. Make implicit externals (procedures declared in the interface
  734. section which do not have a counterpart in the implementation)
  735. to be an imported procedure }
  736. if (m_mac in current_settings.modeswitches) and
  737. (pd.interfacedef) then
  738. begin
  739. pd.setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
  740. if (not current_module.interface_only) then
  741. MessagePos1(pd.fileinfo,sym_w_forward_not_resolved,pd.fullprocname(false));
  742. end
  743. else
  744. begin
  745. MessagePos1(pd.fileinfo,sym_e_forward_not_resolved,pd.fullprocname(false));
  746. end;
  747. { Turn further error messages off }
  748. pd.forwarddef:=false;
  749. end;
  750. end;
  751. end;
  752. procedure tprocsym.buildderef;
  753. var
  754. i : longint;
  755. pd : tprocdef;
  756. d : tderef;
  757. begin
  758. if not assigned(FProcdefDerefList) then
  759. FProcdefDerefList:=TFPList.Create
  760. else
  761. FProcdefDerefList.Clear;
  762. for i:=0 to ProcdefList.Count-1 do
  763. begin
  764. pd:=tprocdef(ProcdefList[i]);
  765. { only write the proc definitions that belong
  766. to this procsym and are in the global symtable }
  767. if pd.owner=owner then
  768. begin
  769. d.build(pd);
  770. FProcdefDerefList.Add(Pointer(PtrInt(d.dataidx)));
  771. end;
  772. end;
  773. end;
  774. procedure tprocsym.deref;
  775. var
  776. i : longint;
  777. pd : tprocdef;
  778. d : tderef;
  779. begin
  780. { Clear all procdefs }
  781. ProcdefList.Clear;
  782. if not assigned(FProcdefDerefList) then
  783. internalerror(200611031);
  784. for i:=0 to FProcdefDerefList.Count-1 do
  785. begin
  786. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  787. pd:=tprocdef(d.resolve);
  788. ProcdefList.Add(pd);
  789. end;
  790. end;
  791. function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  792. var
  793. i : longint;
  794. pd : tprocdef;
  795. begin
  796. result:=nil;
  797. for i:=0 to ProcdefList.Count-1 do
  798. begin
  799. pd:=tprocdef(ProcdefList[i]);
  800. if pd.proctypeoption=pt then
  801. begin
  802. result:=pd;
  803. exit;
  804. end;
  805. end;
  806. end;
  807. function tprocsym.find_bytype_parameterless(pt: Tproctypeoption): Tprocdef;
  808. var
  809. i,j : longint;
  810. pd : tprocdef;
  811. found : boolean;
  812. begin
  813. result:=nil;
  814. for i:=0 to ProcdefList.Count-1 do
  815. begin
  816. pd:=tprocdef(ProcdefList[i]);
  817. if (pd.proctypeoption=pt) then
  818. begin
  819. found:=true;
  820. for j:=0 to pd.paras.count-1 do
  821. begin
  822. if not(vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  823. begin
  824. found:=false;
  825. break;
  826. end;
  827. end;
  828. if found then
  829. begin
  830. result:=pd;
  831. exit;
  832. end;
  833. end;
  834. end;
  835. end;
  836. function check_procdef_paras(pd:tprocdef;para:TFPObjectList;retdef:tdef;
  837. cpoptions:tcompare_paras_options): tprocdef;
  838. var
  839. eq: tequaltype;
  840. begin
  841. result:=nil;
  842. if assigned(retdef) then
  843. eq:=compare_defs(retdef,pd.returndef,nothingn)
  844. else
  845. eq:=te_equal;
  846. if (eq>=te_equal) or
  847. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  848. begin
  849. eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
  850. if (eq>=te_equal) or
  851. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  852. begin
  853. result:=pd;
  854. exit;
  855. end;
  856. end;
  857. end;
  858. function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef;
  859. cpoptions:tcompare_paras_options):Tprocdef;
  860. var
  861. i : longint;
  862. pd : tprocdef;
  863. begin
  864. result:=nil;
  865. for i:=0 to ProcdefList.Count-1 do
  866. begin
  867. pd:=tprocdef(ProcdefList[i]);
  868. result:=check_procdef_paras(pd,para,retdef,cpoptions);
  869. if assigned(result) then
  870. exit;
  871. end;
  872. end;
  873. function Tprocsym.find_procdef_bytype_and_para(pt:Tproctypeoption;
  874. para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  875. var
  876. i : longint;
  877. pd : tprocdef;
  878. begin
  879. result:=nil;
  880. for i:=0 to ProcdefList.Count-1 do
  881. begin
  882. pd:=tprocdef(ProcdefList[i]);
  883. if pd.proctypeoption=pt then
  884. begin
  885. result:=check_procdef_paras(pd,para,retdef,cpoptions);
  886. if assigned(result) then
  887. exit;
  888. end;
  889. end;
  890. end;
  891. function tprocsym.find_procdef_byoptions(ops: tprocoptions): Tprocdef;
  892. var
  893. i : longint;
  894. pd : tprocdef;
  895. begin
  896. result:=nil;
  897. for i:=0 to ProcdefList.Count-1 do
  898. begin
  899. pd:=tprocdef(ProcdefList[i]);
  900. if ops * pd.procoptions = ops then
  901. begin
  902. result:=pd;
  903. exit;
  904. end;
  905. end;
  906. end;
  907. function Tprocsym.Find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  908. var
  909. i : longint;
  910. bestpd,
  911. pd : tprocdef;
  912. eq,besteq : tequaltype;
  913. sym: tsym;
  914. ps: tprocsym;
  915. begin
  916. { This function will return the pprocdef of pprocsym that
  917. is the best match for procvardef. When there are multiple
  918. matches it returns nil.}
  919. result:=nil;
  920. bestpd:=nil;
  921. besteq:=te_incompatible;
  922. ps:=self;
  923. repeat
  924. for i:=0 to ps.ProcdefList.Count-1 do
  925. begin
  926. pd:=tprocdef(ps.ProcdefList[i]);
  927. eq:=proc_to_procvar_equal(pd,d,false);
  928. if eq>=te_convert_l1 then
  929. begin
  930. { multiple procvars with the same equal level }
  931. if assigned(bestpd) and
  932. (besteq=eq) then
  933. exit;
  934. if eq>besteq then
  935. begin
  936. besteq:=eq;
  937. bestpd:=pd;
  938. end;
  939. end;
  940. end;
  941. { maybe TODO: also search class helpers? -- this code is similar to
  942. what happens in htypechk in
  943. tcallcandidates.collect_overloads_in_struct: keep searching in
  944. parent types in case the currently found procdef is marked as
  945. "overload" and we haven't found a proper match yet }
  946. if assigned(ps.owner.defowner) and
  947. (ps.owner.defowner.typ=objectdef) and
  948. assigned(tobjectdef(ps.owner.defowner).childof) and
  949. (not assigned(bestpd) or
  950. (po_overload in bestpd.procoptions)) then
  951. begin
  952. sym:=tsym(tobjectdef(ps.owner.defowner).childof.symtable.find(ps.name));
  953. if assigned(sym) and
  954. (sym.typ=procsym) then
  955. ps:=tprocsym(sym)
  956. else
  957. ps:=nil;
  958. end
  959. else
  960. ps:=nil;
  961. until (besteq>=te_equal) or
  962. not assigned(ps);
  963. result:=bestpd;
  964. end;
  965. function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  966. var
  967. paraidx, realparamcount,
  968. i, j : longint;
  969. bestpd,
  970. hpd,
  971. pd : tprocdef;
  972. convtyp : tconverttype;
  973. eq : tequaltype;
  974. begin
  975. { This function will return the pprocdef of pprocsym that
  976. is the best match for fromdef and todef. }
  977. result:=nil;
  978. bestpd:=nil;
  979. besteq:=te_incompatible;
  980. for i:=0 to ProcdefList.Count-1 do
  981. begin
  982. pd:=tprocdef(ProcdefList[i]);
  983. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  984. continue;
  985. if (equal_defs(todef,pd.returndef) or
  986. { shortstrings of different lengths are ok as result }
  987. (is_shortstring(todef) and is_shortstring(pd.returndef))) and
  988. { the result type must be always really equal and not an alias,
  989. if you mess with this code, check tw4093 }
  990. ((todef=pd.returndef) or
  991. (
  992. not(df_unique in todef.defoptions) and
  993. not(df_unique in pd.returndef.defoptions)
  994. )
  995. ) then
  996. begin
  997. paraidx:=0;
  998. { ignore vs_hidden parameters }
  999. while (paraidx<pd.paras.count) and
  1000. assigned(pd.paras[paraidx]) and
  1001. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  1002. inc(paraidx);
  1003. realparamcount:=0;
  1004. for j := 0 to pd.paras.Count-1 do
  1005. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  1006. inc(realparamcount);
  1007. if (paraidx<pd.paras.count) and
  1008. assigned(pd.paras[paraidx]) and
  1009. (realparamcount = 1) then
  1010. begin
  1011. eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  1012. { alias? if yes, only l1 choice,
  1013. if you mess with this code, check tw4093 }
  1014. if (eq=te_exact) and
  1015. (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
  1016. ((df_unique in fromdef.defoptions) or
  1017. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  1018. eq:=te_convert_l1;
  1019. if eq=te_exact then
  1020. begin
  1021. besteq:=eq;
  1022. result:=pd;
  1023. exit;
  1024. end;
  1025. if eq>besteq then
  1026. begin
  1027. bestpd:=pd;
  1028. besteq:=eq;
  1029. end;
  1030. end;
  1031. end;
  1032. end;
  1033. result:=bestpd;
  1034. end;
  1035. function Tprocsym.find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  1036. var
  1037. paraidx, realparamcount,
  1038. i, j : longint;
  1039. bestpd,
  1040. hpd,
  1041. pd : tprocdef;
  1042. current : tpropertysym;
  1043. convtyp : tconverttype;
  1044. eq : tequaltype;
  1045. begin
  1046. { This function will return the pprocdef of pprocsym that
  1047. is the best match for fromdef and todef. }
  1048. result:=nil;
  1049. bestpd:=nil;
  1050. besteq:=te_incompatible;
  1051. for i:=0 to ProcdefList.Count-1 do
  1052. begin
  1053. pd:=tprocdef(ProcdefList[i]);
  1054. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  1055. continue;
  1056. if not (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
  1057. continue;
  1058. current := tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current);
  1059. if (current = nil) then
  1060. continue;
  1061. // compare current result def with the todef
  1062. if (equal_defs(todef, current.propdef) or
  1063. { shortstrings of different lengths are ok as result }
  1064. (is_shortstring(todef) and is_shortstring(current.propdef))) and
  1065. { the result type must be always really equal and not an alias,
  1066. if you mess with this code, check tw4093 }
  1067. ((todef=current.propdef) or
  1068. (
  1069. not(df_unique in todef.defoptions) and
  1070. not(df_unique in current.propdef.defoptions)
  1071. )
  1072. ) then
  1073. begin
  1074. paraidx:=0;
  1075. { ignore vs_hidden parameters }
  1076. while (paraidx<pd.paras.count) and
  1077. assigned(pd.paras[paraidx]) and
  1078. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  1079. inc(paraidx);
  1080. realparamcount:=0;
  1081. for j := 0 to pd.paras.Count-1 do
  1082. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  1083. inc(realparamcount);
  1084. if (paraidx<pd.paras.count) and
  1085. assigned(pd.paras[paraidx]) and
  1086. (realparamcount = 1) then
  1087. begin
  1088. eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  1089. { alias? if yes, only l1 choice,
  1090. if you mess with this code, check tw4093 }
  1091. if (eq=te_exact) and
  1092. (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
  1093. ((df_unique in fromdef.defoptions) or
  1094. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  1095. eq:=te_convert_l1;
  1096. if eq=te_exact then
  1097. begin
  1098. besteq:=eq;
  1099. result:=pd;
  1100. exit;
  1101. end;
  1102. if eq>besteq then
  1103. begin
  1104. bestpd:=pd;
  1105. besteq:=eq;
  1106. end;
  1107. end;
  1108. end;
  1109. end;
  1110. result:=bestpd;
  1111. end;
  1112. {****************************************************************************
  1113. TERRORSYM
  1114. ****************************************************************************}
  1115. constructor terrorsym.create;
  1116. begin
  1117. inherited create(errorsym,'');
  1118. end;
  1119. {****************************************************************************
  1120. TPROPERTYSYM
  1121. ****************************************************************************}
  1122. procedure tpropertysym.finalize_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
  1123. begin
  1124. { do nothing by default }
  1125. end;
  1126. constructor tpropertysym.create(const n : string);
  1127. var
  1128. pap : tpropaccesslisttypes;
  1129. begin
  1130. inherited create(propertysym,n);
  1131. propoptions:=[];
  1132. index:=0;
  1133. default:=0;
  1134. propdef:=nil;
  1135. indexdef:=nil;
  1136. parast:=nil;
  1137. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1138. propaccesslist[pap]:=tpropaccesslist.create;
  1139. end;
  1140. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  1141. var
  1142. pap : tpropaccesslisttypes;
  1143. begin
  1144. inherited ppuload(propertysym,ppufile);
  1145. ppufile.getsmallset(propoptions);
  1146. if ppo_overrides in propoptions then
  1147. ppufile.getderef(overriddenpropsymderef);
  1148. ppufile.getderef(propdefderef);
  1149. index:=ppufile.getlongint;
  1150. default:=ppufile.getlongint;
  1151. ppufile.getderef(indexdefderef);
  1152. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1153. propaccesslist[pap]:=ppufile.getpropaccesslist;
  1154. ppuload_platform(ppufile);
  1155. if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
  1156. begin
  1157. parast:=tparasymtable.create(nil,0);
  1158. tparasymtable(parast).ppuload(ppufile);
  1159. end
  1160. else
  1161. parast:=nil;
  1162. end;
  1163. destructor tpropertysym.destroy;
  1164. var
  1165. pap : tpropaccesslisttypes;
  1166. begin
  1167. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1168. propaccesslist[pap].free;
  1169. parast.free;
  1170. inherited destroy;
  1171. end;
  1172. procedure tpropertysym.buildderef;
  1173. var
  1174. pap : tpropaccesslisttypes;
  1175. begin
  1176. propdefderef.build(propdef);
  1177. indexdefderef.build(indexdef);
  1178. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1179. propaccesslist[pap].buildderef;
  1180. if ppo_overrides in propoptions then
  1181. overriddenpropsymderef.build(overriddenpropsym)
  1182. else
  1183. if ppo_hasparameters in propoptions then
  1184. tparasymtable(parast).buildderef;
  1185. end;
  1186. procedure tpropertysym.deref;
  1187. var
  1188. pap : tpropaccesslisttypes;
  1189. begin
  1190. indexdef:=tdef(indexdefderef.resolve);
  1191. propdef:=tdef(propdefderef.resolve);
  1192. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1193. propaccesslist[pap].resolve;
  1194. if ppo_overrides in propoptions then
  1195. begin
  1196. overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
  1197. if ppo_hasparameters in propoptions then
  1198. parast:=overriddenpropsym.parast.getcopy;
  1199. end
  1200. else
  1201. if ppo_hasparameters in propoptions then
  1202. tparasymtable(parast).deref
  1203. end;
  1204. function tpropertysym.getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
  1205. var
  1206. hpropsym : tpropertysym;
  1207. begin
  1208. result:=false;
  1209. { find property in the overridden list }
  1210. hpropsym:=self;
  1211. repeat
  1212. plist:=hpropsym.propaccesslist[pap];
  1213. if not plist.empty then
  1214. begin
  1215. result:=true;
  1216. exit;
  1217. end;
  1218. hpropsym:=hpropsym.overriddenpropsym;
  1219. until not assigned(hpropsym);
  1220. end;
  1221. procedure tpropertysym.add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
  1222. var
  1223. i: integer;
  1224. orig, hparavs: tparavarsym;
  1225. begin
  1226. for i := 0 to parast.SymList.Count - 1 do
  1227. begin
  1228. orig:=tparavarsym(parast.SymList[i]);
  1229. if assigned(readprocdef) then
  1230. begin
  1231. hparavs:=cparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
  1232. readprocdef.parast.insert(hparavs);
  1233. end;
  1234. if assigned(writeprocdef) then
  1235. begin
  1236. hparavs:=cparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
  1237. writeprocdef.parast.insert(hparavs);
  1238. end;
  1239. end;
  1240. end;
  1241. procedure tpropertysym.add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
  1242. var
  1243. hparavs: tparavarsym;
  1244. begin
  1245. inc(paranr);
  1246. if assigned(readprocdef) then
  1247. begin
  1248. hparavs:=cparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
  1249. readprocdef.parast.insert(hparavs);
  1250. end;
  1251. if assigned(writeprocdef) then
  1252. begin
  1253. hparavs:=cparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
  1254. writeprocdef.parast.insert(hparavs);
  1255. end;
  1256. end;
  1257. procedure tpropertysym.add_getter_or_setter_for_sym(getset: tpropaccesslisttypes; sym: tsym; fielddef: tdef; accessordef: tprocdef);
  1258. var
  1259. cpo: tcompare_paras_options;
  1260. begin
  1261. case sym.typ of
  1262. procsym :
  1263. begin
  1264. { search procdefs matching accessordef }
  1265. { we ignore hidden stuff here because the property access symbol might have
  1266. non default calling conventions which might change the hidden stuff;
  1267. see tw3216.pp (FK) }
  1268. cpo:=[cpo_allowdefaults,cpo_ignorehidden];
  1269. { allow var-parameters for setters in case of VARPROPSETTER+ }
  1270. if (getset=palt_write) and
  1271. (cs_varpropsetter in current_settings.localswitches) then
  1272. include(cpo,cpo_ignorevarspez);
  1273. propaccesslist[getset].procdef:=tprocsym(sym).find_procdef_bypara(accessordef.paras,accessordef.returndef,cpo);
  1274. if not assigned(propaccesslist[getset].procdef) or
  1275. { because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property }
  1276. ((sp_static in symoptions)<>tprocdef(propaccesslist[getset].procdef).no_self_node) then
  1277. Message(parser_e_ill_property_access_sym)
  1278. else
  1279. finalize_getter_or_setter_for_sym(getset,sym,fielddef,accessordef);
  1280. end;
  1281. fieldvarsym :
  1282. begin
  1283. if not assigned(fielddef) then
  1284. internalerror(200310071);
  1285. if compare_defs(fielddef,propdef,nothingn)>=te_equal then
  1286. begin
  1287. { property parameters are allowed if this is
  1288. an indexed property, because the index is then
  1289. the parameter.
  1290. Note: In the help of Kylix it is written
  1291. that it isn't allowed, but the compiler accepts it (PFV) }
  1292. if (ppo_hasparameters in propoptions) or
  1293. ((sp_static in symoptions) <> (sp_static in sym.symoptions)) then
  1294. Message(parser_e_ill_property_access_sym)
  1295. else
  1296. finalize_getter_or_setter_for_sym(getset,sym,fielddef,accessordef);
  1297. end
  1298. else
  1299. IncompatibleTypes(fielddef,propdef);
  1300. end;
  1301. else
  1302. Message(parser_e_ill_property_access_sym);
  1303. end;
  1304. end;
  1305. procedure tpropertysym.register_override(overriddenprop: tpropertysym);
  1306. begin
  1307. overriddenpropsym:=tpropertysym(overriddenprop);
  1308. include(propoptions,ppo_overrides);
  1309. end;
  1310. procedure tpropertysym.inherit_accessor(getset: tpropaccesslisttypes);
  1311. begin
  1312. { nothing to do by default }
  1313. end;
  1314. procedure tpropertysym.makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
  1315. begin
  1316. { inherit all type related entries }
  1317. p.indexdef:=indexdef;
  1318. p.propdef:=propdef;
  1319. p.index:=index;
  1320. p.default:=default;
  1321. p.propoptions:=propoptions;
  1322. paranr:=0;
  1323. if ppo_hasparameters in propoptions then
  1324. begin
  1325. p.parast:=parast.getcopy;
  1326. p.add_accessor_parameters(readprocdef,writeprocdef);
  1327. paranr:=p.parast.SymList.Count;
  1328. end;
  1329. if ppo_indexed in p.propoptions then
  1330. p.add_index_parameter(paranr,readprocdef,writeprocdef);
  1331. end;
  1332. function tpropertysym.getsize : asizeint;
  1333. begin
  1334. getsize:=0;
  1335. end;
  1336. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  1337. var
  1338. pap : tpropaccesslisttypes;
  1339. begin
  1340. inherited ppuwrite(ppufile);
  1341. ppufile.putsmallset(propoptions);
  1342. if ppo_overrides in propoptions then
  1343. ppufile.putderef(overriddenpropsymderef);
  1344. ppufile.putderef(propdefderef);
  1345. ppufile.putlongint(index);
  1346. ppufile.putlongint(default);
  1347. ppufile.putderef(indexdefderef);
  1348. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1349. ppufile.putpropaccesslist(propaccesslist[pap]);
  1350. writeentry(ppufile,ibpropertysym);
  1351. if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
  1352. tparasymtable(parast).ppuwrite(ppufile);
  1353. end;
  1354. {****************************************************************************
  1355. TABSTRACTVARSYM
  1356. ****************************************************************************}
  1357. constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1358. begin
  1359. inherited create(st,n);
  1360. vardef:=def;
  1361. varspez:=vsp;
  1362. varstate:=vs_declared;
  1363. varoptions:=vopts;
  1364. end;
  1365. constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1366. begin
  1367. inherited ppuload(st,ppufile);
  1368. varstate:=vs_readwritten;
  1369. varspez:=tvarspez(ppufile.getbyte);
  1370. varregable:=tvarregable(ppufile.getbyte);
  1371. addr_taken:=boolean(ppufile.getbyte);
  1372. ppufile.getderef(vardefderef);
  1373. ppufile.getsmallset(varoptions);
  1374. end;
  1375. destructor tabstractvarsym.destroy;
  1376. begin
  1377. if assigned(notifications) then
  1378. notifications.destroy;
  1379. inherited destroy;
  1380. end;
  1381. procedure tabstractvarsym.buildderef;
  1382. begin
  1383. vardefderef.build(vardef);
  1384. end;
  1385. procedure tabstractvarsym.deref;
  1386. var
  1387. oldvarregable: tvarregable;
  1388. begin
  1389. { setting the vardef also updates varregable. We just loaded this }
  1390. { value from a ppu, so it must not be changed (e.g. tw7817a.pp/ }
  1391. { tw7817b.pp: the address is taken of a local variable in an }
  1392. { inlined procedure -> must remain non-regable when inlining) }
  1393. oldvarregable:=varregable;
  1394. vardef:=tdef(vardefderef.resolve);
  1395. varregable:=oldvarregable;
  1396. end;
  1397. procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile);
  1398. var
  1399. oldintfcrc : boolean;
  1400. begin
  1401. inherited ppuwrite(ppufile);
  1402. ppufile.putbyte(byte(varspez));
  1403. oldintfcrc:=ppufile.do_crc;
  1404. ppufile.do_crc:=false;
  1405. ppufile.putbyte(byte(varregable));
  1406. ppufile.putbyte(byte(addr_taken));
  1407. ppufile.do_crc:=oldintfcrc;
  1408. ppufile.putderef(vardefderef);
  1409. ppufile.putsmallset(varoptions);
  1410. end;
  1411. function tabstractvarsym.getsize : asizeint;
  1412. begin
  1413. if assigned(vardef) and
  1414. ((vardef.typ<>arraydef) or
  1415. is_dynamic_array(vardef) or
  1416. (tarraydef(vardef).highrange>=tarraydef(vardef).lowrange)) then
  1417. result:=vardef.size
  1418. else
  1419. result:=0;
  1420. end;
  1421. function tabstractvarsym.getpackedbitsize : longint;
  1422. begin
  1423. { bitpacking is only done for ordinals }
  1424. if not is_ordinal(vardef) then
  1425. internalerror(2006082010);
  1426. result:=vardef.packedbitsize;
  1427. end;
  1428. function tabstractvarsym.is_regvar(refpara: boolean):boolean;
  1429. begin
  1430. { Register variables are not allowed in the following cases:
  1431. - regvars are disabled
  1432. - exceptions are used (after an exception is raised the contents of the
  1433. registers is not valid anymore)
  1434. - it has a local copy
  1435. - the value needs to be in memory (i.e. reference counted) }
  1436. result:=(cs_opt_regvar in current_settings.optimizerswitches) and
  1437. not(pi_has_assembler_block in current_procinfo.flags) and
  1438. not(pi_uses_exceptions in current_procinfo.flags) and
  1439. not(pi_has_interproclabel in current_procinfo.flags) and
  1440. not(vo_has_local_copy in varoptions) and
  1441. ((refpara and
  1442. (varregable <> vr_none)) or
  1443. (not refpara and
  1444. not(varregable in [vr_none,vr_addr])))
  1445. {$if not defined(powerpc) and not defined(powerpc64)}
  1446. and ((vardef.typ <> recorddef) or
  1447. (varregable = vr_addr) or
  1448. not(varstate in [vs_written,vs_readwritten]));
  1449. {$endif}
  1450. end;
  1451. procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag);
  1452. var n:Tnotification;
  1453. begin
  1454. if assigned(notifications) then
  1455. begin
  1456. n:=Tnotification(notifications.first);
  1457. while assigned(n) do
  1458. begin
  1459. if what in n.flags then
  1460. n.callback(what,self);
  1461. n:=Tnotification(n.next);
  1462. end;
  1463. end;
  1464. end;
  1465. function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback:
  1466. Tnotification_callback):cardinal;
  1467. var n:Tnotification;
  1468. begin
  1469. if not assigned(notifications) then
  1470. notifications:=Tlinkedlist.create;
  1471. n:=Tnotification.create(flags,callback);
  1472. register_notification:=n.id;
  1473. notifications.concat(n);
  1474. end;
  1475. procedure Tabstractvarsym.unregister_notification(id:cardinal);
  1476. var n:Tnotification;
  1477. begin
  1478. if not assigned(notifications) then
  1479. internalerror(200212311)
  1480. else
  1481. begin
  1482. n:=Tnotification(notifications.first);
  1483. while assigned(n) do
  1484. begin
  1485. if n.id=id then
  1486. begin
  1487. notifications.remove(n);
  1488. n.destroy;
  1489. exit;
  1490. end;
  1491. n:=Tnotification(n.next);
  1492. end;
  1493. internalerror(200212311)
  1494. end;
  1495. end;
  1496. procedure tabstractvarsym.setvardef(def:tdef);
  1497. begin
  1498. _vardef := def;
  1499. { can we load the value into a register ? }
  1500. if not assigned(owner) or
  1501. (owner.symtabletype in [localsymtable,parasymtable]) or
  1502. (
  1503. (owner.symtabletype=staticsymtable) and
  1504. not(cs_create_pic in current_settings.moduleswitches)
  1505. ) then
  1506. begin
  1507. if (tstoreddef(vardef).is_intregable and
  1508. { we could keep all aint*2 records in registers, but this causes
  1509. too much spilling for CPUs with 8-16 registers so keep only
  1510. parameters and function results of this type in register because they are normally
  1511. passed by register anyways
  1512. This can be changed, as soon as we have full ssa (FK) }
  1513. ((typ=paravarsym) or
  1514. (vo_is_funcret in varoptions) or
  1515. (tstoreddef(vardef).typ<>recorddef) or
  1516. (tstoreddef(vardef).size<=sizeof(aint)))) or
  1517. { const parameters can be put into registers if the def fits into a register }
  1518. (tstoreddef(vardef).is_const_intregable and
  1519. (typ=paravarsym) and
  1520. (varspez=vs_const)) then
  1521. varregable:=vr_intreg
  1522. else
  1523. { $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 }
  1524. if {(
  1525. not assigned(owner) or
  1526. (owner.symtabletype<>staticsymtable)
  1527. ) and }
  1528. tstoreddef(vardef).is_fpuregable then
  1529. begin
  1530. if use_vectorfpu(vardef) then
  1531. varregable:=vr_mmreg
  1532. else
  1533. varregable:=vr_fpureg;
  1534. end;
  1535. end;
  1536. end;
  1537. {****************************************************************************
  1538. TFIELDVARSYM
  1539. ****************************************************************************}
  1540. constructor tfieldvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1541. begin
  1542. inherited create(fieldvarsym,n,vsp,def,vopts);
  1543. fieldoffset:=-1;
  1544. end;
  1545. constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
  1546. begin
  1547. inherited ppuload(fieldvarsym,ppufile);
  1548. fieldoffset:=ppufile.getaint;
  1549. if (vo_has_mangledname in varoptions) then
  1550. externalname:=stringdup(ppufile.getstring)
  1551. else
  1552. externalname:=nil;
  1553. ppuload_platform(ppufile);
  1554. end;
  1555. procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
  1556. begin
  1557. inherited ppuwrite(ppufile);
  1558. ppufile.putaint(fieldoffset);
  1559. if (vo_has_mangledname in varoptions) then
  1560. ppufile.putstring(externalname^);
  1561. writeentry(ppufile,ibfieldvarsym);
  1562. end;
  1563. procedure tfieldvarsym.set_externalname(const s: string);
  1564. begin
  1565. internalerror(2014033001);
  1566. end;
  1567. function tfieldvarsym.mangledname:TSymStr;
  1568. var
  1569. srsym : tsym;
  1570. srsymtable : tsymtable;
  1571. begin
  1572. if sp_static in symoptions then
  1573. begin
  1574. if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1575. result:=srsym.mangledname
  1576. { when generating the debug info for the module in which the }
  1577. { symbol is defined, the localsymtable of that module is }
  1578. { already popped from the symtablestack }
  1579. else if searchsym_in_module(current_module,lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1580. result:=srsym.mangledname
  1581. else
  1582. internalerror(2007012501);
  1583. end
  1584. else if is_objcclass(tdef(owner.defowner)) then
  1585. begin
  1586. {$ifdef symansistr}
  1587. if cachedmangledname<>'' then
  1588. result:=cachedmangledname
  1589. {$else symansistr}
  1590. if assigned(cachedmangledname) then
  1591. result:=cachedmangledname^
  1592. {$endif symansistr}
  1593. else
  1594. begin
  1595. result:=target_info.cprefix+'OBJC_IVAR_$_'+tobjectdef(owner.defowner).objextname^+'.'+RealName;
  1596. {$ifdef symansistr}
  1597. cachedmangledname:=result;
  1598. {$else symansistr}
  1599. cachedmangledname:=stringdup(result);
  1600. {$endif symansistr}
  1601. end;
  1602. end
  1603. else
  1604. result:=inherited mangledname;
  1605. end;
  1606. destructor tfieldvarsym.destroy;
  1607. begin
  1608. {$ifndef symansistr}
  1609. stringdispose(cachedmangledname);
  1610. {$endif symansistr}
  1611. stringdispose(externalname);
  1612. inherited destroy;
  1613. end;
  1614. {****************************************************************************
  1615. TABSTRACTNORMALVARSYM
  1616. ****************************************************************************}
  1617. constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1618. begin
  1619. inherited create(st,n,vsp,def,vopts);
  1620. fillchar(localloc,sizeof(localloc),0);
  1621. fillchar(currentregloc,sizeof(localloc),0);
  1622. fillchar(initialloc,sizeof(initialloc),0);
  1623. defaultconstsym:=nil;
  1624. end;
  1625. constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1626. begin
  1627. inherited ppuload(st,ppufile);
  1628. fillchar(localloc,sizeof(localloc),0);
  1629. fillchar(currentregloc,sizeof(localloc),0);
  1630. fillchar(initialloc,sizeof(initialloc),0);
  1631. ppufile.getderef(defaultconstsymderef);
  1632. end;
  1633. function tabstractnormalvarsym.globalasmsym: boolean;
  1634. begin
  1635. result:=
  1636. (owner.symtabletype=globalsymtable) or
  1637. (create_smartlink and
  1638. not(tf_smartlink_sections in target_info.flags)) or
  1639. DLLSource or
  1640. (assigned(current_procinfo) and
  1641. ((po_inline in current_procinfo.procdef.procoptions) or
  1642. { globalasmsym is called normally before the body of a subroutine is parsed
  1643. so we cannot know if it will be auto inlined, so make all symbols of it
  1644. global if asked }
  1645. (cs_opt_autoinline in current_settings.optimizerswitches))
  1646. ) or
  1647. (vo_is_public in varoptions);
  1648. end;
  1649. procedure tabstractnormalvarsym.buildderef;
  1650. begin
  1651. inherited buildderef;
  1652. defaultconstsymderef.build(defaultconstsym);
  1653. end;
  1654. procedure tabstractnormalvarsym.deref;
  1655. begin
  1656. inherited deref;
  1657. defaultconstsym:=tsym(defaultconstsymderef.resolve);
  1658. end;
  1659. procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1660. begin
  1661. inherited ppuwrite(ppufile);
  1662. ppufile.putderef(defaultconstsymderef);
  1663. end;
  1664. {****************************************************************************
  1665. Tstaticvarsym
  1666. ****************************************************************************}
  1667. constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1668. begin
  1669. inherited create(staticvarsym,n,vsp,def,vopts);
  1670. {$ifdef symansistr}
  1671. _mangledname:='';
  1672. {$else symansistr}
  1673. _mangledname:=nil;
  1674. {$endif symansistr}
  1675. end;
  1676. constructor tstaticvarsym.create_dll(const n : string;vsp:tvarspez;def:tdef);
  1677. begin
  1678. tstaticvarsym(self).create(n,vsp,def,[vo_is_dll_var]);
  1679. end;
  1680. constructor tstaticvarsym.create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);
  1681. begin
  1682. tstaticvarsym(self).create(n,vsp,def,[]);
  1683. set_mangledname(mangled);
  1684. end;
  1685. constructor tstaticvarsym.create_from_fieldvar(const n: string;fieldvar:tfieldvarsym);
  1686. begin
  1687. create(internal_static_field_name(n),vs_value,fieldvar.vardef,[]);
  1688. fieldvarsym:=fieldvar;
  1689. end;
  1690. constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
  1691. begin
  1692. inherited ppuload(staticvarsym,ppufile);
  1693. {$ifdef symansistr}
  1694. if vo_has_mangledname in varoptions then
  1695. _mangledname:=ppufile.getansistring
  1696. else
  1697. _mangledname:='';
  1698. {$else symansistr}
  1699. if vo_has_mangledname in varoptions then
  1700. _mangledname:=stringdup(ppufile.getstring)
  1701. else
  1702. _mangledname:=nil;
  1703. {$endif symansistr}
  1704. if vo_has_section in varoptions then
  1705. section:=ppufile.getansistring;
  1706. ppufile.getderef(fieldvarsymderef);
  1707. ppuload_platform(ppufile);
  1708. end;
  1709. destructor tstaticvarsym.destroy;
  1710. begin
  1711. {$ifndef symansistr}
  1712. if assigned(_mangledname) then
  1713. begin
  1714. {$ifdef MEMDEBUG}
  1715. memmanglednames.start;
  1716. {$endif MEMDEBUG}
  1717. stringdispose(_mangledname);
  1718. {$ifdef MEMDEBUG}
  1719. memmanglednames.stop;
  1720. {$endif MEMDEBUG}
  1721. end;
  1722. stringdispose(_mangledbasename);
  1723. {$endif}
  1724. inherited destroy;
  1725. end;
  1726. procedure tstaticvarsym.ppuwrite(ppufile:tcompilerppufile);
  1727. begin
  1728. inherited ppuwrite(ppufile);
  1729. { write mangledname rather than _mangledname in case the mangledname
  1730. has not been calculated yet (can happen in case only the
  1731. mangledbasename has been set) }
  1732. if vo_has_mangledname in varoptions then
  1733. {$ifdef symansistr}
  1734. ppufile.putansistring(mangledname);
  1735. {$else symansistr}
  1736. ppufile.putstring(mangledname);
  1737. {$endif symansistr}
  1738. if vo_has_section in varoptions then
  1739. ppufile.putansistring(section);
  1740. ppufile.putderef(fieldvarsymderef);
  1741. writeentry(ppufile,ibstaticvarsym);
  1742. end;
  1743. procedure tstaticvarsym.buildderef;
  1744. begin
  1745. inherited buildderef;
  1746. fieldvarsymderef.build(fieldvarsym);
  1747. end;
  1748. procedure tstaticvarsym.deref;
  1749. begin
  1750. inherited deref;
  1751. fieldvarsym:=tfieldvarsym(fieldvarsymderef.resolve);
  1752. end;
  1753. function tstaticvarsym.mangledname:TSymStr;
  1754. var
  1755. usename,
  1756. prefix : TSymStr;
  1757. begin
  1758. {$ifdef symansistr}
  1759. if _mangledname='' then
  1760. {$else symansistr}
  1761. if not assigned(_mangledname) then
  1762. {$endif symansistr}
  1763. begin
  1764. if (vo_is_typed_const in varoptions) then
  1765. prefix:='TC'
  1766. else
  1767. prefix:='U';
  1768. {$ifdef symansistr}
  1769. if _mangledbasename='' then
  1770. usename:=name
  1771. else
  1772. usename:=_mangledbasename;
  1773. _mangledname:=make_mangledname(prefix,owner,usename);
  1774. {$else symansistr}
  1775. if not assigned(_mangledbasename) then
  1776. usename:=name
  1777. else
  1778. usename:=_mangledbasename^;
  1779. _mangledname:=stringdup(make_mangledname(prefix,owner,usename));
  1780. {$endif symansistr}
  1781. end;
  1782. {$ifdef symansistr}
  1783. result:=_mangledname;
  1784. {$else symansistr}
  1785. result:=_mangledname^;
  1786. {$endif symansistr}
  1787. end;
  1788. procedure tstaticvarsym.set_mangledbasename(const s: TSymStr);
  1789. begin
  1790. {$ifdef symansistr}
  1791. _mangledbasename:=s;
  1792. _mangledname:='';
  1793. {$else symansistr}
  1794. stringdispose(_mangledname);
  1795. stringdispose(_mangledbasename);
  1796. _mangledbasename:=stringdup(s);
  1797. {$endif symansistr}
  1798. include(varoptions,vo_has_mangledname);
  1799. end;
  1800. function tstaticvarsym.mangledbasename: TSymStr;
  1801. begin
  1802. {$ifdef symansistr}
  1803. result:=_mangledbasename;
  1804. {$else symansistr}
  1805. if assigned(_mangledbasename) then
  1806. result:=_mangledbasename^
  1807. else
  1808. result:='';
  1809. {$endif symansistr}
  1810. end;
  1811. procedure tstaticvarsym.set_mangledname(const s:TSymStr);
  1812. begin
  1813. {$ifdef symansistr}
  1814. _mangledname:=s;
  1815. {$else symansistr}
  1816. stringdispose(_mangledname);
  1817. _mangledname:=stringdup(s);
  1818. {$endif symansistr}
  1819. include(varoptions,vo_has_mangledname);
  1820. end;
  1821. procedure tstaticvarsym.set_raw_mangledname(const s: TSymStr);
  1822. begin
  1823. {$ifndef symansistr}
  1824. stringdispose(_mangledname);
  1825. _mangledname:=stringdup(s);
  1826. {$else}
  1827. _mangledname:=s;
  1828. {$endif}
  1829. include(varoptions,vo_has_mangledname);
  1830. end;
  1831. {****************************************************************************
  1832. TLOCALVARSYM
  1833. ****************************************************************************}
  1834. constructor tlocalvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1835. begin
  1836. inherited create(localvarsym,n,vsp,def,vopts);
  1837. end;
  1838. constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
  1839. begin
  1840. inherited ppuload(localvarsym,ppufile);
  1841. ppuload_platform(ppufile);
  1842. end;
  1843. procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1844. begin
  1845. inherited ppuwrite(ppufile);
  1846. writeentry(ppufile,iblocalvarsym);
  1847. end;
  1848. {****************************************************************************
  1849. TPARAVARSYM
  1850. ****************************************************************************}
  1851. constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1852. begin
  1853. inherited create(paravarsym,n,vsp,def,vopts);
  1854. if (vsp in [vs_var,vs_value,vs_const,vs_constref]) and
  1855. not(vo_is_funcret in vopts) then
  1856. varstate := vs_initialised;
  1857. paranr:=nr;
  1858. paraloc[calleeside].init;
  1859. paraloc[callerside].init;
  1860. end;
  1861. destructor tparavarsym.destroy;
  1862. begin
  1863. paraloc[calleeside].done;
  1864. paraloc[callerside].done;
  1865. inherited destroy;
  1866. end;
  1867. constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
  1868. var
  1869. b : byte;
  1870. begin
  1871. inherited ppuload(paravarsym,ppufile);
  1872. paranr:=ppufile.getword;
  1873. univpara:=boolean(ppufile.getbyte);
  1874. { The var state of parameter symbols is fixed after writing them so
  1875. we write them to the unit file.
  1876. This enables constant folding for inline procedures loaded from units
  1877. }
  1878. varstate:=tvarstate(ppufile.getbyte);
  1879. { read usage info }
  1880. refs:=ppufile.getbyte;
  1881. paraloc[calleeside].init;
  1882. paraloc[callerside].init;
  1883. if vo_has_explicit_paraloc in varoptions then
  1884. paraloc[callerside].ppuload(ppufile);
  1885. ppuload_platform(ppufile);
  1886. end;
  1887. procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
  1888. var
  1889. oldintfcrc : boolean;
  1890. begin
  1891. inherited ppuwrite(ppufile);
  1892. ppufile.putword(paranr);
  1893. ppufile.putbyte(byte(univpara));
  1894. { The var state of parameter symbols is fixed after writing them so
  1895. we write them to the unit file.
  1896. This enables constant folding for inline procedures loaded from units
  1897. }
  1898. oldintfcrc:=ppufile.do_crc;
  1899. ppufile.do_crc:=false;
  1900. ppufile.putbyte(ord(varstate));
  1901. { write also info about the usage of parameters,
  1902. the absolute usage does not matter }
  1903. ppufile.putbyte(min(1,refs));
  1904. ppufile.do_crc:=oldintfcrc;
  1905. if vo_has_explicit_paraloc in varoptions then
  1906. begin
  1907. paraloc[callerside].check_simple_location;
  1908. paraloc[callerside].ppuwrite(ppufile);
  1909. end;
  1910. writeentry(ppufile,ibparavarsym);
  1911. end;
  1912. function tparavarsym.needs_finalization:boolean;
  1913. begin
  1914. result:=(varspez=vs_value) and
  1915. (is_managed_type(vardef) or
  1916. (
  1917. (not (tabstractprocdef(owner.defowner).proccalloption in cdecl_pocalls)) and
  1918. (not paramanager.use_stackalloc) and
  1919. (is_open_array(vardef) or is_array_of_const(vardef))
  1920. )
  1921. );
  1922. end;
  1923. {****************************************************************************
  1924. TABSOLUTEVARSYM
  1925. ****************************************************************************}
  1926. constructor tabsolutevarsym.create(const n : string;def:tdef);
  1927. begin
  1928. inherited create(absolutevarsym,n,vs_value,def,[]);
  1929. ref:=nil;
  1930. end;
  1931. constructor tabsolutevarsym.create_ref(const n : string;def:tdef;_ref:tpropaccesslist);
  1932. begin
  1933. inherited create(absolutevarsym,n,vs_value,def,[]);
  1934. ref:=_ref;
  1935. end;
  1936. destructor tabsolutevarsym.destroy;
  1937. begin
  1938. if assigned(ref) then
  1939. ref.free;
  1940. inherited destroy;
  1941. end;
  1942. constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
  1943. begin
  1944. inherited ppuload(absolutevarsym,ppufile);
  1945. ref:=nil;
  1946. asmname:=nil;
  1947. abstyp:=absolutetyp(ppufile.getbyte);
  1948. case abstyp of
  1949. tovar :
  1950. ref:=ppufile.getpropaccesslist;
  1951. toasm :
  1952. asmname:=stringdup(ppufile.getstring);
  1953. toaddr :
  1954. addroffset:=ppufile.getaword;
  1955. end;
  1956. ppuload_platform(ppufile);
  1957. end;
  1958. procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
  1959. begin
  1960. inherited ppuwrite(ppufile);
  1961. ppufile.putbyte(byte(abstyp));
  1962. case abstyp of
  1963. tovar :
  1964. ppufile.putpropaccesslist(ref);
  1965. toasm :
  1966. ppufile.putstring(asmname^);
  1967. toaddr :
  1968. ppufile.putaword(addroffset);
  1969. end;
  1970. writeentry(ppufile,ibabsolutevarsym);
  1971. end;
  1972. procedure tabsolutevarsym.buildderef;
  1973. begin
  1974. inherited buildderef;
  1975. if (abstyp=tovar) then
  1976. ref.buildderef;
  1977. end;
  1978. procedure tabsolutevarsym.deref;
  1979. begin
  1980. inherited deref;
  1981. { own absolute deref }
  1982. if (abstyp=tovar) then
  1983. ref.resolve;
  1984. end;
  1985. function tabsolutevarsym.mangledname : TSymStr;
  1986. begin
  1987. case abstyp of
  1988. toasm :
  1989. mangledname:=asmname^;
  1990. toaddr :
  1991. mangledname:='$'+tostr(addroffset);
  1992. else
  1993. internalerror(200411062);
  1994. end;
  1995. end;
  1996. {****************************************************************************
  1997. TCONSTSYM
  1998. ****************************************************************************}
  1999. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
  2000. begin
  2001. inherited create(constsym,n);
  2002. fillchar(value, sizeof(value), #0);
  2003. consttyp:=t;
  2004. value.valueord:=v;
  2005. constdef:=def;
  2006. end;
  2007. constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
  2008. begin
  2009. inherited create(constsym,n);
  2010. fillchar(value, sizeof(value), #0);
  2011. consttyp:=t;
  2012. value.valueordptr:=v;
  2013. constdef:=def;
  2014. end;
  2015. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
  2016. begin
  2017. inherited create(constsym,n);
  2018. fillchar(value, sizeof(value), #0);
  2019. consttyp:=t;
  2020. value.valueptr:=v;
  2021. constdef:=def;
  2022. end;
  2023. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def: tdef);
  2024. begin
  2025. inherited create(constsym,n);
  2026. fillchar(value, sizeof(value), #0);
  2027. consttyp:=t;
  2028. value.valueptr:=str;
  2029. if assigned(def) then
  2030. constdef:=def
  2031. else
  2032. constdef:=getarraydef(cansichartype,l);
  2033. value.len:=l;
  2034. end;
  2035. constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  2036. begin
  2037. inherited create(constsym,n);
  2038. fillchar(value, sizeof(value), #0);
  2039. consttyp:=t;
  2040. pcompilerwidestring(value.valueptr):=pw;
  2041. constdef:=getarraydef(cwidechartype,getlengthwidestring(pw));
  2042. value.len:=getlengthwidestring(pw);
  2043. end;
  2044. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  2045. var
  2046. pd : pbestreal;
  2047. ps : pnormalset;
  2048. pc : pchar;
  2049. pw : pcompilerwidestring;
  2050. i : longint;
  2051. begin
  2052. inherited ppuload(constsym,ppufile);
  2053. constdef:=nil;
  2054. consttyp:=tconsttyp(ppufile.getbyte);
  2055. fillchar(value, sizeof(value), #0);
  2056. case consttyp of
  2057. constord :
  2058. begin
  2059. ppufile.getderef(constdefderef);
  2060. value.valueord:=ppufile.getexprint;
  2061. end;
  2062. constpointer :
  2063. begin
  2064. ppufile.getderef(constdefderef);
  2065. value.valueordptr:=ppufile.getptruint;
  2066. end;
  2067. constwstring :
  2068. begin
  2069. initwidestring(pw);
  2070. setlengthwidestring(pw,ppufile.getlongint);
  2071. { don't use getdata, because the compilerwidechars may have to
  2072. be byteswapped
  2073. }
  2074. {$if sizeof(tcompilerwidechar) = 2}
  2075. for i:=0 to pw^.len-1 do
  2076. pw^.data[i]:=ppufile.getword;
  2077. {$elseif sizeof(tcompilerwidechar) = 4}
  2078. for i:=0 to pw^.len-1 do
  2079. pw^.data[i]:=cardinal(ppufile.getlongint);
  2080. {$else}
  2081. {$error Unsupported tcompilerwidechar size}
  2082. {$endif}
  2083. pcompilerwidestring(value.valueptr):=pw;
  2084. end;
  2085. conststring,
  2086. constresourcestring :
  2087. begin
  2088. value.len:=ppufile.getlongint;
  2089. getmem(pc,value.len+1);
  2090. ppufile.getdata(pc^,value.len);
  2091. pc[value.len]:=#0;
  2092. value.valueptr:=pc;
  2093. end;
  2094. constreal :
  2095. begin
  2096. ppufile.getderef(constdefderef);
  2097. new(pd);
  2098. pd^:=ppufile.getreal;
  2099. value.valueptr:=pd;
  2100. end;
  2101. constset :
  2102. begin
  2103. ppufile.getderef(constdefderef);
  2104. new(ps);
  2105. ppufile.getnormalset(ps^);
  2106. value.valueptr:=ps;
  2107. end;
  2108. constguid :
  2109. begin
  2110. new(pguid(value.valueptr));
  2111. ppufile.getdata(value.valueptr^,sizeof(tguid));
  2112. end;
  2113. constnil : ;
  2114. else
  2115. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  2116. end;
  2117. ppuload_platform(ppufile);
  2118. end;
  2119. destructor tconstsym.destroy;
  2120. begin
  2121. case consttyp of
  2122. conststring,
  2123. constresourcestring :
  2124. freemem(pchar(value.valueptr),value.len+1);
  2125. constwstring :
  2126. donewidestring(pcompilerwidestring(value.valueptr));
  2127. constreal :
  2128. dispose(pbestreal(value.valueptr));
  2129. constset :
  2130. dispose(pnormalset(value.valueptr));
  2131. constguid :
  2132. dispose(pguid(value.valueptr));
  2133. end;
  2134. inherited destroy;
  2135. end;
  2136. procedure tconstsym.buildderef;
  2137. begin
  2138. if consttyp in [constord,constreal,constpointer,constset] then
  2139. constdefderef.build(constdef);
  2140. end;
  2141. procedure tconstsym.deref;
  2142. begin
  2143. if consttyp in [constord,constreal,constpointer,constset] then
  2144. constdef:=tdef(constdefderef.resolve);
  2145. end;
  2146. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  2147. begin
  2148. inherited ppuwrite(ppufile);
  2149. ppufile.putbyte(byte(consttyp));
  2150. case consttyp of
  2151. constnil : ;
  2152. constord :
  2153. begin
  2154. ppufile.putderef(constdefderef);
  2155. ppufile.putexprint(value.valueord);
  2156. end;
  2157. constpointer :
  2158. begin
  2159. ppufile.putderef(constdefderef);
  2160. ppufile.putptruint(value.valueordptr);
  2161. end;
  2162. constwstring :
  2163. begin
  2164. ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
  2165. ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
  2166. end;
  2167. conststring,
  2168. constresourcestring :
  2169. begin
  2170. ppufile.putlongint(value.len);
  2171. ppufile.putdata(pchar(value.valueptr)^,value.len);
  2172. end;
  2173. constreal :
  2174. begin
  2175. ppufile.putderef(constdefderef);
  2176. ppufile.putreal(pbestreal(value.valueptr)^);
  2177. end;
  2178. constset :
  2179. begin
  2180. ppufile.putderef(constdefderef);
  2181. ppufile.putnormalset(value.valueptr^);
  2182. end;
  2183. constguid :
  2184. ppufile.putdata(value.valueptr^,sizeof(tguid));
  2185. else
  2186. internalerror(13);
  2187. end;
  2188. writeentry(ppufile,ibconstsym);
  2189. end;
  2190. {****************************************************************************
  2191. TENUMSYM
  2192. ****************************************************************************}
  2193. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  2194. begin
  2195. inherited create(enumsym,n);
  2196. definition:=def;
  2197. value:=v;
  2198. end;
  2199. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  2200. begin
  2201. inherited ppuload(enumsym,ppufile);
  2202. ppufile.getderef(definitionderef);
  2203. value:=ppufile.getlongint;
  2204. ppuload_platform(ppufile);
  2205. end;
  2206. procedure tenumsym.buildderef;
  2207. begin
  2208. definitionderef.build(definition);
  2209. end;
  2210. procedure tenumsym.deref;
  2211. begin
  2212. definition:=tenumdef(definitionderef.resolve);
  2213. end;
  2214. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  2215. begin
  2216. inherited ppuwrite(ppufile);
  2217. ppufile.putderef(definitionderef);
  2218. ppufile.putlongint(value);
  2219. writeentry(ppufile,ibenumsym);
  2220. end;
  2221. {****************************************************************************
  2222. TTYPESYM
  2223. ****************************************************************************}
  2224. constructor ttypesym.create(const n : string;def:tdef);
  2225. begin
  2226. inherited create(typesym,n);
  2227. typedef:=def;
  2228. { register the typesym for the definition }
  2229. if assigned(typedef) and
  2230. (typedef.typ<>errordef) and
  2231. not(assigned(typedef.typesym)) then
  2232. typedef.typesym:=self;
  2233. end;
  2234. destructor ttypesym.destroy;
  2235. begin
  2236. inherited destroy;
  2237. end;
  2238. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  2239. begin
  2240. inherited ppuload(typesym,ppufile);
  2241. ppufile.getderef(typedefderef);
  2242. fprettyname:=ppufile.getansistring;
  2243. ppuload_platform(ppufile);
  2244. end;
  2245. procedure ttypesym.buildderef;
  2246. begin
  2247. typedefderef.build(typedef);
  2248. end;
  2249. procedure ttypesym.deref;
  2250. begin
  2251. typedef:=tdef(typedefderef.resolve);
  2252. end;
  2253. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  2254. begin
  2255. inherited ppuwrite(ppufile);
  2256. ppufile.putderef(typedefderef);
  2257. ppufile.putansistring(fprettyname);
  2258. writeentry(ppufile,ibtypesym);
  2259. end;
  2260. function ttypesym.prettyname : string;
  2261. begin
  2262. if fprettyname<>'' then
  2263. result:=fprettyname
  2264. else
  2265. result:=inherited prettyname;
  2266. end;
  2267. {****************************************************************************
  2268. TSYSSYM
  2269. ****************************************************************************}
  2270. constructor tsyssym.create(const n : string;l : longint);
  2271. begin
  2272. inherited create(syssym,n);
  2273. number:=l;
  2274. end;
  2275. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  2276. begin
  2277. inherited ppuload(syssym,ppufile);
  2278. number:=ppufile.getlongint;
  2279. ppuload_platform(ppufile);
  2280. end;
  2281. destructor tsyssym.destroy;
  2282. begin
  2283. inherited destroy;
  2284. end;
  2285. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  2286. begin
  2287. inherited ppuwrite(ppufile);
  2288. ppufile.putlongint(number);
  2289. writeentry(ppufile,ibsyssym);
  2290. end;
  2291. {*****************************************************************************
  2292. TMacro
  2293. *****************************************************************************}
  2294. constructor tmacro.create(const n : string);
  2295. begin
  2296. inherited create(macrosym,n);
  2297. owner:=nil;
  2298. defined:=false;
  2299. is_used:=false;
  2300. is_compiler_var:=false;
  2301. buftext:=nil;
  2302. buflen:=0;
  2303. end;
  2304. constructor tmacro.ppuload(ppufile:tcompilerppufile);
  2305. begin
  2306. inherited ppuload(macrosym,ppufile);
  2307. defined:=boolean(ppufile.getbyte);
  2308. is_compiler_var:=boolean(ppufile.getbyte);
  2309. is_used:=false;
  2310. buflen:= ppufile.getlongint;
  2311. if buflen > 0 then
  2312. begin
  2313. getmem(buftext, buflen);
  2314. ppufile.getdata(buftext^, buflen)
  2315. end
  2316. else
  2317. buftext:=nil;
  2318. end;
  2319. destructor tmacro.destroy;
  2320. begin
  2321. if assigned(buftext) then
  2322. freemem(buftext);
  2323. inherited destroy;
  2324. end;
  2325. procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
  2326. begin
  2327. inherited ppuwrite(ppufile);
  2328. ppufile.putbyte(byte(defined));
  2329. ppufile.putbyte(byte(is_compiler_var));
  2330. ppufile.putlongint(buflen);
  2331. if buflen > 0 then
  2332. ppufile.putdata(buftext^,buflen);
  2333. writeentry(ppufile,ibmacrosym);
  2334. end;
  2335. function tmacro.GetCopy:tmacro;
  2336. var
  2337. p : tmacro;
  2338. begin
  2339. p:=tmacro.create(realname);
  2340. p.defined:=defined;
  2341. p.is_used:=is_used;
  2342. p.is_compiler_var:=is_compiler_var;
  2343. p.buflen:=buflen;
  2344. if assigned(buftext) then
  2345. begin
  2346. getmem(p.buftext,buflen);
  2347. move(buftext^,p.buftext^,buflen);
  2348. end;
  2349. Result:=p;
  2350. end;
  2351. {****************************************************************************
  2352. tPtrDefHashSet
  2353. ****************************************************************************}
  2354. constructor tPtrDefHashSet.Create;
  2355. begin
  2356. inherited Create(64,true,false);
  2357. end;
  2358. end.