symsym.pas 89 KB

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