symsym.pas 61 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946
  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. { when the label is defined in an asm block, this points to the
  52. generated asmlabel }
  53. asmblocklabel : tasmlabel;
  54. constructor create(const n : string);
  55. constructor ppuload(ppufile:tcompilerppufile);
  56. procedure ppuwrite(ppufile:tcompilerppufile);override;
  57. function mangledname:string;override;
  58. end;
  59. tunitsym = class(Tstoredsym)
  60. module : tobject; { tmodule }
  61. constructor create(const n : string;amodule : tobject);
  62. constructor ppuload(ppufile:tcompilerppufile);
  63. destructor destroy;override;
  64. procedure ppuwrite(ppufile:tcompilerppufile);override;
  65. end;
  66. terrorsym = class(Tsym)
  67. constructor create;
  68. end;
  69. { tprocsym }
  70. tprocsym = class(tstoredsym)
  71. protected
  72. FProcdefList : TFPObjectList;
  73. FProcdefDerefList : TFPList;
  74. public
  75. constructor create(const n : string);
  76. constructor ppuload(ppufile:tcompilerppufile);
  77. destructor destroy;override;
  78. { writes all declarations except the specified one }
  79. procedure write_parameter_lists(skipdef:tprocdef);
  80. { tests, if all procedures definitions are defined and not }
  81. { only forward }
  82. procedure check_forward;
  83. procedure ppuwrite(ppufile:tcompilerppufile);override;
  84. procedure buildderef;override;
  85. procedure deref;override;
  86. function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  87. function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  88. function find_procdef_byoptions(ops:tprocoptions): Tprocdef;
  89. function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  90. function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  91. function find_procdef_enumerator_operator(typedef:tdef;var besteq:tequaltype):Tprocdef;
  92. property ProcdefList:TFPObjectList read FProcdefList;
  93. end;
  94. ttypesym = class(Tstoredsym)
  95. typedef : tdef;
  96. typedefderef : tderef;
  97. constructor create(const n : string;def:tdef);
  98. constructor ppuload(ppufile:tcompilerppufile);
  99. procedure ppuwrite(ppufile:tcompilerppufile);override;
  100. procedure buildderef;override;
  101. procedure deref;override;
  102. end;
  103. tabstractvarsym = class(tstoredsym)
  104. varoptions : tvaroptions;
  105. notifications : Tlinkedlist;
  106. varspez : tvarspez; { sets the type of access }
  107. varregable : tvarregable;
  108. varstate : tvarstate;
  109. { Has the address of this variable potentially escaped the }
  110. { block in which is was declared? }
  111. { could also be part of tabstractnormalvarsym, but there's }
  112. { one byte left here till the next 4 byte alignment }
  113. addr_taken : boolean;
  114. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  115. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  116. destructor destroy;override;
  117. procedure ppuwrite(ppufile:tcompilerppufile);override;
  118. procedure buildderef;override;
  119. procedure deref;override;
  120. function getsize : aint;
  121. function getpackedbitsize : longint;
  122. function is_regvar(refpara: boolean):boolean;
  123. procedure trigger_notifications(what:Tnotification_flag);
  124. function register_notification(flags:Tnotification_flags;
  125. callback:Tnotification_callback):cardinal;
  126. procedure unregister_notification(id:cardinal);
  127. private
  128. _vardef : tdef;
  129. vardefderef : tderef;
  130. procedure setvardef(def:tdef);
  131. public
  132. property vardef: tdef read _vardef write setvardef;
  133. end;
  134. tfieldvarsym = class(tabstractvarsym)
  135. fieldoffset : aint; { offset in record/object }
  136. objcoffsetmangledname: pshortstring; { mangled name of offset, calculated as needed }
  137. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  138. constructor ppuload(ppufile:tcompilerppufile);
  139. procedure ppuwrite(ppufile:tcompilerppufile);override;
  140. function mangledname:string;override;
  141. destructor destroy;override;
  142. end;
  143. tabstractnormalvarsym = class(tabstractvarsym)
  144. defaultconstsym : tsym;
  145. defaultconstsymderef : tderef;
  146. localloc : TLocation; { register/reference for local var }
  147. initialloc : TLocation; { initial location so it can still be initialized later after the location was changed by SSA }
  148. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  149. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  150. procedure ppuwrite(ppufile:tcompilerppufile);override;
  151. procedure buildderef;override;
  152. procedure deref;override;
  153. end;
  154. tlocalvarsym = class(tabstractnormalvarsym)
  155. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  156. constructor ppuload(ppufile:tcompilerppufile);
  157. procedure ppuwrite(ppufile:tcompilerppufile);override;
  158. end;
  159. tparavarsym = class(tabstractnormalvarsym)
  160. paraloc : array[tcallercallee] of TCGPara;
  161. paranr : word; { position of this parameter }
  162. { in MacPas mode, "univ" parameters mean that type checking should
  163. be disabled, except that the size of the passed parameter must
  164. match the size of the formal parameter }
  165. univpara : boolean;
  166. {$ifdef EXTDEBUG}
  167. eqval : tequaltype;
  168. {$endif EXTDEBUG}
  169. constructor create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  170. constructor ppuload(ppufile:tcompilerppufile);
  171. destructor destroy;override;
  172. procedure ppuwrite(ppufile:tcompilerppufile);override;
  173. end;
  174. tstaticvarsym = class(tabstractnormalvarsym)
  175. private
  176. _mangledname : pshortstring;
  177. public
  178. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  179. constructor create_dll(const n : string;vsp:tvarspez;def:tdef);
  180. constructor create_C(const n,mangled : string;vsp:tvarspez;def:tdef);
  181. constructor ppuload(ppufile:tcompilerppufile);
  182. destructor destroy;override;
  183. procedure ppuwrite(ppufile:tcompilerppufile);override;
  184. function mangledname:string;override;
  185. procedure set_mangledname(const s:string);
  186. end;
  187. tabsolutevarsym = class(tabstractvarsym)
  188. public
  189. abstyp : absolutetyp;
  190. {$ifdef i386}
  191. absseg : boolean;
  192. {$endif i386}
  193. asmname : pshortstring;
  194. addroffset : aword;
  195. ref : tpropaccesslist;
  196. constructor create(const n : string;def:tdef);
  197. constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist);
  198. destructor destroy;override;
  199. constructor ppuload(ppufile:tcompilerppufile);
  200. procedure buildderef;override;
  201. procedure deref;override;
  202. function mangledname : string;override;
  203. procedure ppuwrite(ppufile:tcompilerppufile);override;
  204. end;
  205. tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
  206. tpropertysym = class(Tstoredsym)
  207. propoptions : tpropertyoptions;
  208. overridenpropsym : tpropertysym;
  209. overridenpropsymderef : tderef;
  210. propdef : tdef;
  211. propdefderef : tderef;
  212. indexdef : tdef;
  213. indexdefderef : tderef;
  214. index,
  215. default : longint;
  216. dispid : longint;
  217. propaccesslist: array[tpropaccesslisttypes] of tpropaccesslist;
  218. constructor create(const n : string);
  219. destructor destroy;override;
  220. constructor ppuload(ppufile:tcompilerppufile);
  221. function getsize : aint;
  222. procedure ppuwrite(ppufile:tcompilerppufile);override;
  223. procedure buildderef;override;
  224. procedure deref;override;
  225. end;
  226. tconstvalue = record
  227. case integer of
  228. 0: (valueord : tconstexprint);
  229. 1: (valueordptr : tconstptruint);
  230. 2: (valueptr : pointer; len : longint);
  231. end;
  232. tconstsym = class(tstoredsym)
  233. constdef : tdef;
  234. constdefderef : tderef;
  235. consttyp : tconsttyp;
  236. value : tconstvalue;
  237. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
  238. constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
  239. constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
  240. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  241. constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  242. constructor ppuload(ppufile:tcompilerppufile);
  243. destructor destroy;override;
  244. procedure buildderef;override;
  245. procedure deref;override;
  246. procedure ppuwrite(ppufile:tcompilerppufile);override;
  247. end;
  248. tenumsym = class(Tstoredsym)
  249. value : longint;
  250. definition : tenumdef;
  251. definitionderef : tderef;
  252. constructor create(const n : string;def : tenumdef;v : longint);
  253. constructor ppuload(ppufile:tcompilerppufile);
  254. procedure ppuwrite(ppufile:tcompilerppufile);override;
  255. procedure buildderef;override;
  256. procedure deref;override;
  257. end;
  258. tsyssym = class(Tstoredsym)
  259. number : longint;
  260. constructor create(const n : string;l : longint);
  261. constructor ppuload(ppufile:tcompilerppufile);
  262. destructor destroy;override;
  263. procedure ppuwrite(ppufile:tcompilerppufile);override;
  264. end;
  265. const
  266. maxmacrolen=16*1024;
  267. type
  268. pmacrobuffer = ^tmacrobuffer;
  269. tmacrobuffer = array[0..maxmacrolen-1] of char;
  270. tmacro = class(tstoredsym)
  271. {Normally true, but false when a previously defined macro is undef-ed}
  272. defined : boolean;
  273. {True if this is a mac style compiler variable, in which case no macro
  274. substitutions shall be done.}
  275. is_compiler_var : boolean;
  276. {Whether the macro was used. NOTE: A use of a macro which was never defined}
  277. {e. g. an IFDEF which returns false, will not be registered as used,}
  278. {since there is no place to register its use. }
  279. is_used : boolean;
  280. buftext : pchar;
  281. buflen : longint;
  282. constructor create(const n : string);
  283. constructor ppuload(ppufile:tcompilerppufile);
  284. procedure ppuwrite(ppufile:tcompilerppufile);override;
  285. destructor destroy;override;
  286. function GetCopy:tmacro;
  287. end;
  288. var
  289. generrorsym : tsym;
  290. implementation
  291. uses
  292. { global }
  293. verbose,
  294. { target }
  295. systems,
  296. { symtable }
  297. defutil,symtable,
  298. fmodule,
  299. { tree }
  300. node,
  301. { aasm }
  302. aasmtai,aasmdata,
  303. { codegen }
  304. paramgr,
  305. procinfo
  306. ;
  307. {****************************************************************************
  308. Helpers
  309. ****************************************************************************}
  310. {****************************************************************************
  311. TSYM (base for all symtypes)
  312. ****************************************************************************}
  313. constructor tstoredsym.create(st:tsymtyp;const n : string);
  314. begin
  315. inherited create(st,n);
  316. { Register in current_module }
  317. if assigned(current_module) then
  318. begin
  319. current_module.symlist.Add(self);
  320. SymId:=current_module.symlist.Count-1;
  321. end;
  322. end;
  323. constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  324. begin
  325. SymId:=ppufile.getlongint;
  326. inherited Create(st,ppufile.getstring);
  327. { Register symbol }
  328. current_module.symlist[SymId]:=self;
  329. ppufile.getposinfo(fileinfo);
  330. visibility:=tvisibility(ppufile.getbyte);
  331. ppufile.getsmallset(symoptions);
  332. if sp_has_deprecated_msg in symoptions then
  333. deprecatedmsg:=stringdup(ppufile.getstring)
  334. else
  335. deprecatedmsg:=nil;
  336. end;
  337. procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
  338. begin
  339. ppufile.putlongint(SymId);
  340. ppufile.putstring(realname);
  341. ppufile.putposinfo(fileinfo);
  342. ppufile.putbyte(byte(visibility));
  343. ppufile.putsmallset(symoptions);
  344. if sp_has_deprecated_msg in symoptions then
  345. ppufile.putstring(deprecatedmsg^);
  346. end;
  347. destructor tstoredsym.destroy;
  348. begin
  349. inherited destroy;
  350. end;
  351. {****************************************************************************
  352. TLABELSYM
  353. ****************************************************************************}
  354. constructor tlabelsym.create(const n : string);
  355. begin
  356. inherited create(labelsym,n);
  357. used:=false;
  358. defined:=false;
  359. nonlocal:=false;
  360. code:=nil;
  361. end;
  362. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  363. begin
  364. inherited ppuload(labelsym,ppufile);
  365. code:=nil;
  366. used:=false;
  367. nonlocal:=false;
  368. defined:=true;
  369. end;
  370. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  371. begin
  372. if owner.symtabletype=globalsymtable then
  373. Message(sym_e_ill_label_decl)
  374. else
  375. begin
  376. inherited ppuwrite(ppufile);
  377. ppufile.writeentry(iblabelsym);
  378. end;
  379. end;
  380. function tlabelsym.mangledname:string;
  381. begin
  382. if not(defined) then
  383. begin
  384. defined:=true;
  385. if nonlocal then
  386. current_asmdata.getglobaljumplabel(asmblocklabel)
  387. else
  388. current_asmdata.getjumplabel(asmblocklabel);
  389. end;
  390. result:=asmblocklabel.name;
  391. end;
  392. {****************************************************************************
  393. TUNITSYM
  394. ****************************************************************************}
  395. constructor tunitsym.create(const n : string;amodule : tobject);
  396. begin
  397. inherited create(unitsym,n);
  398. module:=amodule;
  399. end;
  400. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  401. begin
  402. inherited ppuload(unitsym,ppufile);
  403. module:=nil;
  404. end;
  405. destructor tunitsym.destroy;
  406. begin
  407. inherited destroy;
  408. end;
  409. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  410. begin
  411. inherited ppuwrite(ppufile);
  412. ppufile.writeentry(ibunitsym);
  413. end;
  414. {****************************************************************************
  415. TPROCSYM
  416. ****************************************************************************}
  417. constructor tprocsym.create(const n : string);
  418. begin
  419. inherited create(procsym,n);
  420. FProcdefList:=TFPObjectList.Create(false);
  421. FProcdefderefList:=nil;
  422. { the tprocdef have their own symoptions, make the procsym
  423. always visible }
  424. visibility:=vis_public;
  425. end;
  426. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  427. var
  428. pdderef : tderef;
  429. i,
  430. pdcnt : longint;
  431. begin
  432. inherited ppuload(procsym,ppufile);
  433. FProcdefList:=TFPObjectList.Create(false);
  434. FProcdefDerefList:=TFPList.Create;
  435. pdcnt:=ppufile.getword;
  436. for i:=1 to pdcnt do
  437. begin
  438. ppufile.getderef(pdderef);
  439. FProcdefDerefList.Add(Pointer(PtrInt(pdderef.dataidx)));
  440. end;
  441. end;
  442. destructor tprocsym.destroy;
  443. begin
  444. FProcdefList.Free;
  445. if assigned(FProcdefDerefList) then
  446. FProcdefDerefList.Free;
  447. inherited destroy;
  448. end;
  449. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  450. var
  451. i : longint;
  452. d : tderef;
  453. begin
  454. inherited ppuwrite(ppufile);
  455. ppufile.putword(FProcdefDerefList.Count);
  456. for i:=0 to FProcdefDerefList.Count-1 do
  457. begin
  458. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  459. ppufile.putderef(d);
  460. end;
  461. ppufile.writeentry(ibprocsym);
  462. end;
  463. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  464. var
  465. i : longint;
  466. pd : tprocdef;
  467. begin
  468. for i:=0 to ProcdefList.Count-1 do
  469. begin
  470. pd:=tprocdef(ProcdefList[i]);
  471. if pd<>skipdef then
  472. MessagePos1(pd.fileinfo,sym_h_param_list,pd.fullprocname(false));
  473. end;
  474. end;
  475. procedure tprocsym.check_forward;
  476. var
  477. i : longint;
  478. pd : tprocdef;
  479. begin
  480. for i:=0 to ProcdefList.Count-1 do
  481. begin
  482. pd:=tprocdef(ProcdefList[i]);
  483. if (pd.owner=owner) and (pd.forwarddef) then
  484. begin
  485. { For mode macpas. Make implicit externals (procedures declared in the interface
  486. section which do not have a counterpart in the implementation)
  487. to be an imported procedure }
  488. if (m_mac in current_settings.modeswitches) and
  489. (pd.interfacedef) then
  490. begin
  491. pd.setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
  492. if (not current_module.interface_only) then
  493. MessagePos1(pd.fileinfo,sym_w_forward_not_resolved,pd.fullprocname(false));
  494. end
  495. else
  496. begin
  497. MessagePos1(pd.fileinfo,sym_e_forward_not_resolved,pd.fullprocname(false));
  498. end;
  499. { Turn further error messages off }
  500. pd.forwarddef:=false;
  501. end;
  502. end;
  503. end;
  504. procedure tprocsym.buildderef;
  505. var
  506. i : longint;
  507. pd : tprocdef;
  508. d : tderef;
  509. begin
  510. if not assigned(FProcdefDerefList) then
  511. FProcdefDerefList:=TFPList.Create
  512. else
  513. FProcdefDerefList.Clear;
  514. for i:=0 to ProcdefList.Count-1 do
  515. begin
  516. pd:=tprocdef(ProcdefList[i]);
  517. { only write the proc definitions that belong
  518. to this procsym and are in the global symtable }
  519. if pd.owner=owner then
  520. begin
  521. d.build(pd);
  522. FProcdefDerefList.Add(Pointer(PtrInt(d.dataidx)));
  523. end;
  524. end;
  525. end;
  526. procedure tprocsym.deref;
  527. var
  528. i : longint;
  529. pd : tprocdef;
  530. d : tderef;
  531. begin
  532. { Clear all procdefs }
  533. ProcdefList.Clear;
  534. if not assigned(FProcdefDerefList) then
  535. internalerror(200611031);
  536. for i:=0 to FProcdefDerefList.Count-1 do
  537. begin
  538. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  539. pd:=tprocdef(d.resolve);
  540. ProcdefList.Add(pd);
  541. end;
  542. end;
  543. function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  544. var
  545. i : longint;
  546. pd : tprocdef;
  547. begin
  548. result:=nil;
  549. for i:=0 to ProcdefList.Count-1 do
  550. begin
  551. pd:=tprocdef(ProcdefList[i]);
  552. if pd.proctypeoption=pt then
  553. begin
  554. result:=pd;
  555. exit;
  556. end;
  557. end;
  558. end;
  559. function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef;
  560. cpoptions:tcompare_paras_options):Tprocdef;
  561. var
  562. i : longint;
  563. pd : tprocdef;
  564. eq : tequaltype;
  565. begin
  566. result:=nil;
  567. for i:=0 to ProcdefList.Count-1 do
  568. begin
  569. pd:=tprocdef(ProcdefList[i]);
  570. if assigned(retdef) then
  571. eq:=compare_defs(retdef,pd.returndef,nothingn)
  572. else
  573. eq:=te_equal;
  574. if (eq>=te_equal) or
  575. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  576. begin
  577. eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
  578. if (eq>=te_equal) or
  579. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  580. begin
  581. result:=pd;
  582. exit;
  583. end;
  584. end;
  585. end;
  586. end;
  587. function tprocsym.find_procdef_byoptions(ops: tprocoptions): Tprocdef;
  588. var
  589. i : longint;
  590. pd : tprocdef;
  591. begin
  592. result:=nil;
  593. for i:=0 to ProcdefList.Count-1 do
  594. begin
  595. pd:=tprocdef(ProcdefList[i]);
  596. if ops * pd.procoptions = ops then
  597. begin
  598. result:=pd;
  599. exit;
  600. end;
  601. end;
  602. end;
  603. function Tprocsym.Find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  604. var
  605. i : longint;
  606. bestpd,
  607. pd : tprocdef;
  608. eq,besteq : tequaltype;
  609. begin
  610. { This function will return the pprocdef of pprocsym that
  611. is the best match for procvardef. When there are multiple
  612. matches it returns nil.}
  613. result:=nil;
  614. bestpd:=nil;
  615. besteq:=te_incompatible;
  616. for i:=0 to ProcdefList.Count-1 do
  617. begin
  618. pd:=tprocdef(ProcdefList[i]);
  619. eq:=proc_to_procvar_equal(pd,d,false);
  620. if eq>=te_equal then
  621. begin
  622. { multiple procvars with the same equal level }
  623. if assigned(bestpd) and
  624. (besteq=eq) then
  625. exit;
  626. if eq>besteq then
  627. begin
  628. besteq:=eq;
  629. bestpd:=pd;
  630. end;
  631. end;
  632. end;
  633. result:=bestpd;
  634. end;
  635. function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  636. var
  637. paraidx, realparamcount,
  638. i, j : longint;
  639. bestpd,
  640. hpd,
  641. pd : tprocdef;
  642. convtyp : tconverttype;
  643. eq : tequaltype;
  644. begin
  645. { This function will return the pprocdef of pprocsym that
  646. is the best match for procvardef. When there are multiple
  647. matches it returns nil.}
  648. result:=nil;
  649. bestpd:=nil;
  650. besteq:=te_incompatible;
  651. for i:=0 to ProcdefList.Count-1 do
  652. begin
  653. pd:=tprocdef(ProcdefList[i]);
  654. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  655. continue;
  656. if (equal_defs(todef,pd.returndef) or
  657. { shortstrings of different lengths are ok as result }
  658. (is_shortstring(todef) and is_shortstring(pd.returndef))) and
  659. { the result type must be always really equal and not an alias,
  660. if you mess with this code, check tw4093 }
  661. ((todef=pd.returndef) or
  662. (
  663. not(df_unique in todef.defoptions) and
  664. not(df_unique in pd.returndef.defoptions)
  665. )
  666. ) then
  667. begin
  668. paraidx:=0;
  669. { ignore vs_hidden parameters }
  670. while (paraidx<pd.paras.count) and
  671. assigned(pd.paras[paraidx]) and
  672. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  673. inc(paraidx);
  674. realparamcount:=0;
  675. for j := 0 to pd.paras.Count-1 do
  676. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  677. inc(realparamcount);
  678. if (paraidx<pd.paras.count) and
  679. assigned(pd.paras[paraidx]) and
  680. (realparamcount = 1) then
  681. begin
  682. eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  683. { alias? if yes, only l1 choice,
  684. if you mess with this code, check tw4093 }
  685. if (eq=te_exact) and
  686. (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
  687. ((df_unique in fromdef.defoptions) or
  688. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  689. eq:=te_convert_l1;
  690. if eq=te_exact then
  691. begin
  692. besteq:=eq;
  693. result:=pd;
  694. exit;
  695. end;
  696. if eq>besteq then
  697. begin
  698. bestpd:=pd;
  699. besteq:=eq;
  700. end;
  701. end;
  702. end;
  703. end;
  704. result:=bestpd;
  705. end;
  706. function Tprocsym.find_procdef_enumerator_operator(typedef:tdef;var besteq:tequaltype):Tprocdef;
  707. var
  708. paraidx, realparamcount,
  709. i, j : longint;
  710. bestpd,
  711. hpd,
  712. pd : tprocdef;
  713. convtyp : tconverttype;
  714. eq : tequaltype;
  715. begin
  716. { This function will return the pprocdef of pprocsym that
  717. is the best match for procvardef. When there are multiple
  718. matches it returns nil.}
  719. result:=nil;
  720. bestpd:=nil;
  721. besteq:=te_incompatible;
  722. for i:=0 to ProcdefList.Count-1 do
  723. begin
  724. pd:=tprocdef(ProcdefList[i]);
  725. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  726. continue;
  727. paraidx:=0;
  728. { ignore vs_hidden parameters }
  729. while (paraidx<pd.paras.count) and
  730. assigned(pd.paras[paraidx]) and
  731. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  732. inc(paraidx);
  733. realparamcount:=0;
  734. for j := 0 to pd.paras.Count-1 do
  735. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  736. inc(realparamcount);
  737. if (paraidx<pd.paras.count) and
  738. assigned(pd.paras[paraidx]) and
  739. (realparamcount = 1) and
  740. is_class_or_interface_or_object(pd.returndef) then
  741. begin
  742. eq:=compare_defs_ext(typedef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  743. { alias? if yes, only l1 choice,
  744. if you mess with this code, check tw4093 }
  745. if (eq=te_exact) and
  746. (typedef<>tparavarsym(pd.paras[paraidx]).vardef) and
  747. ((df_unique in typedef.defoptions) or
  748. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  749. eq:=te_convert_l1;
  750. if eq=te_exact then
  751. begin
  752. besteq:=eq;
  753. result:=pd;
  754. exit;
  755. end;
  756. if eq>besteq then
  757. begin
  758. bestpd:=pd;
  759. besteq:=eq;
  760. end;
  761. end;
  762. end;
  763. result:=bestpd;
  764. end;
  765. {****************************************************************************
  766. TERRORSYM
  767. ****************************************************************************}
  768. constructor terrorsym.create;
  769. begin
  770. inherited create(errorsym,'');
  771. end;
  772. {****************************************************************************
  773. TPROPERTYSYM
  774. ****************************************************************************}
  775. constructor tpropertysym.create(const n : string);
  776. var
  777. pap : tpropaccesslisttypes;
  778. begin
  779. inherited create(propertysym,n);
  780. propoptions:=[];
  781. index:=0;
  782. default:=0;
  783. propdef:=nil;
  784. indexdef:=nil;
  785. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  786. propaccesslist[pap]:=tpropaccesslist.create;
  787. end;
  788. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  789. var
  790. pap : tpropaccesslisttypes;
  791. begin
  792. inherited ppuload(propertysym,ppufile);
  793. ppufile.getsmallset(propoptions);
  794. ppufile.getderef(overridenpropsymderef);
  795. ppufile.getderef(propdefderef);
  796. index:=ppufile.getlongint;
  797. default:=ppufile.getlongint;
  798. ppufile.getderef(indexdefderef);
  799. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  800. propaccesslist[pap]:=ppufile.getpropaccesslist;
  801. end;
  802. destructor tpropertysym.destroy;
  803. var
  804. pap : tpropaccesslisttypes;
  805. begin
  806. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  807. propaccesslist[pap].free;
  808. inherited destroy;
  809. end;
  810. procedure tpropertysym.buildderef;
  811. var
  812. pap : tpropaccesslisttypes;
  813. begin
  814. overridenpropsymderef.build(overridenpropsym);
  815. propdefderef.build(propdef);
  816. indexdefderef.build(indexdef);
  817. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  818. propaccesslist[pap].buildderef;
  819. end;
  820. procedure tpropertysym.deref;
  821. var
  822. pap : tpropaccesslisttypes;
  823. begin
  824. overridenpropsym:=tpropertysym(overridenpropsymderef.resolve);
  825. indexdef:=tdef(indexdefderef.resolve);
  826. propdef:=tdef(propdefderef.resolve);
  827. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  828. propaccesslist[pap].resolve;
  829. end;
  830. function tpropertysym.getsize : aint;
  831. begin
  832. getsize:=0;
  833. end;
  834. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  835. var
  836. pap : tpropaccesslisttypes;
  837. begin
  838. inherited ppuwrite(ppufile);
  839. ppufile.putsmallset(propoptions);
  840. ppufile.putderef(overridenpropsymderef);
  841. ppufile.putderef(propdefderef);
  842. ppufile.putlongint(index);
  843. ppufile.putlongint(default);
  844. ppufile.putderef(indexdefderef);
  845. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  846. ppufile.putpropaccesslist(propaccesslist[pap]);
  847. ppufile.writeentry(ibpropertysym);
  848. end;
  849. {****************************************************************************
  850. TABSTRACTVARSYM
  851. ****************************************************************************}
  852. constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  853. begin
  854. inherited create(st,n);
  855. vardef:=def;
  856. varspez:=vsp;
  857. varstate:=vs_declared;
  858. varoptions:=vopts;
  859. end;
  860. constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  861. begin
  862. inherited ppuload(st,ppufile);
  863. varstate:=vs_readwritten;
  864. varspez:=tvarspez(ppufile.getbyte);
  865. varregable:=tvarregable(ppufile.getbyte);
  866. addr_taken:=boolean(ppufile.getbyte);
  867. ppufile.getderef(vardefderef);
  868. ppufile.getsmallset(varoptions);
  869. end;
  870. destructor tabstractvarsym.destroy;
  871. begin
  872. if assigned(notifications) then
  873. notifications.destroy;
  874. inherited destroy;
  875. end;
  876. procedure tabstractvarsym.buildderef;
  877. begin
  878. vardefderef.build(vardef);
  879. end;
  880. procedure tabstractvarsym.deref;
  881. var
  882. oldvarregable: tvarregable;
  883. begin
  884. { setting the vardef also updates varregable. We just loaded this }
  885. { value from a ppu, so it must not be changed (e.g. tw7817a.pp/ }
  886. { tw7817b.pp: the address is taken of a local variable in an }
  887. { inlined procedure -> must remain non-regable when inlining) }
  888. oldvarregable:=varregable;
  889. vardef:=tdef(vardefderef.resolve);
  890. varregable:=oldvarregable;
  891. end;
  892. procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile);
  893. var
  894. oldintfcrc : boolean;
  895. begin
  896. inherited ppuwrite(ppufile);
  897. ppufile.putbyte(byte(varspez));
  898. oldintfcrc:=ppufile.do_crc;
  899. ppufile.do_crc:=false;
  900. ppufile.putbyte(byte(varregable));
  901. ppufile.putbyte(byte(addr_taken));
  902. ppufile.do_crc:=oldintfcrc;
  903. ppufile.putderef(vardefderef);
  904. ppufile.putsmallset(varoptions);
  905. end;
  906. function tabstractvarsym.getsize : aint;
  907. begin
  908. if assigned(vardef) and
  909. ((vardef.typ<>arraydef) or
  910. is_dynamic_array(vardef) or
  911. (tarraydef(vardef).highrange>=tarraydef(vardef).lowrange)) then
  912. result:=vardef.size
  913. else
  914. result:=0;
  915. end;
  916. function tabstractvarsym.getpackedbitsize : longint;
  917. begin
  918. { bitpacking is only done for ordinals }
  919. if not is_ordinal(vardef) then
  920. internalerror(2006082010);
  921. result:=vardef.packedbitsize;
  922. end;
  923. function tabstractvarsym.is_regvar(refpara: boolean):boolean;
  924. begin
  925. { Register variables are not allowed in the following cases:
  926. - regvars are disabled
  927. - exceptions are used (after an exception is raised the contents of the
  928. registers is not valid anymore)
  929. - it has a local copy
  930. - the value needs to be in memory (i.e. reference counted) }
  931. result:=(cs_opt_regvar in current_settings.optimizerswitches) and
  932. not(pi_has_assembler_block in current_procinfo.flags) and
  933. not(pi_uses_exceptions in current_procinfo.flags) and
  934. not(vo_has_local_copy in varoptions) and
  935. ((refpara and
  936. (varregable <> vr_none)) or
  937. (not refpara and
  938. not(varregable in [vr_none,vr_addr])))
  939. {$if not defined(powerpc) and not defined(powerpc64)}
  940. and ((vardef.typ <> recorddef) or
  941. (varregable = vr_addr) or
  942. not(varstate in [vs_written,vs_readwritten]));
  943. {$endif}
  944. end;
  945. procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag);
  946. var n:Tnotification;
  947. begin
  948. if assigned(notifications) then
  949. begin
  950. n:=Tnotification(notifications.first);
  951. while assigned(n) do
  952. begin
  953. if what in n.flags then
  954. n.callback(what,self);
  955. n:=Tnotification(n.next);
  956. end;
  957. end;
  958. end;
  959. function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback:
  960. Tnotification_callback):cardinal;
  961. var n:Tnotification;
  962. begin
  963. if not assigned(notifications) then
  964. notifications:=Tlinkedlist.create;
  965. n:=Tnotification.create(flags,callback);
  966. register_notification:=n.id;
  967. notifications.concat(n);
  968. end;
  969. procedure Tabstractvarsym.unregister_notification(id:cardinal);
  970. var n:Tnotification;
  971. begin
  972. if not assigned(notifications) then
  973. internalerror(200212311)
  974. else
  975. begin
  976. n:=Tnotification(notifications.first);
  977. while assigned(n) do
  978. begin
  979. if n.id=id then
  980. begin
  981. notifications.remove(n);
  982. n.destroy;
  983. exit;
  984. end;
  985. n:=Tnotification(n.next);
  986. end;
  987. internalerror(200212311)
  988. end;
  989. end;
  990. procedure tabstractvarsym.setvardef(def:tdef);
  991. begin
  992. _vardef := def;
  993. { can we load the value into a register ? }
  994. if not assigned(owner) or
  995. (owner.symtabletype in [localsymtable,parasymtable]) or
  996. (
  997. (owner.symtabletype=staticsymtable) and
  998. not(cs_create_pic in current_settings.moduleswitches)
  999. ) then
  1000. begin
  1001. if tstoreddef(vardef).is_intregable then
  1002. varregable:=vr_intreg
  1003. else
  1004. { $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 }
  1005. if {(
  1006. not assigned(owner) or
  1007. (owner.symtabletype<>staticsymtable)
  1008. ) and }
  1009. tstoreddef(vardef).is_fpuregable then
  1010. begin
  1011. if use_vectorfpu(vardef) then
  1012. varregable:=vr_mmreg
  1013. else
  1014. varregable:=vr_fpureg;
  1015. end;
  1016. end;
  1017. end;
  1018. {****************************************************************************
  1019. TFIELDVARSYM
  1020. ****************************************************************************}
  1021. constructor tfieldvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1022. begin
  1023. inherited create(fieldvarsym,n,vsp,def,vopts);
  1024. fieldoffset:=-1;
  1025. end;
  1026. constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
  1027. begin
  1028. inherited ppuload(fieldvarsym,ppufile);
  1029. fieldoffset:=ppufile.getaint;
  1030. end;
  1031. procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
  1032. begin
  1033. inherited ppuwrite(ppufile);
  1034. ppufile.putaint(fieldoffset);
  1035. ppufile.writeentry(ibfieldvarsym);
  1036. end;
  1037. function tfieldvarsym.mangledname:string;
  1038. var
  1039. srsym : tsym;
  1040. srsymtable : tsymtable;
  1041. begin
  1042. if sp_static in symoptions then
  1043. begin
  1044. if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1045. result:=srsym.mangledname
  1046. { when generating the debug info for the module in which the }
  1047. { symbol is defined, the localsymtable of that module is }
  1048. { already popped from the symtablestack }
  1049. else if searchsym_in_module(current_module,lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1050. result:=srsym.mangledname
  1051. else
  1052. internalerror(2007012501);
  1053. end
  1054. else if is_objcclass(tdef(owner.defowner)) then
  1055. begin
  1056. if assigned(objcoffsetmangledname) then
  1057. result:=objcoffsetmangledname^
  1058. else
  1059. begin
  1060. result:=target_info.cprefix+'OBJC_IVAR_$_'+tobjectdef(owner.defowner).objextname^+'.'+RealName;
  1061. objcoffsetmangledname:=stringdup(result);
  1062. end;
  1063. end
  1064. else
  1065. result:=inherited mangledname;
  1066. end;
  1067. destructor tfieldvarsym.destroy;
  1068. begin
  1069. stringdispose(objcoffsetmangledname);
  1070. inherited destroy;
  1071. end;
  1072. {****************************************************************************
  1073. TABSTRACTNORMALVARSYM
  1074. ****************************************************************************}
  1075. constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1076. begin
  1077. inherited create(st,n,vsp,def,vopts);
  1078. fillchar(localloc,sizeof(localloc),0);
  1079. fillchar(initialloc,sizeof(initialloc),0);
  1080. defaultconstsym:=nil;
  1081. end;
  1082. constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1083. begin
  1084. inherited ppuload(st,ppufile);
  1085. fillchar(localloc,sizeof(localloc),0);
  1086. fillchar(initialloc,sizeof(initialloc),0);
  1087. ppufile.getderef(defaultconstsymderef);
  1088. end;
  1089. procedure tabstractnormalvarsym.buildderef;
  1090. begin
  1091. inherited buildderef;
  1092. defaultconstsymderef.build(defaultconstsym);
  1093. end;
  1094. procedure tabstractnormalvarsym.deref;
  1095. begin
  1096. inherited deref;
  1097. defaultconstsym:=tsym(defaultconstsymderef.resolve);
  1098. end;
  1099. procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1100. begin
  1101. inherited ppuwrite(ppufile);
  1102. ppufile.putderef(defaultconstsymderef);
  1103. end;
  1104. {****************************************************************************
  1105. Tstaticvarsym
  1106. ****************************************************************************}
  1107. constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1108. begin
  1109. inherited create(staticvarsym,n,vsp,def,vopts);
  1110. _mangledname:=nil;
  1111. end;
  1112. constructor tstaticvarsym.create_dll(const n : string;vsp:tvarspez;def:tdef);
  1113. begin
  1114. tstaticvarsym(self).create(n,vsp,def,[vo_is_dll_var]);
  1115. end;
  1116. constructor tstaticvarsym.create_C(const n,mangled : string;vsp:tvarspez;def:tdef);
  1117. begin
  1118. tstaticvarsym(self).create(n,vsp,def,[]);
  1119. set_mangledname(mangled);
  1120. end;
  1121. constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
  1122. begin
  1123. inherited ppuload(staticvarsym,ppufile);
  1124. if vo_has_mangledname in varoptions then
  1125. _mangledname:=stringdup(ppufile.getstring)
  1126. else
  1127. _mangledname:=nil;
  1128. end;
  1129. destructor tstaticvarsym.destroy;
  1130. begin
  1131. if assigned(_mangledname) then
  1132. begin
  1133. {$ifdef MEMDEBUG}
  1134. memmanglednames.start;
  1135. {$endif MEMDEBUG}
  1136. stringdispose(_mangledname);
  1137. {$ifdef MEMDEBUG}
  1138. memmanglednames.stop;
  1139. {$endif MEMDEBUG}
  1140. end;
  1141. inherited destroy;
  1142. end;
  1143. procedure tstaticvarsym.ppuwrite(ppufile:tcompilerppufile);
  1144. begin
  1145. inherited ppuwrite(ppufile);
  1146. if vo_has_mangledname in varoptions then
  1147. ppufile.putstring(_mangledname^);
  1148. ppufile.writeentry(ibstaticvarsym);
  1149. end;
  1150. function tstaticvarsym.mangledname:string;
  1151. var
  1152. prefix : string[2];
  1153. begin
  1154. if not assigned(_mangledname) then
  1155. begin
  1156. if (vo_is_typed_const in varoptions) then
  1157. prefix:='TC'
  1158. else
  1159. prefix:='U';
  1160. {$ifdef compress}
  1161. _mangledname:=stringdup(minilzw_encode(make_mangledname(prefix,owner,name)));
  1162. {$else}
  1163. _mangledname:=stringdup(make_mangledname(prefix,owner,name));
  1164. {$endif}
  1165. end;
  1166. result:=_mangledname^;
  1167. end;
  1168. procedure tstaticvarsym.set_mangledname(const s:string);
  1169. begin
  1170. stringdispose(_mangledname);
  1171. {$ifdef compress}
  1172. _mangledname:=stringdup(minilzw_encode(s));
  1173. {$else}
  1174. _mangledname:=stringdup(s);
  1175. {$endif}
  1176. include(varoptions,vo_has_mangledname);
  1177. end;
  1178. {****************************************************************************
  1179. TLOCALVARSYM
  1180. ****************************************************************************}
  1181. constructor tlocalvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1182. begin
  1183. inherited create(localvarsym,n,vsp,def,vopts);
  1184. end;
  1185. constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
  1186. begin
  1187. inherited ppuload(localvarsym,ppufile);
  1188. end;
  1189. procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1190. begin
  1191. inherited ppuwrite(ppufile);
  1192. ppufile.writeentry(iblocalvarsym);
  1193. end;
  1194. {****************************************************************************
  1195. TPARAVARSYM
  1196. ****************************************************************************}
  1197. constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1198. begin
  1199. inherited create(paravarsym,n,vsp,def,vopts);
  1200. if (vsp in [vs_var,vs_value,vs_const]) then
  1201. varstate := vs_initialised;
  1202. paranr:=nr;
  1203. paraloc[calleeside].init;
  1204. paraloc[callerside].init;
  1205. end;
  1206. destructor tparavarsym.destroy;
  1207. begin
  1208. paraloc[calleeside].done;
  1209. paraloc[callerside].done;
  1210. inherited destroy;
  1211. end;
  1212. constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
  1213. var
  1214. b : byte;
  1215. begin
  1216. inherited ppuload(paravarsym,ppufile);
  1217. paranr:=ppufile.getword;
  1218. univpara:=boolean(ppufile.getbyte);
  1219. { The var state of parameter symbols is fixed after writing them so
  1220. we write them to the unit file.
  1221. This enables constant folding for inline procedures loaded from units
  1222. }
  1223. varstate:=tvarstate(ppufile.getbyte);
  1224. paraloc[calleeside].init;
  1225. paraloc[callerside].init;
  1226. if vo_has_explicit_paraloc in varoptions then
  1227. begin
  1228. paraloc[callerside].alignment:=ppufile.getbyte;
  1229. b:=ppufile.getbyte;
  1230. if b<>sizeof(paraloc[callerside].location^) then
  1231. internalerror(200411154);
  1232. ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));
  1233. paraloc[callerside].size:=paraloc[callerside].location^.size;
  1234. paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];
  1235. end;
  1236. end;
  1237. procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
  1238. var
  1239. oldintfcrc : boolean;
  1240. begin
  1241. inherited ppuwrite(ppufile);
  1242. ppufile.putword(paranr);
  1243. ppufile.putbyte(byte(univpara));
  1244. { The var state of parameter symbols is fixed after writing them so
  1245. we write them to the unit file.
  1246. This enables constant folding for inline procedures loaded from units
  1247. }
  1248. oldintfcrc:=ppufile.do_crc;
  1249. ppufile.do_crc:=false;
  1250. ppufile.putbyte(ord(varstate));
  1251. ppufile.do_crc:=oldintfcrc;
  1252. if vo_has_explicit_paraloc in varoptions then
  1253. begin
  1254. paraloc[callerside].check_simple_location;
  1255. ppufile.putbyte(sizeof(paraloc[callerside].alignment));
  1256. ppufile.putbyte(sizeof(paraloc[callerside].location^));
  1257. ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));
  1258. end;
  1259. ppufile.writeentry(ibparavarsym);
  1260. end;
  1261. {****************************************************************************
  1262. TABSOLUTEVARSYM
  1263. ****************************************************************************}
  1264. constructor tabsolutevarsym.create(const n : string;def:tdef);
  1265. begin
  1266. inherited create(absolutevarsym,n,vs_value,def,[]);
  1267. ref:=nil;
  1268. end;
  1269. constructor tabsolutevarsym.create_ref(const n : string;def:tdef;_ref:tpropaccesslist);
  1270. begin
  1271. inherited create(absolutevarsym,n,vs_value,def,[]);
  1272. ref:=_ref;
  1273. end;
  1274. destructor tabsolutevarsym.destroy;
  1275. begin
  1276. if assigned(ref) then
  1277. ref.free;
  1278. inherited destroy;
  1279. end;
  1280. constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
  1281. begin
  1282. inherited ppuload(absolutevarsym,ppufile);
  1283. ref:=nil;
  1284. asmname:=nil;
  1285. abstyp:=absolutetyp(ppufile.getbyte);
  1286. {$ifdef i386}
  1287. absseg:=false;
  1288. {$endif i386}
  1289. case abstyp of
  1290. tovar :
  1291. ref:=ppufile.getpropaccesslist;
  1292. toasm :
  1293. asmname:=stringdup(ppufile.getstring);
  1294. toaddr :
  1295. begin
  1296. addroffset:=ppufile.getaword;
  1297. {$ifdef i386}
  1298. absseg:=boolean(ppufile.getbyte);
  1299. {$endif i386}
  1300. end;
  1301. end;
  1302. end;
  1303. procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
  1304. begin
  1305. inherited ppuwrite(ppufile);
  1306. ppufile.putbyte(byte(abstyp));
  1307. case abstyp of
  1308. tovar :
  1309. ppufile.putpropaccesslist(ref);
  1310. toasm :
  1311. ppufile.putstring(asmname^);
  1312. toaddr :
  1313. begin
  1314. ppufile.putaword(addroffset);
  1315. {$ifdef i386}
  1316. ppufile.putbyte(byte(absseg));
  1317. {$endif i386}
  1318. end;
  1319. end;
  1320. ppufile.writeentry(ibabsolutevarsym);
  1321. end;
  1322. procedure tabsolutevarsym.buildderef;
  1323. begin
  1324. inherited buildderef;
  1325. if (abstyp=tovar) then
  1326. ref.buildderef;
  1327. end;
  1328. procedure tabsolutevarsym.deref;
  1329. begin
  1330. inherited deref;
  1331. { own absolute deref }
  1332. if (abstyp=tovar) then
  1333. ref.resolve;
  1334. end;
  1335. function tabsolutevarsym.mangledname : string;
  1336. begin
  1337. case abstyp of
  1338. toasm :
  1339. mangledname:=asmname^;
  1340. toaddr :
  1341. mangledname:='$'+tostr(addroffset);
  1342. else
  1343. internalerror(200411062);
  1344. end;
  1345. end;
  1346. {****************************************************************************
  1347. TCONSTSYM
  1348. ****************************************************************************}
  1349. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
  1350. begin
  1351. inherited create(constsym,n);
  1352. fillchar(value, sizeof(value), #0);
  1353. consttyp:=t;
  1354. value.valueord:=v;
  1355. constdef:=def;
  1356. end;
  1357. constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
  1358. begin
  1359. inherited create(constsym,n);
  1360. fillchar(value, sizeof(value), #0);
  1361. consttyp:=t;
  1362. value.valueordptr:=v;
  1363. constdef:=def;
  1364. end;
  1365. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
  1366. begin
  1367. inherited create(constsym,n);
  1368. fillchar(value, sizeof(value), #0);
  1369. consttyp:=t;
  1370. value.valueptr:=v;
  1371. constdef:=def;
  1372. end;
  1373. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1374. begin
  1375. inherited create(constsym,n);
  1376. fillchar(value, sizeof(value), #0);
  1377. consttyp:=t;
  1378. value.valueptr:=str;
  1379. constdef:=nil;
  1380. value.len:=l;
  1381. end;
  1382. constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  1383. begin
  1384. inherited create(constsym,n);
  1385. fillchar(value, sizeof(value), #0);
  1386. consttyp:=t;
  1387. pcompilerwidestring(value.valueptr):=pw;
  1388. constdef:=nil;
  1389. value.len:=getlengthwidestring(pw);
  1390. end;
  1391. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1392. var
  1393. pd : pbestreal;
  1394. ps : pnormalset;
  1395. pc : pchar;
  1396. pw : pcompilerwidestring;
  1397. i : longint;
  1398. begin
  1399. inherited ppuload(constsym,ppufile);
  1400. constdef:=nil;
  1401. consttyp:=tconsttyp(ppufile.getbyte);
  1402. fillchar(value, sizeof(value), #0);
  1403. case consttyp of
  1404. constord :
  1405. begin
  1406. ppufile.getderef(constdefderef);
  1407. value.valueord:=ppufile.getexprint;
  1408. end;
  1409. constpointer :
  1410. begin
  1411. ppufile.getderef(constdefderef);
  1412. value.valueordptr:=ppufile.getptruint;
  1413. end;
  1414. constwstring :
  1415. begin
  1416. initwidestring(pw);
  1417. setlengthwidestring(pw,ppufile.getlongint);
  1418. { don't use getdata, because the compilerwidechars may have to
  1419. be byteswapped
  1420. }
  1421. {$if sizeof(tcompilerwidechar) = 2}
  1422. for i:=0 to pw^.len-1 do
  1423. pw^.data[i]:=ppufile.getword;
  1424. {$elseif sizeof(tcompilerwidechar) = 4}
  1425. for i:=0 to pw^.len-1 do
  1426. pw^.data[i]:=cardinal(ppufile.getlongint);
  1427. {$else}
  1428. {$error Unsupported tcompilerwidechar size}
  1429. {$endif}
  1430. pcompilerwidestring(value.valueptr):=pw;
  1431. end;
  1432. conststring,
  1433. constresourcestring :
  1434. begin
  1435. value.len:=ppufile.getlongint;
  1436. getmem(pc,value.len+1);
  1437. ppufile.getdata(pc^,value.len);
  1438. pc[value.len]:=#0;
  1439. value.valueptr:=pc;
  1440. end;
  1441. constreal :
  1442. begin
  1443. new(pd);
  1444. pd^:=ppufile.getreal;
  1445. value.valueptr:=pd;
  1446. end;
  1447. constset :
  1448. begin
  1449. ppufile.getderef(constdefderef);
  1450. new(ps);
  1451. ppufile.getnormalset(ps^);
  1452. value.valueptr:=ps;
  1453. end;
  1454. constguid :
  1455. begin
  1456. new(pguid(value.valueptr));
  1457. ppufile.getdata(value.valueptr^,sizeof(tguid));
  1458. end;
  1459. constnil : ;
  1460. else
  1461. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1462. end;
  1463. end;
  1464. destructor tconstsym.destroy;
  1465. begin
  1466. case consttyp of
  1467. conststring,
  1468. constresourcestring :
  1469. freemem(pchar(value.valueptr),value.len+1);
  1470. constwstring :
  1471. donewidestring(pcompilerwidestring(value.valueptr));
  1472. constreal :
  1473. dispose(pbestreal(value.valueptr));
  1474. constset :
  1475. dispose(pnormalset(value.valueptr));
  1476. constguid :
  1477. dispose(pguid(value.valueptr));
  1478. end;
  1479. inherited destroy;
  1480. end;
  1481. procedure tconstsym.buildderef;
  1482. begin
  1483. if consttyp in [constord,constpointer,constset] then
  1484. constdefderef.build(constdef);
  1485. end;
  1486. procedure tconstsym.deref;
  1487. begin
  1488. if consttyp in [constord,constpointer,constset] then
  1489. constdef:=tdef(constdefderef.resolve);
  1490. end;
  1491. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  1492. begin
  1493. inherited ppuwrite(ppufile);
  1494. ppufile.putbyte(byte(consttyp));
  1495. case consttyp of
  1496. constnil : ;
  1497. constord :
  1498. begin
  1499. ppufile.putderef(constdefderef);
  1500. ppufile.putexprint(value.valueord);
  1501. end;
  1502. constpointer :
  1503. begin
  1504. ppufile.putderef(constdefderef);
  1505. ppufile.putptruint(value.valueordptr);
  1506. end;
  1507. constwstring :
  1508. begin
  1509. ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
  1510. ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
  1511. end;
  1512. conststring,
  1513. constresourcestring :
  1514. begin
  1515. ppufile.putlongint(value.len);
  1516. ppufile.putdata(pchar(value.valueptr)^,value.len);
  1517. end;
  1518. constreal :
  1519. ppufile.putreal(pbestreal(value.valueptr)^);
  1520. constset :
  1521. begin
  1522. ppufile.putderef(constdefderef);
  1523. ppufile.putnormalset(value.valueptr^);
  1524. end;
  1525. constguid :
  1526. ppufile.putdata(value.valueptr^,sizeof(tguid));
  1527. else
  1528. internalerror(13);
  1529. end;
  1530. ppufile.writeentry(ibconstsym);
  1531. end;
  1532. {****************************************************************************
  1533. TENUMSYM
  1534. ****************************************************************************}
  1535. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  1536. begin
  1537. inherited create(enumsym,n);
  1538. definition:=def;
  1539. value:=v;
  1540. end;
  1541. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  1542. begin
  1543. inherited ppuload(enumsym,ppufile);
  1544. ppufile.getderef(definitionderef);
  1545. value:=ppufile.getlongint;
  1546. end;
  1547. procedure tenumsym.buildderef;
  1548. begin
  1549. definitionderef.build(definition);
  1550. end;
  1551. procedure tenumsym.deref;
  1552. begin
  1553. definition:=tenumdef(definitionderef.resolve);
  1554. end;
  1555. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  1556. begin
  1557. inherited ppuwrite(ppufile);
  1558. ppufile.putderef(definitionderef);
  1559. ppufile.putlongint(value);
  1560. ppufile.writeentry(ibenumsym);
  1561. end;
  1562. {****************************************************************************
  1563. TTYPESYM
  1564. ****************************************************************************}
  1565. constructor ttypesym.create(const n : string;def:tdef);
  1566. begin
  1567. inherited create(typesym,n);
  1568. typedef:=def;
  1569. { register the typesym for the definition }
  1570. if assigned(typedef) and
  1571. (typedef.typ<>errordef) and
  1572. not(assigned(typedef.typesym)) then
  1573. typedef.typesym:=self;
  1574. end;
  1575. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  1576. begin
  1577. inherited ppuload(typesym,ppufile);
  1578. ppufile.getderef(typedefderef);
  1579. end;
  1580. procedure ttypesym.buildderef;
  1581. begin
  1582. typedefderef.build(typedef);
  1583. end;
  1584. procedure ttypesym.deref;
  1585. begin
  1586. typedef:=tdef(typedefderef.resolve);
  1587. end;
  1588. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  1589. begin
  1590. inherited ppuwrite(ppufile);
  1591. ppufile.putderef(typedefderef);
  1592. ppufile.writeentry(ibtypesym);
  1593. end;
  1594. {****************************************************************************
  1595. TSYSSYM
  1596. ****************************************************************************}
  1597. constructor tsyssym.create(const n : string;l : longint);
  1598. begin
  1599. inherited create(syssym,n);
  1600. number:=l;
  1601. end;
  1602. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  1603. begin
  1604. inherited ppuload(syssym,ppufile);
  1605. number:=ppufile.getlongint;
  1606. end;
  1607. destructor tsyssym.destroy;
  1608. begin
  1609. inherited destroy;
  1610. end;
  1611. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  1612. begin
  1613. inherited ppuwrite(ppufile);
  1614. ppufile.putlongint(number);
  1615. ppufile.writeentry(ibsyssym);
  1616. end;
  1617. {*****************************************************************************
  1618. TMacro
  1619. *****************************************************************************}
  1620. constructor tmacro.create(const n : string);
  1621. begin
  1622. inherited create(macrosym,n);
  1623. owner:=nil;
  1624. defined:=false;
  1625. is_used:=false;
  1626. is_compiler_var:=false;
  1627. buftext:=nil;
  1628. buflen:=0;
  1629. end;
  1630. constructor tmacro.ppuload(ppufile:tcompilerppufile);
  1631. begin
  1632. inherited ppuload(macrosym,ppufile);
  1633. defined:=boolean(ppufile.getbyte);
  1634. is_compiler_var:=boolean(ppufile.getbyte);
  1635. is_used:=false;
  1636. buflen:= ppufile.getlongint;
  1637. if buflen > 0 then
  1638. begin
  1639. getmem(buftext, buflen);
  1640. ppufile.getdata(buftext^, buflen)
  1641. end
  1642. else
  1643. buftext:=nil;
  1644. end;
  1645. destructor tmacro.destroy;
  1646. begin
  1647. if assigned(buftext) then
  1648. freemem(buftext);
  1649. inherited destroy;
  1650. end;
  1651. procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
  1652. begin
  1653. inherited ppuwrite(ppufile);
  1654. ppufile.putbyte(byte(defined));
  1655. ppufile.putbyte(byte(is_compiler_var));
  1656. ppufile.putlongint(buflen);
  1657. if buflen > 0 then
  1658. ppufile.putdata(buftext^,buflen);
  1659. ppufile.writeentry(ibmacrosym);
  1660. end;
  1661. function tmacro.GetCopy:tmacro;
  1662. var
  1663. p : tmacro;
  1664. begin
  1665. p:=tmacro.create(realname);
  1666. p.defined:=defined;
  1667. p.is_used:=is_used;
  1668. p.is_compiler_var:=is_compiler_var;
  1669. p.buflen:=buflen;
  1670. if assigned(buftext) then
  1671. begin
  1672. getmem(p.buftext,buflen);
  1673. move(buftext^,p.buftext^,buflen);
  1674. end;
  1675. Result:=p;
  1676. end;
  1677. end.