symsym.pas 62 KB

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