symsym.pas 61 KB

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