symsym.pas 59 KB

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