symsym.pas 60 KB

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