symsym.pas 57 KB

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