symsym.pas 83 KB

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