symsym.pas 69 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  3. Implementation for the symbols types of the symtable
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit symsym;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. { common }
  22. cutils,
  23. { target }
  24. globtype,globals,widestr,
  25. { symtable }
  26. symconst,symbase,symtype,symdef,defcmp,
  27. { ppu }
  28. ppu,finput,
  29. cclasses,symnot,
  30. { aasm }
  31. aasmbase,
  32. cpuinfo,cpubase,cgbase,cgutils,parabase
  33. ;
  34. type
  35. { this class is the base for all symbol objects }
  36. tstoredsym = class(tsym)
  37. public
  38. constructor create(st:tsymtyp;const n : string);
  39. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  40. destructor destroy;override;
  41. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  42. end;
  43. tlabelsym = class(tstoredsym)
  44. used,
  45. defined : boolean;
  46. { points to the matching node, only valid resulttype pass is run and
  47. the goto<->label relation in the node tree is created, should
  48. be a tnode }
  49. code : pointer;
  50. { when the label is defined in an asm block, this points to the
  51. generated asmlabel }
  52. asmblocklabel : tasmlabel;
  53. constructor create(const n : string);
  54. constructor ppuload(ppufile:tcompilerppufile);
  55. procedure ppuwrite(ppufile:tcompilerppufile);override;
  56. end;
  57. tunitsym = class(Tstoredsym)
  58. module : tobject; { tmodule }
  59. constructor create(const n : string;amodule : tobject);
  60. constructor ppuload(ppufile:tcompilerppufile);
  61. destructor destroy;override;
  62. procedure ppuwrite(ppufile:tcompilerppufile);override;
  63. end;
  64. terrorsym = class(Tsym)
  65. constructor create;
  66. end;
  67. Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
  68. tprocsym = class(tstoredsym)
  69. protected
  70. pdlistfirst,
  71. pdlistlast : pprocdeflist; { linked list of overloaded procdefs }
  72. function getprocdef(nr:cardinal):Tprocdef;
  73. public
  74. procdef_count : byte;
  75. overloadchecked : boolean;
  76. property procdef[nr:cardinal]:Tprocdef read getprocdef;
  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 unchain_overload;
  86. procedure ppuwrite(ppufile:tcompilerppufile);override;
  87. procedure buildderef;override;
  88. procedure deref;override;
  89. procedure addprocdef(p:tprocdef);
  90. procedure addprocdef_deref(const d:tderef);
  91. procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
  92. procedure concat_procdefs_to(s:Tprocsym);
  93. procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  94. function first_procdef:Tprocdef;
  95. function last_procdef:Tprocdef;
  96. function search_procdef_nopara_boolret:Tprocdef;
  97. function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  98. function search_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  99. function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  100. function search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  101. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  102. { currobjdef is the object def to assume, this is necessary for protected and
  103. private,
  104. context is the object def we're really in, this is for the strict stuff
  105. }
  106. function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;
  107. end;
  108. ttypesym = class(Tstoredsym)
  109. restype : ttype;
  110. constructor create(const n : string;const tt : ttype);
  111. constructor ppuload(ppufile:tcompilerppufile);
  112. procedure ppuwrite(ppufile:tcompilerppufile);override;
  113. procedure buildderef;override;
  114. procedure deref;override;
  115. function gettypedef:tdef;override;
  116. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  117. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  118. end;
  119. tabstractvarsym = class(tstoredsym)
  120. varoptions : tvaroptions;
  121. varspez : tvarspez; { sets the type of access }
  122. varregable : tvarregable;
  123. varstate : tvarstate;
  124. notifications : Tlinkedlist;
  125. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  126. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  127. destructor destroy;override;
  128. procedure ppuwrite(ppufile:tcompilerppufile);override;
  129. procedure buildderef;override;
  130. procedure deref;override;
  131. function getsize : longint;
  132. function is_regvar(refpara: boolean):boolean;
  133. procedure trigger_notifications(what:Tnotification_flag);
  134. function register_notification(flags:Tnotification_flags;
  135. callback:Tnotification_callback):cardinal;
  136. procedure unregister_notification(id:cardinal);
  137. private
  138. procedure setvartype(const newtype: ttype);
  139. _vartype : ttype;
  140. public
  141. property vartype: ttype read _vartype write setvartype;
  142. end;
  143. tfieldvarsym = class(tabstractvarsym)
  144. fieldoffset : aint; { offset in record/object }
  145. constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  146. constructor ppuload(ppufile:tcompilerppufile);
  147. procedure ppuwrite(ppufile:tcompilerppufile);override;
  148. end;
  149. tabstractnormalvarsym = class(tabstractvarsym)
  150. defaultconstsym : tsym;
  151. defaultconstsymderef : tderef;
  152. localloc : TLocation; { register/reference for local var }
  153. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  154. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  155. procedure ppuwrite(ppufile:tcompilerppufile);override;
  156. procedure buildderef;override;
  157. procedure deref;override;
  158. end;
  159. tlocalvarsym = class(tabstractnormalvarsym)
  160. constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  161. constructor ppuload(ppufile:tcompilerppufile);
  162. procedure ppuwrite(ppufile:tcompilerppufile);override;
  163. end;
  164. tparavarsym = class(tabstractnormalvarsym)
  165. paraloc : array[tcallercallee] of TCGPara;
  166. paranr : word; { position of this parameter }
  167. {$ifdef EXTDEBUG}
  168. eqval : tequaltype;
  169. {$endif EXTDEBUG}
  170. constructor create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  171. constructor ppuload(ppufile:tcompilerppufile);
  172. destructor destroy;override;
  173. procedure ppuwrite(ppufile:tcompilerppufile);override;
  174. end;
  175. tglobalvarsym = class(tabstractnormalvarsym)
  176. private
  177. _mangledname : pstring;
  178. public
  179. constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  180. constructor create_dll(const n : string;vsp:tvarspez;const tt : ttype);
  181. constructor create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);
  182. constructor ppuload(ppufile:tcompilerppufile);
  183. destructor destroy;override;
  184. procedure ppuwrite(ppufile:tcompilerppufile);override;
  185. function mangledname:string;override;
  186. procedure set_mangledname(const s:string);
  187. end;
  188. tabsolutevarsym = class(tabstractvarsym)
  189. public
  190. abstyp : absolutetyp;
  191. {$ifdef i386}
  192. absseg : boolean;
  193. {$endif i386}
  194. asmname : pstring;
  195. addroffset : aint;
  196. ref : tsymlist;
  197. constructor create(const n : string;const tt : ttype);
  198. constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);
  199. destructor destroy;override;
  200. constructor ppuload(ppufile:tcompilerppufile);
  201. procedure buildderef;override;
  202. procedure deref;override;
  203. function mangledname : string;override;
  204. procedure ppuwrite(ppufile:tcompilerppufile);override;
  205. end;
  206. tpropertysym = class(Tstoredsym)
  207. propoptions : tpropertyoptions;
  208. propoverriden : tpropertysym;
  209. propoverridenderef : tderef;
  210. proptype,
  211. indextype : ttype;
  212. index,
  213. default : longint;
  214. readaccess,
  215. writeaccess,
  216. storedaccess : tsymlist;
  217. constructor create(const n : string);
  218. destructor destroy;override;
  219. constructor ppuload(ppufile:tcompilerppufile);
  220. function getsize : longint;
  221. procedure ppuwrite(ppufile:tcompilerppufile);override;
  222. function gettypedef:tdef;override;
  223. procedure buildderef;override;
  224. procedure deref;override;
  225. procedure derefimpl;override;
  226. procedure dooverride(overriden:tpropertysym);
  227. end;
  228. ttypedconstsym = class(tstoredsym)
  229. private
  230. _mangledname : pstring;
  231. public
  232. typedconsttype : ttype;
  233. is_writable : boolean;
  234. constructor create(const n : string;p : tdef;writable : boolean);
  235. constructor createtype(const n : string;const tt : ttype;writable : boolean);
  236. constructor ppuload(ppufile:tcompilerppufile);
  237. destructor destroy;override;
  238. function mangledname : string;override;
  239. procedure ppuwrite(ppufile:tcompilerppufile);override;
  240. procedure buildderef;override;
  241. procedure deref;override;
  242. function getsize:longint;
  243. procedure set_mangledname(const s:string);
  244. end;
  245. tconstvalue = record
  246. case integer of
  247. 0: (valueord : tconstexprint);
  248. 1: (valueordptr : tconstptruint);
  249. 2: (valueptr : pointer; len : longint);
  250. end;
  251. tconstsym = class(tstoredsym)
  252. consttype : ttype;
  253. consttyp : tconsttyp;
  254. value : tconstvalue;
  255. resstrindex : longint; { needed for resource strings }
  256. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  257. constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  258. constructor create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  259. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  260. constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  261. constructor ppuload(ppufile:tcompilerppufile);
  262. destructor destroy;override;
  263. procedure buildderef;override;
  264. procedure deref;override;
  265. procedure ppuwrite(ppufile:tcompilerppufile);override;
  266. end;
  267. tenumsym = class(Tstoredsym)
  268. value : longint;
  269. definition : tenumdef;
  270. definitionderef : tderef;
  271. nextenum : tenumsym;
  272. constructor create(const n : string;def : tenumdef;v : longint);
  273. constructor ppuload(ppufile:tcompilerppufile);
  274. procedure ppuwrite(ppufile:tcompilerppufile);override;
  275. procedure buildderef;override;
  276. procedure deref;override;
  277. procedure order;
  278. end;
  279. tsyssym = class(Tstoredsym)
  280. number : longint;
  281. constructor create(const n : string;l : longint);
  282. constructor ppuload(ppufile:tcompilerppufile);
  283. destructor destroy;override;
  284. procedure ppuwrite(ppufile:tcompilerppufile);override;
  285. end;
  286. const
  287. maxmacrolen=16*1024;
  288. type
  289. pmacrobuffer = ^tmacrobuffer;
  290. tmacrobuffer = array[0..maxmacrolen-1] of char;
  291. tmacro = class(tstoredsym)
  292. {Normally true, but false when a previously defined macro is undef-ed}
  293. defined : boolean;
  294. {True if this is a mac style compiler variable, in which case no macro
  295. substitutions shall be done.}
  296. is_compiler_var : boolean;
  297. {Whether the macro was used. NOTE: A use of a macro which was never defined}
  298. {e. g. an IFDEF which returns false, will not be registered as used,}
  299. {since there is no place to register its use. }
  300. is_used : boolean;
  301. buftext : pchar;
  302. buflen : longint;
  303. constructor create(const n : string);
  304. constructor ppuload(ppufile:tcompilerppufile);
  305. procedure ppuwrite(ppufile:tcompilerppufile);override;
  306. destructor destroy;override;
  307. function GetCopy:tmacro;
  308. end;
  309. { compiler generated symbol to point to rtti and init/finalize tables }
  310. trttisym = class(tstoredsym)
  311. private
  312. _mangledname : pstring;
  313. public
  314. lab : tasmsymbol;
  315. rttityp : trttitype;
  316. constructor create(const n:string;rt:trttitype);
  317. constructor ppuload(ppufile:tcompilerppufile);
  318. destructor destroy;override;
  319. procedure ppuwrite(ppufile:tcompilerppufile);override;
  320. function mangledname:string;override;
  321. function get_label:tasmsymbol;
  322. end;
  323. var
  324. generrorsym : tsym;
  325. implementation
  326. uses
  327. { global }
  328. verbose,
  329. { target }
  330. systems,
  331. { symtable }
  332. defutil,symtable,
  333. { tree }
  334. node,
  335. { aasm }
  336. aasmtai,aasmdata,
  337. { codegen }
  338. paramgr,
  339. procinfo
  340. ;
  341. {****************************************************************************
  342. Helpers
  343. ****************************************************************************}
  344. {****************************************************************************
  345. TSYM (base for all symtypes)
  346. ****************************************************************************}
  347. constructor tstoredsym.create(st:tsymtyp;const n : string);
  348. begin
  349. inherited create(st,n);
  350. end;
  351. constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  352. var
  353. nr : word;
  354. s : string;
  355. begin
  356. nr:=ppufile.getword;
  357. s:=ppufile.getstring;
  358. if s[1]='$' then
  359. inherited createname(copy(s,2,255))
  360. else
  361. inherited createname(upper(s));
  362. _realname:=stringdup(s);
  363. typ:=st;
  364. { force the correct indexnr. must be after create! }
  365. indexnr:=nr;
  366. ppufile.getposinfo(fileinfo);
  367. ppufile.getsmallset(symoptions);
  368. lastref:=nil;
  369. defref:=nil;
  370. refs:=0;
  371. lastwritten:=nil;
  372. refcount:=0;
  373. isstabwritten := false;
  374. end;
  375. procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
  376. begin
  377. ppufile.putword(indexnr);
  378. ppufile.putstring(_realname^);
  379. ppufile.putposinfo(fileinfo);
  380. ppufile.putsmallset(symoptions);
  381. end;
  382. destructor tstoredsym.destroy;
  383. begin
  384. if assigned(defref) then
  385. begin
  386. {$ifdef MEMDEBUG}
  387. membrowser.start;
  388. {$endif MEMDEBUG}
  389. defref.freechain;
  390. defref.free;
  391. {$ifdef MEMDEBUG}
  392. membrowser.stop;
  393. {$endif MEMDEBUG}
  394. end;
  395. inherited destroy;
  396. end;
  397. {****************************************************************************
  398. TLABELSYM
  399. ****************************************************************************}
  400. constructor tlabelsym.create(const n : string);
  401. begin
  402. inherited create(labelsym,n);
  403. used:=false;
  404. defined:=false;
  405. code:=nil;
  406. end;
  407. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  408. begin
  409. inherited ppuload(labelsym,ppufile);
  410. code:=nil;
  411. used:=false;
  412. defined:=true;
  413. end;
  414. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  415. begin
  416. if owner.symtabletype=globalsymtable then
  417. Message(sym_e_ill_label_decl)
  418. else
  419. begin
  420. inherited ppuwrite(ppufile);
  421. ppufile.writeentry(iblabelsym);
  422. end;
  423. end;
  424. {****************************************************************************
  425. TUNITSYM
  426. ****************************************************************************}
  427. constructor tunitsym.create(const n : string;amodule : tobject);
  428. var
  429. old_make_ref : boolean;
  430. begin
  431. old_make_ref:=make_ref;
  432. make_ref:=false;
  433. inherited create(unitsym,n);
  434. make_ref:=old_make_ref;
  435. module:=amodule;
  436. end;
  437. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  438. begin
  439. inherited ppuload(unitsym,ppufile);
  440. module:=nil;
  441. end;
  442. destructor tunitsym.destroy;
  443. begin
  444. inherited destroy;
  445. end;
  446. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  447. begin
  448. inherited ppuwrite(ppufile);
  449. ppufile.writeentry(ibunitsym);
  450. end;
  451. {****************************************************************************
  452. TPROCSYM
  453. ****************************************************************************}
  454. constructor tprocsym.create(const n : string);
  455. begin
  456. inherited create(procsym,n);
  457. pdlistfirst:=nil;
  458. pdlistlast:=nil;
  459. { the tprocdef have their own symoptions, make the procsym
  460. always visible }
  461. symoptions:=[sp_public];
  462. overloadchecked:=false;
  463. procdef_count:=0;
  464. end;
  465. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  466. var
  467. pdderef : tderef;
  468. i,n : longint;
  469. begin
  470. inherited ppuload(procsym,ppufile);
  471. pdlistfirst:=nil;
  472. pdlistlast:=nil;
  473. procdef_count:=0;
  474. n:=ppufile.getword;
  475. for i:=1to n do
  476. begin
  477. ppufile.getderef(pdderef);
  478. addprocdef_deref(pdderef);
  479. end;
  480. overloadchecked:=false;
  481. end;
  482. destructor tprocsym.destroy;
  483. var
  484. hp,p : pprocdeflist;
  485. begin
  486. p:=pdlistfirst;
  487. while assigned(p) do
  488. begin
  489. hp:=p^.next;
  490. dispose(p);
  491. p:=hp;
  492. end;
  493. inherited destroy;
  494. end;
  495. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  496. var
  497. p : pprocdeflist;
  498. n : word;
  499. begin
  500. inherited ppuwrite(ppufile);
  501. { count procdefs }
  502. n:=0;
  503. p:=pdlistfirst;
  504. while assigned(p) do
  505. begin
  506. { only write the proc definitions that belong
  507. to this procsym and are in the global symtable }
  508. if p^.def.owner=owner then
  509. inc(n);
  510. p:=p^.next;
  511. end;
  512. ppufile.putword(n);
  513. { write procdefs }
  514. p:=pdlistfirst;
  515. while assigned(p) do
  516. begin
  517. { only write the proc definitions that belong
  518. to this procsym and are in the global symtable }
  519. if p^.def.owner=owner then
  520. ppufile.putderef(p^.defderef);
  521. p:=p^.next;
  522. end;
  523. ppufile.writeentry(ibprocsym);
  524. end;
  525. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  526. var
  527. p : pprocdeflist;
  528. begin
  529. p:=pdlistfirst;
  530. while assigned(p) do
  531. begin
  532. if p^.def<>skipdef then
  533. MessagePos1(p^.def.fileinfo,sym_h_param_list,p^.def.fullprocname(false));
  534. p:=p^.next;
  535. end;
  536. end;
  537. {Makes implicit externals (procedures declared in the interface
  538. section which do not have a counterpart in the implementation)
  539. to be an imported procedure. For mode macpas.}
  540. procedure import_implict_external(pd:tabstractprocdef);
  541. begin
  542. tprocdef(pd).forwarddef:=false;
  543. tprocdef(pd).setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
  544. end;
  545. procedure tprocsym.check_forward;
  546. var
  547. p : pprocdeflist;
  548. begin
  549. p:=pdlistfirst;
  550. while assigned(p) do
  551. begin
  552. if (p^.def.owner=owner) and (p^.def.forwarddef) then
  553. begin
  554. if (m_mac in aktmodeswitches) and (p^.def.interfacedef) then
  555. import_implict_external(p^.def)
  556. else
  557. begin
  558. MessagePos1(p^.def.fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname(false));
  559. { Turn further error messages off }
  560. p^.def.forwarddef:=false;
  561. end
  562. end;
  563. p:=p^.next;
  564. end;
  565. end;
  566. procedure tprocsym.buildderef;
  567. var
  568. p : pprocdeflist;
  569. begin
  570. p:=pdlistfirst;
  571. while assigned(p) do
  572. begin
  573. if p^.def.owner=owner then
  574. p^.defderef.build(p^.def);
  575. p:=p^.next;
  576. end;
  577. end;
  578. procedure tprocsym.deref;
  579. var
  580. p : pprocdeflist;
  581. begin
  582. { We have removed the overloaded entries, because they
  583. are not valid anymore and we can't deref them because
  584. the unit were they come from is not necessary in
  585. our uses clause (PFV) }
  586. unchain_overload;
  587. { Deref our own procdefs }
  588. p:=pdlistfirst;
  589. while assigned(p) do
  590. begin
  591. if not(
  592. (p^.def=nil) or
  593. (p^.def.owner=owner)
  594. ) then
  595. internalerror(200310291);
  596. p^.def:=tprocdef(p^.defderef.resolve);
  597. p:=p^.next;
  598. end;
  599. end;
  600. procedure tprocsym.addprocdef(p:tprocdef);
  601. var
  602. pd : pprocdeflist;
  603. begin
  604. new(pd);
  605. pd^.def:=p;
  606. pd^.defderef.reset;
  607. pd^.next:=nil;
  608. { Add at end of list to keep always
  609. a correct order, also after loading from ppu }
  610. if assigned(pdlistlast) then
  611. begin
  612. pdlistlast^.next:=pd;
  613. pdlistlast:=pd;
  614. end
  615. else
  616. begin
  617. pdlistfirst:=pd;
  618. pdlistlast:=pd;
  619. end;
  620. inc(procdef_count);
  621. end;
  622. procedure tprocsym.addprocdef_deref(const d:tderef);
  623. var
  624. pd : pprocdeflist;
  625. begin
  626. new(pd);
  627. pd^.def:=nil;
  628. pd^.defderef:=d;
  629. pd^.next:=nil;
  630. { Add at end of list to keep always
  631. a correct order, also after loading from ppu }
  632. if assigned(pdlistlast) then
  633. begin
  634. pdlistlast^.next:=pd;
  635. pdlistlast:=pd;
  636. end
  637. else
  638. begin
  639. pdlistfirst:=pd;
  640. pdlistlast:=pd;
  641. end;
  642. inc(procdef_count);
  643. end;
  644. function Tprocsym.getprocdef(nr:cardinal):Tprocdef;
  645. var
  646. i : cardinal;
  647. pd : pprocdeflist;
  648. begin
  649. pd:=pdlistfirst;
  650. for i:=2 to nr do
  651. begin
  652. if not assigned(pd) then
  653. internalerror(200209051);
  654. pd:=pd^.next;
  655. end;
  656. getprocdef:=pd^.def;
  657. end;
  658. procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
  659. var
  660. pd:pprocdeflist;
  661. begin
  662. pd:=pdlistfirst;
  663. while assigned(pd) do
  664. begin
  665. if Aprocsym.search_procdef_bypara(pd^.def.paras,nil,cpoptions)=nil then
  666. Aprocsym.addprocdef(pd^.def);
  667. pd:=pd^.next;
  668. end;
  669. end;
  670. procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
  671. var
  672. pd : pprocdeflist;
  673. begin
  674. pd:=pdlistfirst;
  675. while assigned(pd) do
  676. begin
  677. s.addprocdef(pd^.def);
  678. pd:=pd^.next;
  679. end;
  680. end;
  681. function Tprocsym.first_procdef:Tprocdef;
  682. begin
  683. if assigned(pdlistfirst) then
  684. first_procdef:=pdlistfirst^.def
  685. else
  686. first_procdef:=nil;
  687. end;
  688. function Tprocsym.last_procdef:Tprocdef;
  689. begin
  690. if assigned(pdlistlast) then
  691. last_procdef:=pdlistlast^.def
  692. else
  693. last_procdef:=nil;
  694. end;
  695. procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  696. var
  697. p : pprocdeflist;
  698. begin
  699. p:=pdlistfirst;
  700. while assigned(p) do
  701. begin
  702. proc2call(p^.def,arg);
  703. p:=p^.next;
  704. end;
  705. end;
  706. function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
  707. var
  708. p : pprocdeflist;
  709. begin
  710. search_procdef_nopara_boolret:=nil;
  711. p:=pdlistfirst;
  712. while p<>nil do
  713. begin
  714. if (p^.def.maxparacount=0) and
  715. is_boolean(p^.def.rettype.def) then
  716. begin
  717. search_procdef_nopara_boolret:=p^.def;
  718. break;
  719. end;
  720. p:=p^.next;
  721. end;
  722. end;
  723. function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  724. var
  725. p : pprocdeflist;
  726. begin
  727. search_procdef_bytype:=nil;
  728. p:=pdlistfirst;
  729. while p<>nil do
  730. begin
  731. if p^.def.proctypeoption=pt then
  732. begin
  733. search_procdef_bytype:=p^.def;
  734. break;
  735. end;
  736. p:=p^.next;
  737. end;
  738. end;
  739. function Tprocsym.search_procdef_bypara(para:TFPObjectList;retdef:tdef;
  740. cpoptions:tcompare_paras_options):Tprocdef;
  741. var
  742. pd : pprocdeflist;
  743. eq : tequaltype;
  744. begin
  745. search_procdef_bypara:=nil;
  746. pd:=pdlistfirst;
  747. while assigned(pd) do
  748. begin
  749. if assigned(retdef) then
  750. eq:=compare_defs(retdef,pd^.def.rettype.def,nothingn)
  751. else
  752. eq:=te_equal;
  753. if (eq>=te_equal) or
  754. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  755. begin
  756. eq:=compare_paras(para,pd^.def.paras,cp_value_equal_const,cpoptions);
  757. if (eq>=te_equal) or
  758. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  759. begin
  760. search_procdef_bypara:=pd^.def;
  761. break;
  762. end;
  763. end;
  764. pd:=pd^.next;
  765. end;
  766. end;
  767. function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  768. var
  769. pd : pprocdeflist;
  770. eq,besteq : tequaltype;
  771. bestpd : tprocdef;
  772. begin
  773. { This function will return the pprocdef of pprocsym that
  774. is the best match for procvardef. When there are multiple
  775. matches it returns nil.}
  776. search_procdef_byprocvardef:=nil;
  777. bestpd:=nil;
  778. besteq:=te_incompatible;
  779. pd:=pdlistfirst;
  780. while assigned(pd) do
  781. begin
  782. eq:=proc_to_procvar_equal(pd^.def,d);
  783. if eq>=te_equal then
  784. begin
  785. { multiple procvars with the same equal level }
  786. if assigned(bestpd) and
  787. (besteq=eq) then
  788. exit;
  789. if eq>besteq then
  790. begin
  791. besteq:=eq;
  792. bestpd:=pd^.def;
  793. end;
  794. end;
  795. pd:=pd^.next;
  796. end;
  797. search_procdef_byprocvardef:=bestpd;
  798. end;
  799. function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  800. var
  801. convtyp : tconverttype;
  802. pd : pprocdeflist;
  803. bestpd : tprocdef;
  804. eq : tequaltype;
  805. hpd : tprocdef;
  806. i : byte;
  807. begin
  808. result:=nil;
  809. bestpd:=nil;
  810. besteq:=te_incompatible;
  811. pd:=pdlistfirst;
  812. while assigned(pd) do
  813. begin
  814. if equal_defs(todef,pd^.def.rettype.def) and
  815. { the result type must be always really equal and not an alias,
  816. if you mess with this code, check tw4093 }
  817. ((todef=pd^.def.rettype.def) or
  818. (
  819. not(df_unique in todef.defoptions) and
  820. not(df_unique in pd^.def.rettype.def.defoptions)
  821. )
  822. ) then
  823. begin
  824. i:=0;
  825. { ignore vs_hidden parameters }
  826. while (i<pd^.def.paras.count) and
  827. assigned(pd^.def.paras[i]) and
  828. (vo_is_hidden_para in tparavarsym(pd^.def.paras[i]).varoptions) do
  829. inc(i);
  830. if (i<pd^.def.paras.count) and
  831. assigned(pd^.def.paras[i]) then
  832. begin
  833. eq:=compare_defs_ext(fromdef,tparavarsym(pd^.def.paras[i]).vartype.def,nothingn,convtyp,hpd,[]);
  834. { alias? if yes, only l1 choice,
  835. if you mess with this code, check tw4093 }
  836. if (eq=te_exact) and
  837. (fromdef<>tparavarsym(pd^.def.paras[i]).vartype.def) and
  838. ((df_unique in fromdef.defoptions) or
  839. (df_unique in tparavarsym(pd^.def.paras[i]).vartype.def.defoptions)) then
  840. eq:=te_convert_l1;
  841. if eq=te_exact then
  842. begin
  843. besteq:=eq;
  844. result:=pd^.def;
  845. exit;
  846. end;
  847. if eq>besteq then
  848. begin
  849. bestpd:=pd^.def;
  850. besteq:=eq;
  851. end;
  852. end;
  853. end;
  854. pd:=pd^.next;
  855. end;
  856. result:=bestpd;
  857. end;
  858. function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
  859. var
  860. p : pprocdeflist;
  861. begin
  862. write_references:=false;
  863. if not inherited write_references(ppufile,locals) then
  864. exit;
  865. write_references:=true;
  866. p:=pdlistfirst;
  867. while assigned(p) do
  868. begin
  869. if p^.def.owner=owner then
  870. p^.def.write_references(ppufile,locals);
  871. p:=p^.next;
  872. end;
  873. end;
  874. procedure tprocsym.unchain_overload;
  875. var
  876. p,hp : pprocdeflist;
  877. begin
  878. { remove all overloaded procdefs from the
  879. procdeflist that are not in the current symtable }
  880. overloadchecked:=false;
  881. p:=pdlistfirst;
  882. { reset new lists }
  883. pdlistfirst:=nil;
  884. pdlistlast:=nil;
  885. while assigned(p) do
  886. begin
  887. hp:=p^.next;
  888. { only keep the proc definitions:
  889. - are not deref'd (def=nil)
  890. - are in the same symtable as the procsym (for example both
  891. are in the staticsymtable) }
  892. if (p^.def=nil) or
  893. (p^.def.owner=owner) then
  894. begin
  895. { keep, add to list }
  896. if assigned(pdlistlast) then
  897. begin
  898. pdlistlast^.next:=p;
  899. pdlistlast:=p;
  900. end
  901. else
  902. begin
  903. pdlistfirst:=p;
  904. pdlistlast:=p;
  905. end;
  906. p^.next:=nil;
  907. end
  908. else
  909. begin
  910. { remove }
  911. dispose(p);
  912. dec(procdef_count);
  913. end;
  914. p:=hp;
  915. end;
  916. end;
  917. function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean;
  918. var
  919. p : pprocdeflist;
  920. begin
  921. { This procsym is visible, when there is at least
  922. one of the procdefs visible }
  923. result:=false;
  924. p:=pdlistfirst;
  925. while assigned(p) do
  926. begin
  927. if (p^.def.owner=owner) and
  928. p^.def.is_visible_for_object(tobjectdef(currobjdef)) then
  929. begin
  930. result:=true;
  931. exit;
  932. end;
  933. p:=p^.next;
  934. end;
  935. end;
  936. {****************************************************************************
  937. TERRORSYM
  938. ****************************************************************************}
  939. constructor terrorsym.create;
  940. begin
  941. inherited create(errorsym,'');
  942. end;
  943. {****************************************************************************
  944. TPROPERTYSYM
  945. ****************************************************************************}
  946. constructor tpropertysym.create(const n : string);
  947. begin
  948. inherited create(propertysym,n);
  949. propoptions:=[];
  950. index:=0;
  951. default:=0;
  952. proptype.reset;
  953. indextype.reset;
  954. readaccess:=tsymlist.create;
  955. writeaccess:=tsymlist.create;
  956. storedaccess:=tsymlist.create;
  957. end;
  958. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  959. begin
  960. inherited ppuload(propertysym,ppufile);
  961. ppufile.getsmallset(propoptions);
  962. if (ppo_is_override in propoptions) then
  963. begin
  964. ppufile.getderef(propoverridenderef);
  965. { we need to have these objects initialized }
  966. readaccess:=tsymlist.create;
  967. writeaccess:=tsymlist.create;
  968. storedaccess:=tsymlist.create;
  969. end
  970. else
  971. begin
  972. ppufile.gettype(proptype);
  973. index:=ppufile.getlongint;
  974. default:=ppufile.getlongint;
  975. ppufile.gettype(indextype);
  976. readaccess:=ppufile.getsymlist;
  977. writeaccess:=ppufile.getsymlist;
  978. storedaccess:=ppufile.getsymlist;
  979. end;
  980. end;
  981. destructor tpropertysym.destroy;
  982. begin
  983. readaccess.free;
  984. writeaccess.free;
  985. storedaccess.free;
  986. inherited destroy;
  987. end;
  988. function tpropertysym.gettypedef:tdef;
  989. begin
  990. gettypedef:=proptype.def;
  991. end;
  992. procedure tpropertysym.buildderef;
  993. begin
  994. if (ppo_is_override in propoptions) then
  995. begin
  996. propoverridenderef.build(propoverriden);
  997. end
  998. else
  999. begin
  1000. proptype.buildderef;
  1001. indextype.buildderef;
  1002. readaccess.buildderef;
  1003. writeaccess.buildderef;
  1004. storedaccess.buildderef;
  1005. end;
  1006. end;
  1007. procedure tpropertysym.deref;
  1008. begin
  1009. if not(ppo_is_override in propoptions) then
  1010. begin
  1011. proptype.resolve;
  1012. indextype.resolve;
  1013. readaccess.resolve;
  1014. writeaccess.resolve;
  1015. storedaccess.resolve;
  1016. end;
  1017. end;
  1018. procedure tpropertysym.derefimpl;
  1019. begin
  1020. if (ppo_is_override in propoptions) then
  1021. begin
  1022. propoverriden:=tpropertysym(propoverridenderef.resolve);
  1023. dooverride(propoverriden);
  1024. end
  1025. end;
  1026. function tpropertysym.getsize : longint;
  1027. begin
  1028. getsize:=0;
  1029. end;
  1030. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  1031. begin
  1032. inherited ppuwrite(ppufile);
  1033. ppufile.putsmallset(propoptions);
  1034. if (ppo_is_override in propoptions) then
  1035. ppufile.putderef(propoverridenderef)
  1036. else
  1037. begin
  1038. ppufile.puttype(proptype);
  1039. ppufile.putlongint(index);
  1040. ppufile.putlongint(default);
  1041. ppufile.puttype(indextype);
  1042. ppufile.putsymlist(readaccess);
  1043. ppufile.putsymlist(writeaccess);
  1044. ppufile.putsymlist(storedaccess);
  1045. end;
  1046. ppufile.writeentry(ibpropertysym);
  1047. end;
  1048. procedure tpropertysym.dooverride(overriden:tpropertysym);
  1049. begin
  1050. propoverriden:=overriden;
  1051. proptype:=overriden.proptype;
  1052. propoptions:=overriden.propoptions+[ppo_is_override];
  1053. index:=overriden.index;
  1054. default:=overriden.default;
  1055. indextype:=overriden.indextype;
  1056. readaccess.free;
  1057. readaccess:=overriden.readaccess.getcopy;
  1058. writeaccess.free;
  1059. writeaccess:=overriden.writeaccess.getcopy;
  1060. storedaccess.free;
  1061. storedaccess:=overriden.storedaccess.getcopy;
  1062. end;
  1063. {****************************************************************************
  1064. TABSTRACTVARSYM
  1065. ****************************************************************************}
  1066. constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1067. begin
  1068. inherited create(st,n);
  1069. vartype:=tt;
  1070. varspez:=vsp;
  1071. varstate:=vs_declared;
  1072. varoptions:=vopts;
  1073. end;
  1074. constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1075. begin
  1076. inherited ppuload(st,ppufile);
  1077. varstate:=vs_readwritten;
  1078. varspez:=tvarspez(ppufile.getbyte);
  1079. varregable:=tvarregable(ppufile.getbyte);
  1080. ppufile.gettype(_vartype);
  1081. ppufile.getsmallset(varoptions);
  1082. end;
  1083. destructor tabstractvarsym.destroy;
  1084. begin
  1085. if assigned(notifications) then
  1086. notifications.destroy;
  1087. inherited destroy;
  1088. end;
  1089. procedure tabstractvarsym.buildderef;
  1090. begin
  1091. vartype.buildderef;
  1092. end;
  1093. procedure tabstractvarsym.deref;
  1094. begin
  1095. vartype.resolve;
  1096. end;
  1097. procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile);
  1098. var
  1099. oldintfcrc : boolean;
  1100. begin
  1101. inherited ppuwrite(ppufile);
  1102. ppufile.putbyte(byte(varspez));
  1103. oldintfcrc:=ppufile.do_crc;
  1104. ppufile.do_crc:=false;
  1105. ppufile.putbyte(byte(varregable));
  1106. ppufile.do_crc:=oldintfcrc;
  1107. ppufile.puttype(vartype);
  1108. ppufile.putsmallset(varoptions);
  1109. end;
  1110. function tabstractvarsym.getsize : longint;
  1111. begin
  1112. if assigned(vartype.def) and
  1113. ((vartype.def.deftype<>arraydef) or
  1114. is_dynamic_array(vartype.def) or
  1115. (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
  1116. result:=vartype.def.size
  1117. else
  1118. result:=0;
  1119. end;
  1120. function tabstractvarsym.is_regvar(refpara: boolean):boolean;
  1121. begin
  1122. { Register variables are not allowed in the following cases:
  1123. - regvars are disabled
  1124. - exceptions are used (after an exception is raised the contents of the
  1125. registers is not valid anymore)
  1126. - it has a local copy
  1127. - the value needs to be in memory (i.e. reference counted) }
  1128. result:=(cs_opt_regvar in aktoptimizerswitches) and
  1129. not(pi_has_assembler_block in current_procinfo.flags) and
  1130. not(pi_uses_exceptions in current_procinfo.flags) and
  1131. not(vo_has_local_copy in varoptions) and
  1132. ((refpara and
  1133. (varregable <> vr_none)) or
  1134. (not refpara and
  1135. not(varregable in [vr_none,vr_addr])));
  1136. end;
  1137. procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag);
  1138. var n:Tnotification;
  1139. begin
  1140. if assigned(notifications) then
  1141. begin
  1142. n:=Tnotification(notifications.first);
  1143. while assigned(n) do
  1144. begin
  1145. if what in n.flags then
  1146. n.callback(what,self);
  1147. n:=Tnotification(n.next);
  1148. end;
  1149. end;
  1150. end;
  1151. function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback:
  1152. Tnotification_callback):cardinal;
  1153. var n:Tnotification;
  1154. begin
  1155. if not assigned(notifications) then
  1156. notifications:=Tlinkedlist.create;
  1157. n:=Tnotification.create(flags,callback);
  1158. register_notification:=n.id;
  1159. notifications.concat(n);
  1160. end;
  1161. procedure Tabstractvarsym.unregister_notification(id:cardinal);
  1162. var n:Tnotification;
  1163. begin
  1164. if not assigned(notifications) then
  1165. internalerror(200212311)
  1166. else
  1167. begin
  1168. n:=Tnotification(notifications.first);
  1169. while assigned(n) do
  1170. begin
  1171. if n.id=id then
  1172. begin
  1173. notifications.remove(n);
  1174. n.destroy;
  1175. exit;
  1176. end;
  1177. n:=Tnotification(n.next);
  1178. end;
  1179. internalerror(200212311)
  1180. end;
  1181. end;
  1182. procedure tabstractvarsym.setvartype(const newtype: ttype);
  1183. begin
  1184. _vartype := newtype;
  1185. { can we load the value into a register ? }
  1186. if not assigned(owner) or
  1187. (owner.symtabletype in [localsymtable,parasymtable]) or
  1188. (
  1189. (owner.symtabletype=staticsymtable) and
  1190. not(cs_create_pic in aktmoduleswitches)
  1191. ) then
  1192. begin
  1193. if tstoreddef(vartype.def).is_intregable then
  1194. varregable:=vr_intreg
  1195. else
  1196. { $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 }
  1197. if {(
  1198. not assigned(owner) or
  1199. (owner.symtabletype<>staticsymtable)
  1200. ) and }
  1201. tstoreddef(vartype.def).is_fpuregable then
  1202. begin
  1203. {$ifdef x86}
  1204. if use_sse(vartype.def) then
  1205. varregable:=vr_mmreg
  1206. else
  1207. {$else x86}
  1208. varregable:=vr_fpureg;
  1209. {$endif x86}
  1210. end;
  1211. end;
  1212. end;
  1213. {****************************************************************************
  1214. TFIELDVARSYM
  1215. ****************************************************************************}
  1216. constructor tfieldvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1217. begin
  1218. inherited create(fieldvarsym,n,vsp,tt,vopts);
  1219. fieldoffset:=-1;
  1220. end;
  1221. constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
  1222. begin
  1223. inherited ppuload(fieldvarsym,ppufile);
  1224. fieldoffset:=ppufile.getaint;
  1225. end;
  1226. procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
  1227. begin
  1228. inherited ppuwrite(ppufile);
  1229. ppufile.putaint(fieldoffset);
  1230. ppufile.writeentry(ibfieldvarsym);
  1231. end;
  1232. {****************************************************************************
  1233. TABSTRACTNORMALVARSYM
  1234. ****************************************************************************}
  1235. constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1236. begin
  1237. inherited create(st,n,vsp,tt,vopts);
  1238. fillchar(localloc,sizeof(localloc),0);
  1239. defaultconstsym:=nil;
  1240. end;
  1241. constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1242. begin
  1243. inherited ppuload(st,ppufile);
  1244. fillchar(localloc,sizeof(localloc),0);
  1245. ppufile.getderef(defaultconstsymderef);
  1246. end;
  1247. procedure tabstractnormalvarsym.buildderef;
  1248. begin
  1249. inherited buildderef;
  1250. defaultconstsymderef.build(defaultconstsym);
  1251. end;
  1252. procedure tabstractnormalvarsym.deref;
  1253. begin
  1254. inherited deref;
  1255. defaultconstsym:=tsym(defaultconstsymderef.resolve);
  1256. end;
  1257. procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1258. begin
  1259. inherited ppuwrite(ppufile);
  1260. ppufile.putderef(defaultconstsymderef);
  1261. end;
  1262. {****************************************************************************
  1263. TGLOBALVARSYM
  1264. ****************************************************************************}
  1265. constructor tglobalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1266. begin
  1267. inherited create(globalvarsym,n,vsp,tt,vopts);
  1268. _mangledname:=nil;
  1269. end;
  1270. constructor tglobalvarsym.create_dll(const n : string;vsp:tvarspez;const tt : ttype);
  1271. begin
  1272. tglobalvarsym(self).create(n,vsp,tt,[vo_is_dll_var]);
  1273. end;
  1274. constructor tglobalvarsym.create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);
  1275. begin
  1276. tglobalvarsym(self).create(n,vsp,tt,[]);
  1277. set_mangledname(mangled);
  1278. end;
  1279. constructor tglobalvarsym.ppuload(ppufile:tcompilerppufile);
  1280. begin
  1281. inherited ppuload(globalvarsym,ppufile);
  1282. if vo_has_mangledname in varoptions then
  1283. _mangledname:=stringdup(ppufile.getstring)
  1284. else
  1285. _mangledname:=nil;
  1286. end;
  1287. destructor tglobalvarsym.destroy;
  1288. begin
  1289. if assigned(_mangledname) then
  1290. begin
  1291. {$ifdef MEMDEBUG}
  1292. memmanglednames.start;
  1293. {$endif MEMDEBUG}
  1294. stringdispose(_mangledname);
  1295. {$ifdef MEMDEBUG}
  1296. memmanglednames.stop;
  1297. {$endif MEMDEBUG}
  1298. end;
  1299. inherited destroy;
  1300. end;
  1301. procedure tglobalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1302. begin
  1303. inherited ppuwrite(ppufile);
  1304. if vo_has_mangledname in varoptions then
  1305. ppufile.putstring(_mangledname^);
  1306. ppufile.writeentry(ibglobalvarsym);
  1307. end;
  1308. function tglobalvarsym.mangledname:string;
  1309. begin
  1310. if not assigned(_mangledname) then
  1311. begin
  1312. {$ifdef compress}
  1313. _mangledname:=stringdup(minilzw_encode(make_mangledname('U',owner,name)));
  1314. {$else}
  1315. _mangledname:=stringdup(make_mangledname('U',owner,name));
  1316. {$endif}
  1317. end;
  1318. result:=_mangledname^;
  1319. end;
  1320. procedure tglobalvarsym.set_mangledname(const s:string);
  1321. begin
  1322. stringdispose(_mangledname);
  1323. {$ifdef compress}
  1324. _mangledname:=stringdup(minilzw_encode(s));
  1325. {$else}
  1326. _mangledname:=stringdup(s);
  1327. {$endif}
  1328. include(varoptions,vo_has_mangledname);
  1329. end;
  1330. {****************************************************************************
  1331. TLOCALVARSYM
  1332. ****************************************************************************}
  1333. constructor tlocalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1334. begin
  1335. inherited create(localvarsym,n,vsp,tt,vopts);
  1336. end;
  1337. constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
  1338. begin
  1339. inherited ppuload(localvarsym,ppufile);
  1340. end;
  1341. procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1342. begin
  1343. inherited ppuwrite(ppufile);
  1344. ppufile.writeentry(iblocalvarsym);
  1345. end;
  1346. {****************************************************************************
  1347. TPARAVARSYM
  1348. ****************************************************************************}
  1349. constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1350. begin
  1351. inherited create(paravarsym,n,vsp,tt,vopts);
  1352. if (vsp in [vs_var,vs_value,vs_const]) then
  1353. varstate := vs_initialised;
  1354. paranr:=nr;
  1355. paraloc[calleeside].init;
  1356. paraloc[callerside].init;
  1357. end;
  1358. destructor tparavarsym.destroy;
  1359. begin
  1360. paraloc[calleeside].done;
  1361. paraloc[callerside].done;
  1362. inherited destroy;
  1363. end;
  1364. constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
  1365. var
  1366. b : byte;
  1367. begin
  1368. inherited ppuload(paravarsym,ppufile);
  1369. paranr:=ppufile.getword;
  1370. paraloc[calleeside].init;
  1371. paraloc[callerside].init;
  1372. if vo_has_explicit_paraloc in varoptions then
  1373. begin
  1374. b:=ppufile.getbyte;
  1375. if b<>sizeof(paraloc[callerside].location^) then
  1376. internalerror(200411154);
  1377. ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));
  1378. paraloc[callerside].size:=paraloc[callerside].location^.size;
  1379. paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];
  1380. end;
  1381. end;
  1382. procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
  1383. begin
  1384. inherited ppuwrite(ppufile);
  1385. ppufile.putword(paranr);
  1386. if vo_has_explicit_paraloc in varoptions then
  1387. begin
  1388. paraloc[callerside].check_simple_location;
  1389. ppufile.putbyte(sizeof(paraloc[callerside].location^));
  1390. ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));
  1391. end;
  1392. ppufile.writeentry(ibparavarsym);
  1393. end;
  1394. {****************************************************************************
  1395. TABSOLUTEVARSYM
  1396. ****************************************************************************}
  1397. constructor tabsolutevarsym.create(const n : string;const tt : ttype);
  1398. begin
  1399. inherited create(absolutevarsym,n,vs_value,tt,[]);
  1400. ref:=nil;
  1401. end;
  1402. constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);
  1403. begin
  1404. inherited create(absolutevarsym,n,vs_value,tt,[]);
  1405. ref:=_ref;
  1406. end;
  1407. destructor tabsolutevarsym.destroy;
  1408. begin
  1409. if assigned(ref) then
  1410. ref.free;
  1411. inherited destroy;
  1412. end;
  1413. constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
  1414. begin
  1415. inherited ppuload(absolutevarsym,ppufile);
  1416. ref:=nil;
  1417. asmname:=nil;
  1418. abstyp:=absolutetyp(ppufile.getbyte);
  1419. {$ifdef i386}
  1420. absseg:=false;
  1421. {$endif i386}
  1422. case abstyp of
  1423. tovar :
  1424. ref:=ppufile.getsymlist;
  1425. toasm :
  1426. asmname:=stringdup(ppufile.getstring);
  1427. toaddr :
  1428. begin
  1429. addroffset:=ppufile.getaint;
  1430. {$ifdef i386}
  1431. absseg:=boolean(ppufile.getbyte);
  1432. {$endif i386}
  1433. end;
  1434. end;
  1435. end;
  1436. procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
  1437. begin
  1438. inherited ppuwrite(ppufile);
  1439. ppufile.putbyte(byte(abstyp));
  1440. case abstyp of
  1441. tovar :
  1442. ppufile.putsymlist(ref);
  1443. toasm :
  1444. ppufile.putstring(asmname^);
  1445. toaddr :
  1446. begin
  1447. ppufile.putaint(addroffset);
  1448. {$ifdef i386}
  1449. ppufile.putbyte(byte(absseg));
  1450. {$endif i386}
  1451. end;
  1452. end;
  1453. ppufile.writeentry(ibabsolutevarsym);
  1454. end;
  1455. procedure tabsolutevarsym.buildderef;
  1456. begin
  1457. inherited buildderef;
  1458. if (abstyp=tovar) then
  1459. ref.buildderef;
  1460. end;
  1461. procedure tabsolutevarsym.deref;
  1462. begin
  1463. inherited deref;
  1464. { own absolute deref }
  1465. if (abstyp=tovar) then
  1466. ref.resolve;
  1467. end;
  1468. function tabsolutevarsym.mangledname : string;
  1469. begin
  1470. case abstyp of
  1471. toasm :
  1472. mangledname:=asmname^;
  1473. toaddr :
  1474. mangledname:='$'+tostr(addroffset);
  1475. else
  1476. internalerror(200411062);
  1477. end;
  1478. end;
  1479. {****************************************************************************
  1480. TTYPEDCONSTSYM
  1481. *****************************************************************************}
  1482. constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
  1483. begin
  1484. inherited create(typedconstsym,n);
  1485. typedconsttype.setdef(p);
  1486. is_writable:=writable;
  1487. end;
  1488. constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
  1489. begin
  1490. inherited create(typedconstsym,n);
  1491. typedconsttype:=tt;
  1492. is_writable:=writable;
  1493. end;
  1494. constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
  1495. begin
  1496. inherited ppuload(typedconstsym,ppufile);
  1497. ppufile.gettype(typedconsttype);
  1498. is_writable:=boolean(ppufile.getbyte);
  1499. end;
  1500. destructor ttypedconstsym.destroy;
  1501. begin
  1502. if assigned(_mangledname) then
  1503. begin
  1504. {$ifdef MEMDEBUG}
  1505. memmanglednames.start;
  1506. {$endif MEMDEBUG}
  1507. stringdispose(_mangledname);
  1508. {$ifdef MEMDEBUG}
  1509. memmanglednames.stop;
  1510. {$endif MEMDEBUG}
  1511. end;
  1512. inherited destroy;
  1513. end;
  1514. function ttypedconstsym.mangledname:string;
  1515. begin
  1516. if not assigned(_mangledname) then
  1517. begin
  1518. {$ifdef compress}
  1519. _mangledname:=stringdup(make_mangledname('TC',owner,name));
  1520. {$else}
  1521. _mangledname:=stringdup(make_mangledname('TC',owner,name));
  1522. {$endif}
  1523. end;
  1524. result:=_mangledname^;
  1525. end;
  1526. procedure ttypedconstsym.set_mangledname(const s:string);
  1527. begin
  1528. stringdispose(_mangledname);
  1529. {$ifdef compress}
  1530. _mangledname:=stringdup(minilzw_encode(s));
  1531. {$else}
  1532. _mangledname:=stringdup(s);
  1533. {$endif}
  1534. end;
  1535. function ttypedconstsym.getsize : longint;
  1536. begin
  1537. if assigned(typedconsttype.def) then
  1538. getsize:=typedconsttype.def.size
  1539. else
  1540. getsize:=0;
  1541. end;
  1542. procedure ttypedconstsym.buildderef;
  1543. begin
  1544. typedconsttype.buildderef;
  1545. end;
  1546. procedure ttypedconstsym.deref;
  1547. begin
  1548. typedconsttype.resolve;
  1549. end;
  1550. procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);
  1551. begin
  1552. inherited ppuwrite(ppufile);
  1553. ppufile.puttype(typedconsttype);
  1554. ppufile.putbyte(byte(is_writable));
  1555. ppufile.writeentry(ibtypedconstsym);
  1556. end;
  1557. {****************************************************************************
  1558. TCONSTSYM
  1559. ****************************************************************************}
  1560. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  1561. begin
  1562. inherited create(constsym,n);
  1563. fillchar(value, sizeof(value), #0);
  1564. consttyp:=t;
  1565. value.valueord:=v;
  1566. ResStrIndex:=0;
  1567. consttype:=tt;
  1568. end;
  1569. constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  1570. begin
  1571. inherited create(constsym,n);
  1572. fillchar(value, sizeof(value), #0);
  1573. consttyp:=t;
  1574. value.valueordptr:=v;
  1575. ResStrIndex:=0;
  1576. consttype:=tt;
  1577. end;
  1578. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  1579. begin
  1580. inherited create(constsym,n);
  1581. fillchar(value, sizeof(value), #0);
  1582. consttyp:=t;
  1583. value.valueptr:=v;
  1584. ResStrIndex:=0;
  1585. consttype:=tt;
  1586. end;
  1587. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1588. begin
  1589. inherited create(constsym,n);
  1590. fillchar(value, sizeof(value), #0);
  1591. consttyp:=t;
  1592. value.valueptr:=str;
  1593. consttype.reset;
  1594. value.len:=l;
  1595. end;
  1596. constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  1597. begin
  1598. inherited create(constsym,n);
  1599. fillchar(value, sizeof(value), #0);
  1600. consttyp:=t;
  1601. pcompilerwidestring(value.valueptr):=pw;
  1602. consttype.reset;
  1603. value.len:=getlengthwidestring(pw);
  1604. end;
  1605. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1606. var
  1607. pd : pbestreal;
  1608. ps : pnormalset;
  1609. pc : pchar;
  1610. pw : pcompilerwidestring;
  1611. begin
  1612. inherited ppuload(constsym,ppufile);
  1613. consttype.reset;
  1614. consttyp:=tconsttyp(ppufile.getbyte);
  1615. fillchar(value, sizeof(value), #0);
  1616. case consttyp of
  1617. constord :
  1618. begin
  1619. ppufile.gettype(consttype);
  1620. value.valueord:=ppufile.getexprint;
  1621. end;
  1622. constpointer :
  1623. begin
  1624. ppufile.gettype(consttype);
  1625. value.valueordptr:=ppufile.getptruint;
  1626. end;
  1627. constwstring :
  1628. begin
  1629. initwidestring(pw);
  1630. setlengthwidestring(pw,ppufile.getlongint);
  1631. ppufile.getdata(pw^.data,pw^.len*sizeof(tcompilerwidechar));
  1632. pcompilerwidestring(value.valueptr):=pw;
  1633. end;
  1634. conststring,
  1635. constresourcestring :
  1636. begin
  1637. value.len:=ppufile.getlongint;
  1638. getmem(pc,value.len+1);
  1639. ppufile.getdata(pc^,value.len);
  1640. if consttyp=constresourcestring then
  1641. ResStrIndex:=ppufile.getlongint;
  1642. value.valueptr:=pc;
  1643. end;
  1644. constreal :
  1645. begin
  1646. new(pd);
  1647. pd^:=ppufile.getreal;
  1648. value.valueptr:=pd;
  1649. end;
  1650. constset :
  1651. begin
  1652. ppufile.gettype(consttype);
  1653. new(ps);
  1654. ppufile.getnormalset(ps^);
  1655. value.valueptr:=ps;
  1656. end;
  1657. constguid :
  1658. begin
  1659. new(pguid(value.valueptr));
  1660. ppufile.getdata(value.valueptr^,sizeof(tguid));
  1661. end;
  1662. constnil : ;
  1663. else
  1664. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1665. end;
  1666. end;
  1667. destructor tconstsym.destroy;
  1668. begin
  1669. case consttyp of
  1670. conststring,
  1671. constresourcestring :
  1672. freemem(pchar(value.valueptr),value.len+1);
  1673. constwstring :
  1674. donewidestring(pcompilerwidestring(value.valueptr));
  1675. constreal :
  1676. dispose(pbestreal(value.valueptr));
  1677. constset :
  1678. dispose(pnormalset(value.valueptr));
  1679. constguid :
  1680. dispose(pguid(value.valueptr));
  1681. end;
  1682. inherited destroy;
  1683. end;
  1684. procedure tconstsym.buildderef;
  1685. begin
  1686. if consttyp in [constord,constpointer,constset] then
  1687. consttype.buildderef;
  1688. end;
  1689. procedure tconstsym.deref;
  1690. begin
  1691. if consttyp in [constord,constpointer,constset] then
  1692. consttype.resolve;
  1693. end;
  1694. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  1695. begin
  1696. inherited ppuwrite(ppufile);
  1697. ppufile.putbyte(byte(consttyp));
  1698. case consttyp of
  1699. constnil : ;
  1700. constord :
  1701. begin
  1702. ppufile.puttype(consttype);
  1703. ppufile.putexprint(value.valueord);
  1704. end;
  1705. constpointer :
  1706. begin
  1707. ppufile.puttype(consttype);
  1708. ppufile.putptruint(value.valueordptr);
  1709. end;
  1710. constwstring :
  1711. begin
  1712. ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
  1713. ppufile.putdata(pcompilerwidestring(value.valueptr)^.data,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
  1714. end;
  1715. conststring,
  1716. constresourcestring :
  1717. begin
  1718. ppufile.putlongint(value.len);
  1719. ppufile.putdata(pchar(value.valueptr)^,value.len);
  1720. if consttyp=constresourcestring then
  1721. ppufile.putlongint(ResStrIndex);
  1722. end;
  1723. constreal :
  1724. ppufile.putreal(pbestreal(value.valueptr)^);
  1725. constset :
  1726. begin
  1727. ppufile.puttype(consttype);
  1728. ppufile.putnormalset(value.valueptr^);
  1729. end;
  1730. constguid :
  1731. ppufile.putdata(value.valueptr^,sizeof(tguid));
  1732. else
  1733. internalerror(13);
  1734. end;
  1735. ppufile.writeentry(ibconstsym);
  1736. end;
  1737. {****************************************************************************
  1738. TENUMSYM
  1739. ****************************************************************************}
  1740. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  1741. begin
  1742. inherited create(enumsym,n);
  1743. definition:=def;
  1744. value:=v;
  1745. { First entry? Then we need to set the minval }
  1746. if def.firstenum=nil then
  1747. begin
  1748. if v>0 then
  1749. def.has_jumps:=true;
  1750. def.setmin(v);
  1751. def.setmax(v);
  1752. end
  1753. else
  1754. begin
  1755. { check for jumps }
  1756. if v>def.max+1 then
  1757. def.has_jumps:=true;
  1758. { update low and high }
  1759. if def.min>v then
  1760. def.setmin(v);
  1761. if def.max<v then
  1762. def.setmax(v);
  1763. end;
  1764. order;
  1765. end;
  1766. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  1767. begin
  1768. inherited ppuload(enumsym,ppufile);
  1769. ppufile.getderef(definitionderef);
  1770. value:=ppufile.getlongint;
  1771. nextenum := Nil;
  1772. end;
  1773. procedure tenumsym.buildderef;
  1774. begin
  1775. definitionderef.build(definition);
  1776. end;
  1777. procedure tenumsym.deref;
  1778. begin
  1779. definition:=tenumdef(definitionderef.resolve);
  1780. order;
  1781. end;
  1782. procedure tenumsym.order;
  1783. var
  1784. sym : tenumsym;
  1785. begin
  1786. sym := tenumsym(definition.firstenum);
  1787. if sym = nil then
  1788. begin
  1789. definition.firstenum := self;
  1790. nextenum := nil;
  1791. exit;
  1792. end;
  1793. { reorder the symbols in increasing value }
  1794. if value < sym.value then
  1795. begin
  1796. nextenum := sym;
  1797. definition.firstenum := self;
  1798. end
  1799. else
  1800. begin
  1801. while (sym.value <= value) and assigned(sym.nextenum) do
  1802. sym := sym.nextenum;
  1803. nextenum := sym.nextenum;
  1804. sym.nextenum := self;
  1805. end;
  1806. end;
  1807. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  1808. begin
  1809. inherited ppuwrite(ppufile);
  1810. ppufile.putderef(definitionderef);
  1811. ppufile.putlongint(value);
  1812. ppufile.writeentry(ibenumsym);
  1813. end;
  1814. {****************************************************************************
  1815. TTYPESYM
  1816. ****************************************************************************}
  1817. constructor ttypesym.create(const n : string;const tt : ttype);
  1818. begin
  1819. inherited create(typesym,n);
  1820. restype:=tt;
  1821. { register the typesym for the definition }
  1822. if assigned(restype.def) and
  1823. (restype.def.deftype<>errordef) and
  1824. not(assigned(restype.def.typesym)) then
  1825. restype.def.typesym:=self;
  1826. end;
  1827. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  1828. begin
  1829. inherited ppuload(typesym,ppufile);
  1830. ppufile.gettype(restype);
  1831. end;
  1832. function ttypesym.gettypedef:tdef;
  1833. begin
  1834. gettypedef:=restype.def;
  1835. end;
  1836. procedure ttypesym.buildderef;
  1837. begin
  1838. restype.buildderef;
  1839. end;
  1840. procedure ttypesym.deref;
  1841. begin
  1842. restype.resolve;
  1843. end;
  1844. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  1845. begin
  1846. inherited ppuwrite(ppufile);
  1847. ppufile.puttype(restype);
  1848. ppufile.writeentry(ibtypesym);
  1849. end;
  1850. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  1851. begin
  1852. inherited load_references(ppufile,locals);
  1853. if (restype.def.deftype=recorddef) then
  1854. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  1855. if (restype.def.deftype=objectdef) then
  1856. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  1857. end;
  1858. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  1859. var
  1860. d : tderef;
  1861. begin
  1862. d.reset;
  1863. if not inherited write_references(ppufile,locals) then
  1864. begin
  1865. { write address of this symbol if record or object
  1866. even if no real refs are there
  1867. because we need it for the symtable }
  1868. if (restype.def.deftype in [recorddef,objectdef]) then
  1869. begin
  1870. d.build(self);
  1871. ppufile.putderef(d);
  1872. ppufile.writeentry(ibsymref);
  1873. end;
  1874. end;
  1875. write_references:=true;
  1876. if (restype.def.deftype=recorddef) then
  1877. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  1878. if (restype.def.deftype=objectdef) then
  1879. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  1880. end;
  1881. {****************************************************************************
  1882. TSYSSYM
  1883. ****************************************************************************}
  1884. constructor tsyssym.create(const n : string;l : longint);
  1885. begin
  1886. inherited create(syssym,n);
  1887. number:=l;
  1888. end;
  1889. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  1890. begin
  1891. inherited ppuload(syssym,ppufile);
  1892. number:=ppufile.getlongint;
  1893. end;
  1894. destructor tsyssym.destroy;
  1895. begin
  1896. inherited destroy;
  1897. end;
  1898. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  1899. begin
  1900. inherited ppuwrite(ppufile);
  1901. ppufile.putlongint(number);
  1902. ppufile.writeentry(ibsyssym);
  1903. end;
  1904. {*****************************************************************************
  1905. TMacro
  1906. *****************************************************************************}
  1907. constructor tmacro.create(const n : string);
  1908. begin
  1909. inherited create(macrosym,n);
  1910. owner:=nil;
  1911. defined:=false;
  1912. is_used:=false;
  1913. is_compiler_var:=false;
  1914. buftext:=nil;
  1915. buflen:=0;
  1916. end;
  1917. constructor tmacro.ppuload(ppufile:tcompilerppufile);
  1918. begin
  1919. inherited ppuload(macrosym,ppufile);
  1920. name:=ppufile.getstring;
  1921. defined:=boolean(ppufile.getbyte);
  1922. is_compiler_var:=boolean(ppufile.getbyte);
  1923. is_used:=false;
  1924. buflen:= ppufile.getlongint;
  1925. if buflen > 0 then
  1926. begin
  1927. getmem(buftext, buflen);
  1928. ppufile.getdata(buftext^, buflen)
  1929. end
  1930. else
  1931. buftext:=nil;
  1932. end;
  1933. destructor tmacro.destroy;
  1934. begin
  1935. if assigned(buftext) then
  1936. freemem(buftext);
  1937. inherited destroy;
  1938. end;
  1939. procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
  1940. begin
  1941. inherited ppuwrite(ppufile);
  1942. ppufile.putstring(name);
  1943. ppufile.putbyte(byte(defined));
  1944. ppufile.putbyte(byte(is_compiler_var));
  1945. ppufile.putlongint(buflen);
  1946. if buflen > 0 then
  1947. ppufile.putdata(buftext^,buflen);
  1948. ppufile.writeentry(ibmacrosym);
  1949. end;
  1950. function tmacro.GetCopy:tmacro;
  1951. var
  1952. p : tmacro;
  1953. begin
  1954. p:=tmacro.create(realname);
  1955. p.defined:=defined;
  1956. p.is_used:=is_used;
  1957. p.is_compiler_var:=is_compiler_var;
  1958. p.buflen:=buflen;
  1959. if assigned(buftext) then
  1960. begin
  1961. getmem(p.buftext,buflen);
  1962. move(buftext^,p.buftext^,buflen);
  1963. end;
  1964. Result:=p;
  1965. end;
  1966. {****************************************************************************
  1967. TRTTISYM
  1968. ****************************************************************************}
  1969. constructor trttisym.create(const n:string;rt:trttitype);
  1970. const
  1971. prefix : array[trttitype] of string[5]=('$rtti','$init');
  1972. begin
  1973. inherited create(rttisym,prefix[rt]+n);
  1974. include(symoptions,sp_internal);
  1975. lab:=nil;
  1976. rttityp:=rt;
  1977. end;
  1978. destructor trttisym.destroy;
  1979. begin
  1980. if assigned(_mangledname) then
  1981. begin
  1982. {$ifdef MEMDEBUG}
  1983. memmanglednames.start;
  1984. {$endif MEMDEBUG}
  1985. stringdispose(_mangledname);
  1986. {$ifdef MEMDEBUG}
  1987. memmanglednames.stop;
  1988. {$endif MEMDEBUG}
  1989. end;
  1990. inherited destroy;
  1991. end;
  1992. constructor trttisym.ppuload(ppufile:tcompilerppufile);
  1993. begin
  1994. inherited ppuload(rttisym,ppufile);
  1995. lab:=nil;
  1996. rttityp:=trttitype(ppufile.getbyte);
  1997. end;
  1998. procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
  1999. begin
  2000. inherited ppuwrite(ppufile);
  2001. ppufile.putbyte(byte(rttityp));
  2002. ppufile.writeentry(ibrttisym);
  2003. end;
  2004. function trttisym.mangledname : string;
  2005. const
  2006. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2007. begin
  2008. if not assigned(_mangledname) then
  2009. _mangledname:=stringdup(make_mangledname(prefix[rttityp],owner,Copy(name,5,255)));
  2010. result:=_mangledname^;
  2011. end;
  2012. function trttisym.get_label:tasmsymbol;
  2013. begin
  2014. { the label is always a global label }
  2015. if not assigned(lab) then
  2016. lab:=current_asmdata.RefAsmSymbol(mangledname);
  2017. get_label:=lab;
  2018. end;
  2019. end.