symsym.pas 85 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589
  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. private
  38. procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
  39. protected
  40. procedure ppuwrite_platform(ppufile: tcompilerppufile);virtual;
  41. procedure ppuload_platform(ppufile: tcompilerppufile);virtual;
  42. public
  43. constructor create(st:tsymtyp;const n : string);
  44. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  45. destructor destroy;override;
  46. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  47. end;
  48. tlabelsym = class(tstoredsym)
  49. used,
  50. defined,
  51. nonlocal : boolean;
  52. { points to the matching node, only valid resultdef pass is run and
  53. the goto<->label relation in the node tree is created, should
  54. be a tnode }
  55. code : pointer;
  56. { points to the jump buffer }
  57. jumpbuf : tstoredsym;
  58. { when the label is defined in an asm block, this points to the
  59. generated asmlabel }
  60. asmblocklabel : tasmlabel;
  61. constructor create(const n : string);virtual;
  62. constructor ppuload(ppufile:tcompilerppufile);
  63. { do not override this routine in platform-specific subclasses,
  64. override ppuwrite_platform instead }
  65. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  66. function mangledname:TSymStr;override;
  67. end;
  68. tlabelsymclass = class of tlabelsym;
  69. tunitsym = class(Tstoredsym)
  70. module : tobject; { tmodule }
  71. constructor create(const n : string;amodule : tobject);virtual;
  72. constructor ppuload(ppufile:tcompilerppufile);
  73. destructor destroy;override;
  74. { do not override this routine in platform-specific subclasses,
  75. override ppuwrite_platform instead }
  76. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  77. end;
  78. tunitsymclass = class of tunitsym;
  79. tnamespacesym = class(Tstoredsym)
  80. unitsym:tsym;
  81. unitsymderef:tderef;
  82. constructor create(const n : string);virtual;
  83. constructor ppuload(ppufile:tcompilerppufile);
  84. { do not override this routine in platform-specific subclasses,
  85. override ppuwrite_platform instead }
  86. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  87. procedure buildderef;override;
  88. procedure deref;override;
  89. end;
  90. tnamespacesymclass = class of tnamespacesym;
  91. terrorsym = class(Tsym)
  92. constructor create;
  93. end;
  94. { tprocsym }
  95. tprocsym = class(tstoredsym)
  96. protected
  97. FProcdefList : TFPObjectList;
  98. FProcdefDerefList : TFPList;
  99. public
  100. constructor create(const n : string);virtual;
  101. constructor ppuload(ppufile:tcompilerppufile);
  102. destructor destroy;override;
  103. { writes all declarations except the specified one }
  104. procedure write_parameter_lists(skipdef:tprocdef);
  105. { tests, if all procedures definitions are defined and not }
  106. { only forward }
  107. procedure check_forward;
  108. { do not override this routine in platform-specific subclasses,
  109. override ppuwrite_platform instead }
  110. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  111. procedure buildderef;override;
  112. procedure deref;override;
  113. function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  114. function find_bytype_parameterless(pt:Tproctypeoption):Tprocdef;
  115. function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  116. function find_procdef_bytype_and_para(pt:Tproctypeoption;para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  117. function find_procdef_byoptions(ops:tprocoptions): Tprocdef;
  118. function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  119. function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  120. function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  121. property ProcdefList:TFPObjectList read FProcdefList;
  122. end;
  123. tprocsymclass = class of tprocsym;
  124. ttypesym = class(Tstoredsym)
  125. public
  126. typedef : tdef;
  127. typedefderef : tderef;
  128. fprettyname : ansistring;
  129. constructor create(const n : string;def:tdef);virtual;
  130. destructor destroy;override;
  131. constructor ppuload(ppufile:tcompilerppufile);
  132. { do not override this routine in platform-specific subclasses,
  133. override ppuwrite_platform instead }
  134. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  135. procedure buildderef;override;
  136. procedure deref;override;
  137. function prettyname : string;override;
  138. end;
  139. ttypesymclass = class of ttypesym;
  140. tabstractvarsym = class(tstoredsym)
  141. varoptions : tvaroptions;
  142. notifications : Tlinkedlist;
  143. varspez : tvarspez; { sets the type of access }
  144. varregable : tvarregable;
  145. varstate : tvarstate;
  146. { Has the address of this variable potentially escaped the }
  147. { block in which is was declared? }
  148. { could also be part of tabstractnormalvarsym, but there's }
  149. { one byte left here till the next 4 byte alignment }
  150. addr_taken : boolean;
  151. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  152. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  153. destructor destroy;override;
  154. procedure ppuwrite(ppufile:tcompilerppufile);override;
  155. procedure buildderef;override;
  156. procedure deref;override;
  157. function getsize : asizeint;
  158. function getpackedbitsize : longint;
  159. function is_regvar(refpara: boolean):boolean;
  160. procedure trigger_notifications(what:Tnotification_flag);
  161. function register_notification(flags:Tnotification_flags;
  162. callback:Tnotification_callback):cardinal;
  163. procedure unregister_notification(id:cardinal);
  164. private
  165. _vardef : tdef;
  166. vardefderef : tderef;
  167. procedure setvardef(def:tdef);
  168. public
  169. property vardef: tdef read _vardef write setvardef;
  170. end;
  171. tfieldvarsym = class(tabstractvarsym)
  172. { offset in record/object, for bitpacked fields the offset is
  173. given in bit, else in bytes }
  174. fieldoffset : asizeint;
  175. externalname : pshortstring;
  176. {$ifdef symansistr}
  177. cachedmangledname: TSymStr; { mangled name for ObjC or Java }
  178. {$else symansistr}
  179. cachedmangledname: pshortstring; { mangled name for ObjC or Java }
  180. {$endif symansistr}
  181. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  182. constructor ppuload(ppufile:tcompilerppufile);
  183. { do not override this routine in platform-specific subclasses,
  184. override ppuwrite_platform instead }
  185. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  186. procedure set_externalname(const s:string);virtual;
  187. function mangledname:TSymStr;override;
  188. destructor destroy;override;
  189. end;
  190. tfieldvarsymclass = class of tfieldvarsym;
  191. tabstractnormalvarsym = class(tabstractvarsym)
  192. defaultconstsym : tsym;
  193. defaultconstsymderef : tderef;
  194. { register/reference for local var }
  195. localloc : TLocation;
  196. { initial location so it can still be initialized later after the location was changed by SSA }
  197. initialloc : TLocation;
  198. { current registers for register variables with moving register numbers }
  199. currentregloc : TLocation;
  200. { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
  201. inparentfpstruct : boolean;
  202. constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  203. constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  204. function globalasmsym: boolean;
  205. procedure ppuwrite(ppufile:tcompilerppufile);override;
  206. procedure buildderef;override;
  207. procedure deref;override;
  208. end;
  209. tlocalvarsym = class(tabstractnormalvarsym)
  210. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  211. constructor ppuload(ppufile:tcompilerppufile);
  212. { do not override this routine in platform-specific subclasses,
  213. override ppuwrite_platform instead }
  214. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  215. end;
  216. tlocalvarsymclass = class of tlocalvarsym;
  217. tparavarsym = class(tabstractnormalvarsym)
  218. paraloc : array[tcallercallee] of TCGPara;
  219. paranr : word; { position of this parameter }
  220. { in MacPas mode, "univ" parameters mean that type checking should
  221. be disabled, except that the size of the passed parameter must
  222. match the size of the formal parameter }
  223. univpara : boolean;
  224. {$ifdef EXTDEBUG}
  225. eqval : tequaltype;
  226. {$endif EXTDEBUG}
  227. constructor create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  228. constructor ppuload(ppufile:tcompilerppufile);
  229. destructor destroy;override;
  230. { do not override this routine in platform-specific subclasses,
  231. override ppuwrite_platform instead }
  232. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  233. function needs_finalization: boolean;
  234. end;
  235. tparavarsymclass = class of tparavarsym;
  236. tstaticvarsym = class(tabstractnormalvarsym)
  237. protected
  238. {$ifdef symansistr}
  239. _mangledbasename,
  240. _mangledname : TSymStr;
  241. {$else symansistr}
  242. _mangledbasename,
  243. _mangledname : pshortstring;
  244. {$endif symansistr}
  245. public
  246. section : ansistring;
  247. { if a text buffer has been defined as being initialized from command line
  248. parameters as it is done by iso pascal with the program symbols,
  249. isoindex contains the parameter number }
  250. isoindex : dword;
  251. constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
  252. constructor create_dll(const n : string;vsp:tvarspez;def:tdef);virtual;
  253. constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
  254. constructor ppuload(ppufile:tcompilerppufile);
  255. destructor destroy;override;
  256. { do not override this routine in platform-specific subclasses,
  257. override ppuwrite_platform instead }
  258. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  259. function mangledname:TSymStr;override;
  260. procedure set_mangledbasename(const s: TSymStr);
  261. function mangledbasename: TSymStr;
  262. procedure set_mangledname(const s:TSymStr);virtual;
  263. procedure set_raw_mangledname(const s:TSymStr);
  264. end;
  265. tstaticvarsymclass = class of tstaticvarsym;
  266. tabsolutevarsym = class(tabstractvarsym)
  267. public
  268. abstyp : absolutetyp;
  269. asmname : pshortstring;
  270. addroffset : aword;
  271. ref : tpropaccesslist;
  272. constructor create(const n : string;def:tdef);virtual;
  273. constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist);virtual;
  274. destructor destroy;override;
  275. constructor ppuload(ppufile:tcompilerppufile);
  276. procedure buildderef;override;
  277. procedure deref;override;
  278. function mangledname : TSymStr;override;
  279. { do not override this routine in platform-specific subclasses,
  280. override ppuwrite_platform instead }
  281. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  282. end;
  283. tabsolutevarsymclass = class of tabsolutevarsym;
  284. tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
  285. tpropertysym = class(Tstoredsym)
  286. propoptions : tpropertyoptions;
  287. overriddenpropsym : tpropertysym;
  288. overriddenpropsymderef : tderef;
  289. propdef : tdef;
  290. propdefderef : tderef;
  291. indexdef : tdef;
  292. indexdefderef : tderef;
  293. index,
  294. default : longint;
  295. dispid : longint;
  296. propaccesslist: array[tpropaccesslisttypes] of tpropaccesslist;
  297. parast : tsymtable;
  298. constructor create(const n : string);virtual;
  299. destructor destroy;override;
  300. constructor ppuload(ppufile:tcompilerppufile);
  301. function getsize : asizeint;
  302. { do not override this routine in platform-specific subclasses,
  303. override ppuwrite_platform instead }
  304. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  305. procedure buildderef;override;
  306. procedure deref;override;
  307. function getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
  308. { copies the settings of the current propertysym to p; a bit like
  309. a form of getcopy, but without the name }
  310. procedure makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
  311. procedure add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
  312. procedure add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
  313. end;
  314. tpropertysymclass = class of tpropertysym;
  315. tconstvalue = record
  316. case integer of
  317. 0: (valueord : tconstexprint);
  318. 1: (valueordptr : tconstptruint);
  319. 2: (valueptr : pointer; len : longint);
  320. end;
  321. tconstsym = class(tstoredsym)
  322. constdef : tdef;
  323. constdefderef : tderef;
  324. consttyp : tconsttyp;
  325. value : tconstvalue;
  326. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);virtual;
  327. constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);virtual;
  328. constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
  329. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
  330. constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
  331. constructor ppuload(ppufile:tcompilerppufile);
  332. destructor destroy;override;
  333. procedure buildderef;override;
  334. procedure deref;override;
  335. { do not override this routine in platform-specific subclasses,
  336. override ppuwrite_platform instead }
  337. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  338. end;
  339. tconstsymclass = class of tconstsym;
  340. tenumsym = class(Tstoredsym)
  341. value : longint;
  342. definition : tenumdef;
  343. definitionderef : tderef;
  344. constructor create(const n : string;def : tenumdef;v : longint);virtual;
  345. constructor ppuload(ppufile:tcompilerppufile);
  346. { do not override this routine in platform-specific subclasses,
  347. override ppuwrite_platform instead }
  348. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  349. procedure buildderef;override;
  350. procedure deref;override;
  351. end;
  352. tenumsymclass = class of tenumsym;
  353. tsyssym = class(Tstoredsym)
  354. number : longint;
  355. constructor create(const n : string;l : longint);virtual;
  356. constructor ppuload(ppufile:tcompilerppufile);
  357. destructor destroy;override;
  358. { do not override this routine in platform-specific subclasses,
  359. override ppuwrite_platform instead }
  360. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  361. end;
  362. tsyssymclass = class of tsyssym;
  363. const
  364. maxmacrolen=16*1024;
  365. type
  366. pmacrobuffer = ^tmacrobuffer;
  367. tmacrobuffer = array[0..maxmacrolen-1] of char;
  368. tmacro = class(tstoredsym)
  369. {Normally true, but false when a previously defined macro is undef-ed}
  370. defined : boolean;
  371. {True if this is a mac style compiler variable, in which case no macro
  372. substitutions shall be done.}
  373. is_compiler_var : boolean;
  374. {Whether the macro was used. NOTE: A use of a macro which was never defined}
  375. {e. g. an IFDEF which returns false, will not be registered as used,}
  376. {since there is no place to register its use. }
  377. is_used : boolean;
  378. buftext : pchar;
  379. buflen : longint;
  380. constructor create(const n : string);
  381. constructor ppuload(ppufile:tcompilerppufile);
  382. { do not override this routine in platform-specific subclasses,
  383. override ppuwrite_platform instead }
  384. procedure ppuwrite(ppufile:tcompilerppufile);override;final;
  385. destructor destroy;override;
  386. function GetCopy:tmacro;
  387. end;
  388. var
  389. generrorsym : tsym;
  390. clabelsym: tlabelsymclass;
  391. cunitsym: tunitsymclass;
  392. cnamespacesym: tnamespacesymclass;
  393. cprocsym: tprocsymclass;
  394. ctypesym: ttypesymclass;
  395. cfieldvarsym: tfieldvarsymclass;
  396. clocalvarsym: tlocalvarsymclass;
  397. cparavarsym: tparavarsymclass;
  398. cstaticvarsym: tstaticvarsymclass;
  399. cabsolutevarsym: tabsolutevarsymclass;
  400. cpropertysym: tpropertysymclass;
  401. cconstsym: tconstsymclass;
  402. cenumsym: tenumsymclass;
  403. csyssym: tsyssymclass;
  404. { generate internal static field name based on regular field name }
  405. function internal_static_field_name(const fieldname: TSymStr): TSymStr;
  406. function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
  407. procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
  408. implementation
  409. uses
  410. { global }
  411. verbose,
  412. { target }
  413. systems,
  414. { symtable }
  415. defutil,symtable,
  416. fmodule,
  417. { tree }
  418. node,
  419. { aasm }
  420. aasmtai,aasmdata,
  421. { codegen }
  422. paramgr,
  423. procinfo
  424. ;
  425. {****************************************************************************
  426. Helpers
  427. ****************************************************************************}
  428. function internal_static_field_name(const fieldname: TSymStr): TSymStr;
  429. begin
  430. result:='$_static_'+fieldname;
  431. end;
  432. function get_high_value_sym(vs: tparavarsym):tsym;
  433. begin
  434. result := tsym(vs.owner.Find('high'+vs.name));
  435. end;
  436. procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
  437. begin
  438. if not assigned(srsym) then
  439. internalerror(200602051);
  440. if sp_hint_deprecated in symoptions then
  441. if (sp_has_deprecated_msg in symoptions) and (deprecatedmsg <> nil) then
  442. Message2(sym_w_deprecated_symbol_with_msg,srsym.realname,deprecatedmsg^)
  443. else
  444. Message1(sym_w_deprecated_symbol,srsym.realname);
  445. if sp_hint_experimental in symoptions then
  446. Message1(sym_w_experimental_symbol,srsym.realname);
  447. if sp_hint_platform in symoptions then
  448. Message1(sym_w_non_portable_symbol,srsym.realname);
  449. if sp_hint_library in symoptions then
  450. Message1(sym_w_library_symbol,srsym.realname);
  451. if sp_hint_unimplemented in symoptions then
  452. Message1(sym_w_non_implemented_symbol,srsym.realname);
  453. end;
  454. {****************************************************************************
  455. TSYM (base for all symtypes)
  456. ****************************************************************************}
  457. constructor tstoredsym.create(st:tsymtyp;const n : string);
  458. begin
  459. inherited create(st,n);
  460. { Register in current_module }
  461. if assigned(current_module) then
  462. begin
  463. current_module.symlist.Add(self);
  464. SymId:=current_module.symlist.Count-1;
  465. end;
  466. end;
  467. constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  468. begin
  469. SymId:=ppufile.getlongint;
  470. inherited Create(st,ppufile.getstring);
  471. { Register symbol }
  472. current_module.symlist[SymId]:=self;
  473. ppufile.getposinfo(fileinfo);
  474. visibility:=tvisibility(ppufile.getbyte);
  475. ppufile.getsmallset(symoptions);
  476. if sp_has_deprecated_msg in symoptions then
  477. deprecatedmsg:=stringdup(ppufile.getstring)
  478. else
  479. deprecatedmsg:=nil;
  480. end;
  481. procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile);
  482. var
  483. oldintfcrc : boolean;
  484. begin
  485. ppufile.putlongint(SymId);
  486. ppufile.putstring(realname);
  487. ppufile.putposinfo(fileinfo);
  488. ppufile.putbyte(byte(visibility));
  489. { symoptions can differ between interface and implementation, except
  490. for overload (this is checked in pdecsub.proc_add_definition() )
  491. These differences can lead to compiler crashes, so ignore them.
  492. This does mean that changing e.g. the "deprecated" state of a symbol
  493. by itself will not trigger a recompilation of dependent units.
  494. }
  495. oldintfcrc:=ppufile.do_interface_crc;
  496. ppufile.do_interface_crc:=false;
  497. ppufile.putsmallset(symoptions);
  498. if sp_has_deprecated_msg in symoptions then
  499. ppufile.putstring(deprecatedmsg^);
  500. ppufile.do_interface_crc:=oldintfcrc;
  501. end;
  502. procedure tstoredsym.writeentry(ppufile: tcompilerppufile; ibnr: byte);
  503. begin
  504. ppuwrite_platform(ppufile);
  505. ppufile.writeentry(ibnr);
  506. end;
  507. procedure tstoredsym.ppuwrite_platform(ppufile: tcompilerppufile);
  508. begin
  509. { by default: do nothing }
  510. end;
  511. procedure tstoredsym.ppuload_platform(ppufile: tcompilerppufile);
  512. begin
  513. { by default: do nothing }
  514. end;
  515. destructor tstoredsym.destroy;
  516. begin
  517. inherited destroy;
  518. end;
  519. {****************************************************************************
  520. TLABELSYM
  521. ****************************************************************************}
  522. constructor tlabelsym.create(const n : string);
  523. begin
  524. inherited create(labelsym,n);
  525. used:=false;
  526. defined:=false;
  527. nonlocal:=false;
  528. code:=nil;
  529. end;
  530. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  531. begin
  532. inherited ppuload(labelsym,ppufile);
  533. code:=nil;
  534. used:=false;
  535. nonlocal:=false;
  536. defined:=true;
  537. ppuload_platform(ppufile);
  538. end;
  539. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  540. begin
  541. if owner.symtabletype=globalsymtable then
  542. Message(sym_e_ill_label_decl)
  543. else
  544. begin
  545. inherited ppuwrite(ppufile);
  546. writeentry(ppufile,iblabelsym);
  547. end;
  548. end;
  549. function tlabelsym.mangledname:TSymStr;
  550. begin
  551. if not(defined) then
  552. begin
  553. defined:=true;
  554. if nonlocal then
  555. current_asmdata.getglobaljumplabel(asmblocklabel)
  556. else
  557. current_asmdata.getjumplabel(asmblocklabel);
  558. end;
  559. result:=asmblocklabel.name;
  560. end;
  561. {****************************************************************************
  562. TUNITSYM
  563. ****************************************************************************}
  564. constructor tunitsym.create(const n : string;amodule : tobject);
  565. begin
  566. inherited create(unitsym,n);
  567. module:=amodule;
  568. end;
  569. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  570. begin
  571. inherited ppuload(unitsym,ppufile);
  572. module:=nil;
  573. ppuload_platform(ppufile);
  574. end;
  575. destructor tunitsym.destroy;
  576. begin
  577. inherited destroy;
  578. end;
  579. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  580. begin
  581. inherited ppuwrite(ppufile);
  582. writeentry(ppufile,ibunitsym);
  583. end;
  584. {****************************************************************************
  585. TNAMESPACESYM
  586. ****************************************************************************}
  587. constructor tnamespacesym.create(const n : string);
  588. begin
  589. inherited create(namespacesym,n);
  590. unitsym:=nil;
  591. end;
  592. constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
  593. begin
  594. inherited ppuload(namespacesym,ppufile);
  595. ppufile.getderef(unitsymderef);
  596. ppuload_platform(ppufile);
  597. end;
  598. procedure tnamespacesym.ppuwrite(ppufile:tcompilerppufile);
  599. begin
  600. inherited ppuwrite(ppufile);
  601. ppufile.putderef(unitsymderef);
  602. writeentry(ppufile,ibnamespacesym);
  603. end;
  604. procedure tnamespacesym.buildderef;
  605. begin
  606. inherited buildderef;
  607. unitsymderef.build(unitsym);
  608. end;
  609. procedure tnamespacesym.deref;
  610. begin
  611. inherited deref;
  612. unitsym:=tsym(unitsymderef.resolve);
  613. end;
  614. {****************************************************************************
  615. TPROCSYM
  616. ****************************************************************************}
  617. constructor tprocsym.create(const n : string);
  618. var
  619. i: longint;
  620. begin
  621. if not(ts_lowercase_proc_start in current_settings.targetswitches) or
  622. (n='') then
  623. inherited create(procsym,n)
  624. else
  625. begin
  626. { YToX -> yToX
  627. RC64Encode -> rc64Encode
  628. Test -> test
  629. }
  630. i:=2;
  631. while i<=length(n) do
  632. begin
  633. if not(n[i] in ['A'..'Z']) then
  634. begin
  635. if (i>2) and
  636. (n[i] in ['a'..'z']) then
  637. dec(i);
  638. break;
  639. end;
  640. inc(i);
  641. end;
  642. inherited create(procsym,lower(copy(n,1,i-1))+copy(n,i,length(n)));
  643. end;
  644. FProcdefList:=TFPObjectList.Create(false);
  645. FProcdefderefList:=nil;
  646. { the tprocdef have their own symoptions, make the procsym
  647. always visible }
  648. visibility:=vis_public;
  649. end;
  650. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  651. var
  652. pdderef : tderef;
  653. i,
  654. pdcnt : longint;
  655. begin
  656. inherited ppuload(procsym,ppufile);
  657. FProcdefList:=TFPObjectList.Create(false);
  658. FProcdefDerefList:=TFPList.Create;
  659. pdcnt:=ppufile.getword;
  660. for i:=1 to pdcnt do
  661. begin
  662. ppufile.getderef(pdderef);
  663. FProcdefDerefList.Add(Pointer(PtrInt(pdderef.dataidx)));
  664. end;
  665. ppuload_platform(ppufile);
  666. end;
  667. destructor tprocsym.destroy;
  668. begin
  669. FProcdefList.Free;
  670. if assigned(FProcdefDerefList) then
  671. FProcdefDerefList.Free;
  672. inherited destroy;
  673. end;
  674. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  675. var
  676. i : longint;
  677. d : tderef;
  678. begin
  679. inherited ppuwrite(ppufile);
  680. if fprocdefdereflist=nil then
  681. internalerror(2013121801);
  682. ppufile.putword(FProcdefDerefList.Count);
  683. for i:=0 to FProcdefDerefList.Count-1 do
  684. begin
  685. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  686. ppufile.putderef(d);
  687. end;
  688. writeentry(ppufile,ibprocsym);
  689. end;
  690. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  691. var
  692. i : longint;
  693. pd : tprocdef;
  694. begin
  695. for i:=0 to ProcdefList.Count-1 do
  696. begin
  697. pd:=tprocdef(ProcdefList[i]);
  698. if pd<>skipdef then
  699. MessagePos1(pd.fileinfo,sym_h_param_list,pd.fullprocname(false));
  700. end;
  701. end;
  702. procedure tprocsym.check_forward;
  703. var
  704. i : longint;
  705. pd : tprocdef;
  706. begin
  707. for i:=0 to ProcdefList.Count-1 do
  708. begin
  709. pd:=tprocdef(ProcdefList[i]);
  710. if (pd.owner=owner) and (pd.forwarddef) then
  711. begin
  712. { For mode macpas. Make implicit externals (procedures declared in the interface
  713. section which do not have a counterpart in the implementation)
  714. to be an imported procedure }
  715. if (m_mac in current_settings.modeswitches) and
  716. (pd.interfacedef) then
  717. begin
  718. pd.setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname);
  719. if (not current_module.interface_only) then
  720. MessagePos1(pd.fileinfo,sym_w_forward_not_resolved,pd.fullprocname(false));
  721. end
  722. else
  723. begin
  724. MessagePos1(pd.fileinfo,sym_e_forward_not_resolved,pd.fullprocname(false));
  725. end;
  726. { Turn further error messages off }
  727. pd.forwarddef:=false;
  728. end;
  729. end;
  730. end;
  731. procedure tprocsym.buildderef;
  732. var
  733. i : longint;
  734. pd : tprocdef;
  735. d : tderef;
  736. begin
  737. if not assigned(FProcdefDerefList) then
  738. FProcdefDerefList:=TFPList.Create
  739. else
  740. FProcdefDerefList.Clear;
  741. for i:=0 to ProcdefList.Count-1 do
  742. begin
  743. pd:=tprocdef(ProcdefList[i]);
  744. { only write the proc definitions that belong
  745. to this procsym and are in the global symtable }
  746. if pd.owner=owner then
  747. begin
  748. d.build(pd);
  749. FProcdefDerefList.Add(Pointer(PtrInt(d.dataidx)));
  750. end;
  751. end;
  752. end;
  753. procedure tprocsym.deref;
  754. var
  755. i : longint;
  756. pd : tprocdef;
  757. d : tderef;
  758. begin
  759. { Clear all procdefs }
  760. ProcdefList.Clear;
  761. if not assigned(FProcdefDerefList) then
  762. internalerror(200611031);
  763. for i:=0 to FProcdefDerefList.Count-1 do
  764. begin
  765. d.dataidx:=PtrInt(FProcdefDerefList[i]);
  766. pd:=tprocdef(d.resolve);
  767. ProcdefList.Add(pd);
  768. end;
  769. end;
  770. function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  771. var
  772. i : longint;
  773. pd : tprocdef;
  774. begin
  775. result:=nil;
  776. for i:=0 to ProcdefList.Count-1 do
  777. begin
  778. pd:=tprocdef(ProcdefList[i]);
  779. if pd.proctypeoption=pt then
  780. begin
  781. result:=pd;
  782. exit;
  783. end;
  784. end;
  785. end;
  786. function tprocsym.find_bytype_parameterless(pt: Tproctypeoption): Tprocdef;
  787. var
  788. i,j : longint;
  789. pd : tprocdef;
  790. found : boolean;
  791. begin
  792. result:=nil;
  793. for i:=0 to ProcdefList.Count-1 do
  794. begin
  795. pd:=tprocdef(ProcdefList[i]);
  796. if (pd.proctypeoption=pt) then
  797. begin
  798. found:=true;
  799. for j:=0 to pd.paras.count-1 do
  800. begin
  801. if not(vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  802. begin
  803. found:=false;
  804. break;
  805. end;
  806. end;
  807. if found then
  808. begin
  809. result:=pd;
  810. exit;
  811. end;
  812. end;
  813. end;
  814. end;
  815. function check_procdef_paras(pd:tprocdef;para:TFPObjectList;retdef:tdef;
  816. cpoptions:tcompare_paras_options): tprocdef;
  817. var
  818. eq: tequaltype;
  819. begin
  820. result:=nil;
  821. if assigned(retdef) then
  822. eq:=compare_defs(retdef,pd.returndef,nothingn)
  823. else
  824. eq:=te_equal;
  825. if (eq>=te_equal) or
  826. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  827. begin
  828. eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
  829. if (eq>=te_equal) or
  830. ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
  831. begin
  832. result:=pd;
  833. exit;
  834. end;
  835. end;
  836. end;
  837. function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef;
  838. cpoptions:tcompare_paras_options):Tprocdef;
  839. var
  840. i : longint;
  841. pd : tprocdef;
  842. begin
  843. result:=nil;
  844. for i:=0 to ProcdefList.Count-1 do
  845. begin
  846. pd:=tprocdef(ProcdefList[i]);
  847. result:=check_procdef_paras(pd,para,retdef,cpoptions);
  848. if assigned(result) then
  849. exit;
  850. end;
  851. end;
  852. function Tprocsym.find_procdef_bytype_and_para(pt:Tproctypeoption;
  853. para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
  854. var
  855. i : longint;
  856. pd : tprocdef;
  857. begin
  858. result:=nil;
  859. for i:=0 to ProcdefList.Count-1 do
  860. begin
  861. pd:=tprocdef(ProcdefList[i]);
  862. if pd.proctypeoption=pt then
  863. begin
  864. result:=check_procdef_paras(pd,para,retdef,cpoptions);
  865. if assigned(result) then
  866. exit;
  867. end;
  868. end;
  869. end;
  870. function tprocsym.find_procdef_byoptions(ops: tprocoptions): Tprocdef;
  871. var
  872. i : longint;
  873. pd : tprocdef;
  874. begin
  875. result:=nil;
  876. for i:=0 to ProcdefList.Count-1 do
  877. begin
  878. pd:=tprocdef(ProcdefList[i]);
  879. if ops * pd.procoptions = ops then
  880. begin
  881. result:=pd;
  882. exit;
  883. end;
  884. end;
  885. end;
  886. function Tprocsym.Find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  887. var
  888. i : longint;
  889. bestpd,
  890. pd : tprocdef;
  891. eq,besteq : tequaltype;
  892. sym: tsym;
  893. ps: tprocsym;
  894. begin
  895. { This function will return the pprocdef of pprocsym that
  896. is the best match for procvardef. When there are multiple
  897. matches it returns nil.}
  898. result:=nil;
  899. bestpd:=nil;
  900. besteq:=te_incompatible;
  901. ps:=self;
  902. repeat
  903. for i:=0 to ps.ProcdefList.Count-1 do
  904. begin
  905. pd:=tprocdef(ps.ProcdefList[i]);
  906. eq:=proc_to_procvar_equal(pd,d,false);
  907. if eq>=te_convert_l1 then
  908. begin
  909. { multiple procvars with the same equal level }
  910. if assigned(bestpd) and
  911. (besteq=eq) then
  912. exit;
  913. if eq>besteq then
  914. begin
  915. besteq:=eq;
  916. bestpd:=pd;
  917. end;
  918. end;
  919. end;
  920. { maybe TODO: also search class helpers? -- this code is similar to
  921. what happens in htypechk in
  922. tcallcandidates.collect_overloads_in_struct: keep searching in
  923. parent types in case the currently found procdef is marked as
  924. "overload" and we haven't found a proper match yet }
  925. if assigned(ps.owner.defowner) and
  926. (ps.owner.defowner.typ=objectdef) and
  927. assigned(tobjectdef(ps.owner.defowner).childof) and
  928. (not assigned(bestpd) or
  929. (po_overload in bestpd.procoptions)) then
  930. begin
  931. sym:=tsym(tobjectdef(ps.owner.defowner).childof.symtable.find(ps.name));
  932. if assigned(sym) and
  933. (sym.typ=procsym) then
  934. ps:=tprocsym(sym)
  935. else
  936. ps:=nil;
  937. end
  938. else
  939. ps:=nil;
  940. until (besteq>=te_equal) or
  941. not assigned(ps);
  942. result:=bestpd;
  943. end;
  944. function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  945. var
  946. paraidx, realparamcount,
  947. i, j : longint;
  948. bestpd,
  949. hpd,
  950. pd : tprocdef;
  951. convtyp : tconverttype;
  952. eq : tequaltype;
  953. begin
  954. { This function will return the pprocdef of pprocsym that
  955. is the best match for fromdef and todef. }
  956. result:=nil;
  957. bestpd:=nil;
  958. besteq:=te_incompatible;
  959. for i:=0 to ProcdefList.Count-1 do
  960. begin
  961. pd:=tprocdef(ProcdefList[i]);
  962. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  963. continue;
  964. if (equal_defs(todef,pd.returndef) or
  965. { shortstrings of different lengths are ok as result }
  966. (is_shortstring(todef) and is_shortstring(pd.returndef))) and
  967. { the result type must be always really equal and not an alias,
  968. if you mess with this code, check tw4093 }
  969. ((todef=pd.returndef) or
  970. (
  971. not(df_unique in todef.defoptions) and
  972. not(df_unique in pd.returndef.defoptions)
  973. )
  974. ) then
  975. begin
  976. paraidx:=0;
  977. { ignore vs_hidden parameters }
  978. while (paraidx<pd.paras.count) and
  979. assigned(pd.paras[paraidx]) and
  980. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  981. inc(paraidx);
  982. realparamcount:=0;
  983. for j := 0 to pd.paras.Count-1 do
  984. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  985. inc(realparamcount);
  986. if (paraidx<pd.paras.count) and
  987. assigned(pd.paras[paraidx]) and
  988. (realparamcount = 1) then
  989. begin
  990. eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  991. { alias? if yes, only l1 choice,
  992. if you mess with this code, check tw4093 }
  993. if (eq=te_exact) and
  994. (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
  995. ((df_unique in fromdef.defoptions) or
  996. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  997. eq:=te_convert_l1;
  998. if eq=te_exact then
  999. begin
  1000. besteq:=eq;
  1001. result:=pd;
  1002. exit;
  1003. end;
  1004. if eq>besteq then
  1005. begin
  1006. bestpd:=pd;
  1007. besteq:=eq;
  1008. end;
  1009. end;
  1010. end;
  1011. end;
  1012. result:=bestpd;
  1013. end;
  1014. function Tprocsym.find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
  1015. var
  1016. paraidx, realparamcount,
  1017. i, j : longint;
  1018. bestpd,
  1019. hpd,
  1020. pd : tprocdef;
  1021. current : tpropertysym;
  1022. convtyp : tconverttype;
  1023. eq : tequaltype;
  1024. begin
  1025. { This function will return the pprocdef of pprocsym that
  1026. is the best match for fromdef and todef. }
  1027. result:=nil;
  1028. bestpd:=nil;
  1029. besteq:=te_incompatible;
  1030. for i:=0 to ProcdefList.Count-1 do
  1031. begin
  1032. pd:=tprocdef(ProcdefList[i]);
  1033. if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
  1034. continue;
  1035. if not (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
  1036. continue;
  1037. current := tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current);
  1038. if (current = nil) then
  1039. continue;
  1040. // compare current result def with the todef
  1041. if (equal_defs(todef, current.propdef) or
  1042. { shortstrings of different lengths are ok as result }
  1043. (is_shortstring(todef) and is_shortstring(current.propdef))) and
  1044. { the result type must be always really equal and not an alias,
  1045. if you mess with this code, check tw4093 }
  1046. ((todef=current.propdef) or
  1047. (
  1048. not(df_unique in todef.defoptions) and
  1049. not(df_unique in current.propdef.defoptions)
  1050. )
  1051. ) then
  1052. begin
  1053. paraidx:=0;
  1054. { ignore vs_hidden parameters }
  1055. while (paraidx<pd.paras.count) and
  1056. assigned(pd.paras[paraidx]) and
  1057. (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do
  1058. inc(paraidx);
  1059. realparamcount:=0;
  1060. for j := 0 to pd.paras.Count-1 do
  1061. if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then
  1062. inc(realparamcount);
  1063. if (paraidx<pd.paras.count) and
  1064. assigned(pd.paras[paraidx]) and
  1065. (realparamcount = 1) then
  1066. begin
  1067. eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]);
  1068. { alias? if yes, only l1 choice,
  1069. if you mess with this code, check tw4093 }
  1070. if (eq=te_exact) and
  1071. (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and
  1072. ((df_unique in fromdef.defoptions) or
  1073. (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
  1074. eq:=te_convert_l1;
  1075. if eq=te_exact then
  1076. begin
  1077. besteq:=eq;
  1078. result:=pd;
  1079. exit;
  1080. end;
  1081. if eq>besteq then
  1082. begin
  1083. bestpd:=pd;
  1084. besteq:=eq;
  1085. end;
  1086. end;
  1087. end;
  1088. end;
  1089. result:=bestpd;
  1090. end;
  1091. {****************************************************************************
  1092. TERRORSYM
  1093. ****************************************************************************}
  1094. constructor terrorsym.create;
  1095. begin
  1096. inherited create(errorsym,'');
  1097. end;
  1098. {****************************************************************************
  1099. TPROPERTYSYM
  1100. ****************************************************************************}
  1101. constructor tpropertysym.create(const n : string);
  1102. var
  1103. pap : tpropaccesslisttypes;
  1104. begin
  1105. inherited create(propertysym,n);
  1106. propoptions:=[];
  1107. index:=0;
  1108. default:=0;
  1109. propdef:=nil;
  1110. indexdef:=nil;
  1111. parast:=nil;
  1112. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1113. propaccesslist[pap]:=tpropaccesslist.create;
  1114. end;
  1115. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  1116. var
  1117. pap : tpropaccesslisttypes;
  1118. begin
  1119. inherited ppuload(propertysym,ppufile);
  1120. ppufile.getsmallset(propoptions);
  1121. if ppo_overrides in propoptions then
  1122. ppufile.getderef(overriddenpropsymderef);
  1123. ppufile.getderef(propdefderef);
  1124. index:=ppufile.getlongint;
  1125. default:=ppufile.getlongint;
  1126. ppufile.getderef(indexdefderef);
  1127. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1128. propaccesslist[pap]:=ppufile.getpropaccesslist;
  1129. ppuload_platform(ppufile);
  1130. if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
  1131. begin
  1132. parast:=tparasymtable.create(nil,0);
  1133. tparasymtable(parast).ppuload(ppufile);
  1134. end
  1135. else
  1136. parast:=nil;
  1137. end;
  1138. destructor tpropertysym.destroy;
  1139. var
  1140. pap : tpropaccesslisttypes;
  1141. begin
  1142. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1143. propaccesslist[pap].free;
  1144. parast.free;
  1145. inherited destroy;
  1146. end;
  1147. procedure tpropertysym.buildderef;
  1148. var
  1149. pap : tpropaccesslisttypes;
  1150. begin
  1151. propdefderef.build(propdef);
  1152. indexdefderef.build(indexdef);
  1153. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1154. propaccesslist[pap].buildderef;
  1155. if ppo_overrides in propoptions then
  1156. overriddenpropsymderef.build(overriddenpropsym)
  1157. else
  1158. if ppo_hasparameters in propoptions then
  1159. tparasymtable(parast).buildderef;
  1160. end;
  1161. procedure tpropertysym.deref;
  1162. var
  1163. pap : tpropaccesslisttypes;
  1164. begin
  1165. indexdef:=tdef(indexdefderef.resolve);
  1166. propdef:=tdef(propdefderef.resolve);
  1167. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1168. propaccesslist[pap].resolve;
  1169. if ppo_overrides in propoptions then
  1170. begin
  1171. overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
  1172. if ppo_hasparameters in propoptions then
  1173. parast:=overriddenpropsym.parast.getcopy;
  1174. end
  1175. else
  1176. if ppo_hasparameters in propoptions then
  1177. tparasymtable(parast).deref
  1178. end;
  1179. function tpropertysym.getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
  1180. var
  1181. hpropsym : tpropertysym;
  1182. begin
  1183. result:=false;
  1184. { find property in the overridden list }
  1185. hpropsym:=self;
  1186. repeat
  1187. plist:=hpropsym.propaccesslist[pap];
  1188. if not plist.empty then
  1189. begin
  1190. result:=true;
  1191. exit;
  1192. end;
  1193. hpropsym:=hpropsym.overriddenpropsym;
  1194. until not assigned(hpropsym);
  1195. end;
  1196. procedure tpropertysym.add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
  1197. var
  1198. i: integer;
  1199. orig, hparavs: tparavarsym;
  1200. begin
  1201. for i := 0 to parast.SymList.Count - 1 do
  1202. begin
  1203. orig:=tparavarsym(parast.SymList[i]);
  1204. if assigned(readprocdef) then
  1205. begin
  1206. hparavs:=cparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
  1207. readprocdef.parast.insert(hparavs);
  1208. end;
  1209. if assigned(writeprocdef) then
  1210. begin
  1211. hparavs:=cparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
  1212. writeprocdef.parast.insert(hparavs);
  1213. end;
  1214. end;
  1215. end;
  1216. procedure tpropertysym.add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
  1217. var
  1218. hparavs: tparavarsym;
  1219. begin
  1220. inc(paranr);
  1221. if assigned(readprocdef) then
  1222. begin
  1223. hparavs:=cparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
  1224. readprocdef.parast.insert(hparavs);
  1225. end;
  1226. if assigned(writeprocdef) then
  1227. begin
  1228. hparavs:=cparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
  1229. writeprocdef.parast.insert(hparavs);
  1230. end;
  1231. end;
  1232. procedure tpropertysym.makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
  1233. begin
  1234. { inherit all type related entries }
  1235. p.indexdef:=indexdef;
  1236. p.propdef:=propdef;
  1237. p.index:=index;
  1238. p.default:=default;
  1239. p.propoptions:=propoptions;
  1240. paranr:=0;
  1241. if ppo_hasparameters in propoptions then
  1242. begin
  1243. p.parast:=parast.getcopy;
  1244. p.add_accessor_parameters(readprocdef,writeprocdef);
  1245. paranr:=p.parast.SymList.Count;
  1246. end;
  1247. if ppo_indexed in p.propoptions then
  1248. p.add_index_parameter(paranr,readprocdef,writeprocdef);
  1249. end;
  1250. function tpropertysym.getsize : asizeint;
  1251. begin
  1252. getsize:=0;
  1253. end;
  1254. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  1255. var
  1256. pap : tpropaccesslisttypes;
  1257. begin
  1258. inherited ppuwrite(ppufile);
  1259. ppufile.putsmallset(propoptions);
  1260. if ppo_overrides in propoptions then
  1261. ppufile.putderef(overriddenpropsymderef);
  1262. ppufile.putderef(propdefderef);
  1263. ppufile.putlongint(index);
  1264. ppufile.putlongint(default);
  1265. ppufile.putderef(indexdefderef);
  1266. for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
  1267. ppufile.putpropaccesslist(propaccesslist[pap]);
  1268. writeentry(ppufile,ibpropertysym);
  1269. if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
  1270. tparasymtable(parast).ppuwrite(ppufile);
  1271. end;
  1272. {****************************************************************************
  1273. TABSTRACTVARSYM
  1274. ****************************************************************************}
  1275. constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1276. begin
  1277. inherited create(st,n);
  1278. vardef:=def;
  1279. varspez:=vsp;
  1280. varstate:=vs_declared;
  1281. varoptions:=vopts;
  1282. end;
  1283. constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1284. begin
  1285. inherited ppuload(st,ppufile);
  1286. varstate:=vs_readwritten;
  1287. varspez:=tvarspez(ppufile.getbyte);
  1288. varregable:=tvarregable(ppufile.getbyte);
  1289. addr_taken:=boolean(ppufile.getbyte);
  1290. ppufile.getderef(vardefderef);
  1291. ppufile.getsmallset(varoptions);
  1292. end;
  1293. destructor tabstractvarsym.destroy;
  1294. begin
  1295. if assigned(notifications) then
  1296. notifications.destroy;
  1297. inherited destroy;
  1298. end;
  1299. procedure tabstractvarsym.buildderef;
  1300. begin
  1301. vardefderef.build(vardef);
  1302. end;
  1303. procedure tabstractvarsym.deref;
  1304. var
  1305. oldvarregable: tvarregable;
  1306. begin
  1307. { setting the vardef also updates varregable. We just loaded this }
  1308. { value from a ppu, so it must not be changed (e.g. tw7817a.pp/ }
  1309. { tw7817b.pp: the address is taken of a local variable in an }
  1310. { inlined procedure -> must remain non-regable when inlining) }
  1311. oldvarregable:=varregable;
  1312. vardef:=tdef(vardefderef.resolve);
  1313. varregable:=oldvarregable;
  1314. end;
  1315. procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile);
  1316. var
  1317. oldintfcrc : boolean;
  1318. begin
  1319. inherited ppuwrite(ppufile);
  1320. ppufile.putbyte(byte(varspez));
  1321. oldintfcrc:=ppufile.do_crc;
  1322. ppufile.do_crc:=false;
  1323. ppufile.putbyte(byte(varregable));
  1324. ppufile.putbyte(byte(addr_taken));
  1325. ppufile.do_crc:=oldintfcrc;
  1326. ppufile.putderef(vardefderef);
  1327. ppufile.putsmallset(varoptions);
  1328. end;
  1329. function tabstractvarsym.getsize : asizeint;
  1330. begin
  1331. if assigned(vardef) and
  1332. ((vardef.typ<>arraydef) or
  1333. is_dynamic_array(vardef) or
  1334. (tarraydef(vardef).highrange>=tarraydef(vardef).lowrange)) then
  1335. result:=vardef.size
  1336. else
  1337. result:=0;
  1338. end;
  1339. function tabstractvarsym.getpackedbitsize : longint;
  1340. begin
  1341. { bitpacking is only done for ordinals }
  1342. if not is_ordinal(vardef) then
  1343. internalerror(2006082010);
  1344. result:=vardef.packedbitsize;
  1345. end;
  1346. function tabstractvarsym.is_regvar(refpara: boolean):boolean;
  1347. begin
  1348. { Register variables are not allowed in the following cases:
  1349. - regvars are disabled
  1350. - exceptions are used (after an exception is raised the contents of the
  1351. registers is not valid anymore)
  1352. - it has a local copy
  1353. - the value needs to be in memory (i.e. reference counted) }
  1354. result:=(cs_opt_regvar in current_settings.optimizerswitches) and
  1355. not(pi_has_assembler_block in current_procinfo.flags) and
  1356. not(pi_uses_exceptions in current_procinfo.flags) and
  1357. not(pi_has_interproclabel in current_procinfo.flags) and
  1358. not(vo_has_local_copy in varoptions) and
  1359. ((refpara and
  1360. (varregable <> vr_none)) or
  1361. (not refpara and
  1362. not(varregable in [vr_none,vr_addr])))
  1363. {$if not defined(powerpc) and not defined(powerpc64)}
  1364. and ((vardef.typ <> recorddef) or
  1365. (varregable = vr_addr) or
  1366. not(varstate in [vs_written,vs_readwritten]));
  1367. {$endif}
  1368. end;
  1369. procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag);
  1370. var n:Tnotification;
  1371. begin
  1372. if assigned(notifications) then
  1373. begin
  1374. n:=Tnotification(notifications.first);
  1375. while assigned(n) do
  1376. begin
  1377. if what in n.flags then
  1378. n.callback(what,self);
  1379. n:=Tnotification(n.next);
  1380. end;
  1381. end;
  1382. end;
  1383. function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback:
  1384. Tnotification_callback):cardinal;
  1385. var n:Tnotification;
  1386. begin
  1387. if not assigned(notifications) then
  1388. notifications:=Tlinkedlist.create;
  1389. n:=Tnotification.create(flags,callback);
  1390. register_notification:=n.id;
  1391. notifications.concat(n);
  1392. end;
  1393. procedure Tabstractvarsym.unregister_notification(id:cardinal);
  1394. var n:Tnotification;
  1395. begin
  1396. if not assigned(notifications) then
  1397. internalerror(200212311)
  1398. else
  1399. begin
  1400. n:=Tnotification(notifications.first);
  1401. while assigned(n) do
  1402. begin
  1403. if n.id=id then
  1404. begin
  1405. notifications.remove(n);
  1406. n.destroy;
  1407. exit;
  1408. end;
  1409. n:=Tnotification(n.next);
  1410. end;
  1411. internalerror(200212311)
  1412. end;
  1413. end;
  1414. procedure tabstractvarsym.setvardef(def:tdef);
  1415. begin
  1416. _vardef := def;
  1417. { can we load the value into a register ? }
  1418. if not assigned(owner) or
  1419. (owner.symtabletype in [localsymtable,parasymtable]) or
  1420. (
  1421. (owner.symtabletype=staticsymtable) and
  1422. not(cs_create_pic in current_settings.moduleswitches)
  1423. ) then
  1424. begin
  1425. if (tstoreddef(vardef).is_intregable and
  1426. { we could keep all aint*2 records in registers, but this causes
  1427. too much spilling for CPUs with 8-16 registers so keep only
  1428. parameters and function results of this type in register because they are normally
  1429. passed by register anyways
  1430. This can be changed, as soon as we have full ssa (FK) }
  1431. ((typ=paravarsym) or
  1432. (vo_is_funcret in varoptions) or
  1433. (tstoreddef(vardef).typ<>recorddef) or
  1434. (tstoreddef(vardef).size<=sizeof(aint)))) or
  1435. { const parameters can be put into registers if the def fits into a register }
  1436. (tstoreddef(vardef).is_const_intregable and
  1437. (typ=paravarsym) and
  1438. (varspez=vs_const)) then
  1439. varregable:=vr_intreg
  1440. else
  1441. { $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 }
  1442. if {(
  1443. not assigned(owner) or
  1444. (owner.symtabletype<>staticsymtable)
  1445. ) and }
  1446. tstoreddef(vardef).is_fpuregable then
  1447. begin
  1448. if use_vectorfpu(vardef) then
  1449. varregable:=vr_mmreg
  1450. else
  1451. varregable:=vr_fpureg;
  1452. end;
  1453. end;
  1454. end;
  1455. {****************************************************************************
  1456. TFIELDVARSYM
  1457. ****************************************************************************}
  1458. constructor tfieldvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1459. begin
  1460. inherited create(fieldvarsym,n,vsp,def,vopts);
  1461. fieldoffset:=-1;
  1462. end;
  1463. constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
  1464. begin
  1465. inherited ppuload(fieldvarsym,ppufile);
  1466. fieldoffset:=ppufile.getaint;
  1467. if (vo_has_mangledname in varoptions) then
  1468. externalname:=stringdup(ppufile.getstring)
  1469. else
  1470. externalname:=nil;
  1471. ppuload_platform(ppufile);
  1472. end;
  1473. procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
  1474. begin
  1475. inherited ppuwrite(ppufile);
  1476. ppufile.putaint(fieldoffset);
  1477. if (vo_has_mangledname in varoptions) then
  1478. ppufile.putstring(externalname^);
  1479. writeentry(ppufile,ibfieldvarsym);
  1480. end;
  1481. procedure tfieldvarsym.set_externalname(const s: string);
  1482. begin
  1483. internalerror(2014033001);
  1484. end;
  1485. function tfieldvarsym.mangledname:TSymStr;
  1486. var
  1487. srsym : tsym;
  1488. srsymtable : tsymtable;
  1489. begin
  1490. if sp_static in symoptions then
  1491. begin
  1492. if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1493. result:=srsym.mangledname
  1494. { when generating the debug info for the module in which the }
  1495. { symbol is defined, the localsymtable of that module is }
  1496. { already popped from the symtablestack }
  1497. else if searchsym_in_module(current_module,lower(owner.name^)+'_'+name,srsym,srsymtable) then
  1498. result:=srsym.mangledname
  1499. else
  1500. internalerror(2007012501);
  1501. end
  1502. else if is_objcclass(tdef(owner.defowner)) then
  1503. begin
  1504. {$ifdef symansistr}
  1505. if cachedmangledname<>'' then
  1506. result:=cachedmangledname
  1507. {$else symansistr}
  1508. if assigned(cachedmangledname) then
  1509. result:=cachedmangledname^
  1510. {$endif symansistr}
  1511. else
  1512. begin
  1513. result:=target_info.cprefix+'OBJC_IVAR_$_'+tobjectdef(owner.defowner).objextname^+'.'+RealName;
  1514. {$ifdef symansistr}
  1515. cachedmangledname:=result;
  1516. {$else symansistr}
  1517. cachedmangledname:=stringdup(result);
  1518. {$endif symansistr}
  1519. end;
  1520. end
  1521. else
  1522. result:=inherited mangledname;
  1523. end;
  1524. destructor tfieldvarsym.destroy;
  1525. begin
  1526. {$ifndef symansistr}
  1527. stringdispose(cachedmangledname);
  1528. {$endif symansistr}
  1529. stringdispose(externalname);
  1530. inherited destroy;
  1531. end;
  1532. {****************************************************************************
  1533. TABSTRACTNORMALVARSYM
  1534. ****************************************************************************}
  1535. constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1536. begin
  1537. inherited create(st,n,vsp,def,vopts);
  1538. fillchar(localloc,sizeof(localloc),0);
  1539. fillchar(currentregloc,sizeof(localloc),0);
  1540. fillchar(initialloc,sizeof(initialloc),0);
  1541. defaultconstsym:=nil;
  1542. end;
  1543. constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile);
  1544. begin
  1545. inherited ppuload(st,ppufile);
  1546. fillchar(localloc,sizeof(localloc),0);
  1547. fillchar(currentregloc,sizeof(localloc),0);
  1548. fillchar(initialloc,sizeof(initialloc),0);
  1549. ppufile.getderef(defaultconstsymderef);
  1550. end;
  1551. function tabstractnormalvarsym.globalasmsym: boolean;
  1552. begin
  1553. result:=
  1554. (owner.symtabletype=globalsymtable) or
  1555. (create_smartlink and
  1556. not(tf_smartlink_sections in target_info.flags)) or
  1557. DLLSource or
  1558. (assigned(current_procinfo) and
  1559. ((po_inline in current_procinfo.procdef.procoptions) or
  1560. { globalasmsym is called normally before the body of a subroutine is parsed
  1561. so we cannot know if it will be auto inlined, so make all symbols of it
  1562. global if asked }
  1563. (cs_opt_autoinline in current_settings.optimizerswitches))
  1564. ) or
  1565. (vo_is_public in varoptions);
  1566. end;
  1567. procedure tabstractnormalvarsym.buildderef;
  1568. begin
  1569. inherited buildderef;
  1570. defaultconstsymderef.build(defaultconstsym);
  1571. end;
  1572. procedure tabstractnormalvarsym.deref;
  1573. begin
  1574. inherited deref;
  1575. defaultconstsym:=tsym(defaultconstsymderef.resolve);
  1576. end;
  1577. procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1578. begin
  1579. inherited ppuwrite(ppufile);
  1580. ppufile.putderef(defaultconstsymderef);
  1581. end;
  1582. {****************************************************************************
  1583. Tstaticvarsym
  1584. ****************************************************************************}
  1585. constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1586. begin
  1587. inherited create(staticvarsym,n,vsp,def,vopts);
  1588. {$ifdef symansistr}
  1589. _mangledname:='';
  1590. {$else symansistr}
  1591. _mangledname:=nil;
  1592. {$endif symansistr}
  1593. end;
  1594. constructor tstaticvarsym.create_dll(const n : string;vsp:tvarspez;def:tdef);
  1595. begin
  1596. tstaticvarsym(self).create(n,vsp,def,[vo_is_dll_var]);
  1597. end;
  1598. constructor tstaticvarsym.create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);
  1599. begin
  1600. tstaticvarsym(self).create(n,vsp,def,[]);
  1601. set_mangledname(mangled);
  1602. end;
  1603. constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
  1604. begin
  1605. inherited ppuload(staticvarsym,ppufile);
  1606. {$ifdef symansistr}
  1607. if vo_has_mangledname in varoptions then
  1608. _mangledname:=ppufile.getansistring
  1609. else
  1610. _mangledname:='';
  1611. {$else symansistr}
  1612. if vo_has_mangledname in varoptions then
  1613. _mangledname:=stringdup(ppufile.getstring)
  1614. else
  1615. _mangledname:=nil;
  1616. if vo_has_section in varoptions then
  1617. section:=ppufile.getansistring;
  1618. {$endif symansistr}
  1619. ppuload_platform(ppufile);
  1620. end;
  1621. destructor tstaticvarsym.destroy;
  1622. begin
  1623. {$ifndef symansistr}
  1624. if assigned(_mangledname) then
  1625. begin
  1626. {$ifdef MEMDEBUG}
  1627. memmanglednames.start;
  1628. {$endif MEMDEBUG}
  1629. stringdispose(_mangledname);
  1630. {$ifdef MEMDEBUG}
  1631. memmanglednames.stop;
  1632. {$endif MEMDEBUG}
  1633. end;
  1634. stringdispose(_mangledbasename);
  1635. {$endif}
  1636. inherited destroy;
  1637. end;
  1638. procedure tstaticvarsym.ppuwrite(ppufile:tcompilerppufile);
  1639. begin
  1640. inherited ppuwrite(ppufile);
  1641. { write mangledname rather than _mangledname in case the mangledname
  1642. has not been calculated yet (can happen in case only the
  1643. mangledbasename has been set) }
  1644. if vo_has_mangledname in varoptions then
  1645. {$ifdef symansistr}
  1646. ppufile.putansistring(mangledname);
  1647. {$else symansistr}
  1648. ppufile.putstring(mangledname);
  1649. {$endif symansistr}
  1650. if vo_has_section in varoptions then
  1651. ppufile.putansistring(section);
  1652. writeentry(ppufile,ibstaticvarsym);
  1653. end;
  1654. function tstaticvarsym.mangledname:TSymStr;
  1655. var
  1656. usename,
  1657. prefix : TSymStr;
  1658. begin
  1659. {$ifdef symansistr}
  1660. if _mangledname='' then
  1661. {$else symansistr}
  1662. if not assigned(_mangledname) then
  1663. {$endif symansistr}
  1664. begin
  1665. if (vo_is_typed_const in varoptions) then
  1666. prefix:='TC'
  1667. else
  1668. prefix:='U';
  1669. {$ifdef symansistr}
  1670. if _mangledbasename='' then
  1671. usename:=name
  1672. else
  1673. usename:=_mangledbasename;
  1674. _mangledname:=make_mangledname(prefix,owner,usename);
  1675. {$else symansistr}
  1676. if not assigned(_mangledbasename) then
  1677. usename:=name
  1678. else
  1679. usename:=_mangledbasename^;
  1680. _mangledname:=stringdup(make_mangledname(prefix,owner,usename));
  1681. {$endif symansistr}
  1682. end;
  1683. {$ifdef symansistr}
  1684. result:=_mangledname;
  1685. {$else symansistr}
  1686. result:=_mangledname^;
  1687. {$endif symansistr}
  1688. end;
  1689. procedure tstaticvarsym.set_mangledbasename(const s: TSymStr);
  1690. begin
  1691. {$ifdef symansistr}
  1692. _mangledbasename:=s;
  1693. _mangledname:='';
  1694. {$else symansistr}
  1695. stringdispose(_mangledname);
  1696. stringdispose(_mangledbasename);
  1697. _mangledbasename:=stringdup(s);
  1698. {$endif symansistr}
  1699. include(varoptions,vo_has_mangledname);
  1700. end;
  1701. function tstaticvarsym.mangledbasename: TSymStr;
  1702. begin
  1703. {$ifdef symansistr}
  1704. result:=_mangledbasename;
  1705. {$else symansistr}
  1706. if assigned(_mangledbasename) then
  1707. result:=_mangledbasename^
  1708. else
  1709. result:='';
  1710. {$endif symansistr}
  1711. end;
  1712. procedure tstaticvarsym.set_mangledname(const s:TSymStr);
  1713. begin
  1714. {$ifdef symansistr}
  1715. _mangledname:=s;
  1716. {$else symansistr}
  1717. stringdispose(_mangledname);
  1718. _mangledname:=stringdup(s);
  1719. {$endif symansistr}
  1720. include(varoptions,vo_has_mangledname);
  1721. end;
  1722. procedure tstaticvarsym.set_raw_mangledname(const s: TSymStr);
  1723. begin
  1724. {$ifndef symansistr}
  1725. stringdispose(_mangledname);
  1726. _mangledname:=stringdup(s);
  1727. {$else}
  1728. _mangledname:=s;
  1729. {$endif}
  1730. include(varoptions,vo_has_mangledname);
  1731. end;
  1732. {****************************************************************************
  1733. TLOCALVARSYM
  1734. ****************************************************************************}
  1735. constructor tlocalvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1736. begin
  1737. inherited create(localvarsym,n,vsp,def,vopts);
  1738. end;
  1739. constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
  1740. begin
  1741. inherited ppuload(localvarsym,ppufile);
  1742. ppuload_platform(ppufile);
  1743. end;
  1744. procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1745. begin
  1746. inherited ppuwrite(ppufile);
  1747. writeentry(ppufile,iblocalvarsym);
  1748. end;
  1749. {****************************************************************************
  1750. TPARAVARSYM
  1751. ****************************************************************************}
  1752. constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
  1753. begin
  1754. inherited create(paravarsym,n,vsp,def,vopts);
  1755. if (vsp in [vs_var,vs_value,vs_const,vs_constref]) and
  1756. not(vo_is_funcret in vopts) then
  1757. varstate := vs_initialised;
  1758. paranr:=nr;
  1759. paraloc[calleeside].init;
  1760. paraloc[callerside].init;
  1761. end;
  1762. destructor tparavarsym.destroy;
  1763. begin
  1764. paraloc[calleeside].done;
  1765. paraloc[callerside].done;
  1766. inherited destroy;
  1767. end;
  1768. constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
  1769. var
  1770. b : byte;
  1771. begin
  1772. inherited ppuload(paravarsym,ppufile);
  1773. paranr:=ppufile.getword;
  1774. univpara:=boolean(ppufile.getbyte);
  1775. { The var state of parameter symbols is fixed after writing them so
  1776. we write them to the unit file.
  1777. This enables constant folding for inline procedures loaded from units
  1778. }
  1779. varstate:=tvarstate(ppufile.getbyte);
  1780. { read usage info }
  1781. refs:=ppufile.getbyte;
  1782. paraloc[calleeside].init;
  1783. paraloc[callerside].init;
  1784. if vo_has_explicit_paraloc in varoptions then
  1785. begin
  1786. paraloc[callerside].alignment:=ppufile.getbyte;
  1787. b:=ppufile.getbyte;
  1788. if b<>sizeof(paraloc[callerside].location^) then
  1789. internalerror(200411154);
  1790. ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));
  1791. paraloc[callerside].size:=paraloc[callerside].location^.size;
  1792. paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];
  1793. end;
  1794. ppuload_platform(ppufile);
  1795. end;
  1796. procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
  1797. var
  1798. oldintfcrc : boolean;
  1799. begin
  1800. inherited ppuwrite(ppufile);
  1801. ppufile.putword(paranr);
  1802. ppufile.putbyte(byte(univpara));
  1803. { The var state of parameter symbols is fixed after writing them so
  1804. we write them to the unit file.
  1805. This enables constant folding for inline procedures loaded from units
  1806. }
  1807. oldintfcrc:=ppufile.do_crc;
  1808. ppufile.do_crc:=false;
  1809. ppufile.putbyte(ord(varstate));
  1810. { write also info about the usage of parameters,
  1811. the absolute usage does not matter }
  1812. ppufile.putbyte(min(1,refs));
  1813. ppufile.do_crc:=oldintfcrc;
  1814. if vo_has_explicit_paraloc in varoptions then
  1815. begin
  1816. paraloc[callerside].check_simple_location;
  1817. ppufile.putbyte(sizeof(paraloc[callerside].alignment));
  1818. ppufile.putbyte(sizeof(paraloc[callerside].location^));
  1819. ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));
  1820. end;
  1821. writeentry(ppufile,ibparavarsym);
  1822. end;
  1823. function tparavarsym.needs_finalization:boolean;
  1824. begin
  1825. result:=(varspez=vs_value) and
  1826. (is_managed_type(vardef) or
  1827. (
  1828. (not (tabstractprocdef(owner.defowner).proccalloption in cdecl_pocalls)) and
  1829. (not paramanager.use_stackalloc) and
  1830. (is_open_array(vardef) or is_array_of_const(vardef))
  1831. )
  1832. );
  1833. end;
  1834. {****************************************************************************
  1835. TABSOLUTEVARSYM
  1836. ****************************************************************************}
  1837. constructor tabsolutevarsym.create(const n : string;def:tdef);
  1838. begin
  1839. inherited create(absolutevarsym,n,vs_value,def,[]);
  1840. ref:=nil;
  1841. end;
  1842. constructor tabsolutevarsym.create_ref(const n : string;def:tdef;_ref:tpropaccesslist);
  1843. begin
  1844. inherited create(absolutevarsym,n,vs_value,def,[]);
  1845. ref:=_ref;
  1846. end;
  1847. destructor tabsolutevarsym.destroy;
  1848. begin
  1849. if assigned(ref) then
  1850. ref.free;
  1851. inherited destroy;
  1852. end;
  1853. constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
  1854. begin
  1855. inherited ppuload(absolutevarsym,ppufile);
  1856. ref:=nil;
  1857. asmname:=nil;
  1858. abstyp:=absolutetyp(ppufile.getbyte);
  1859. case abstyp of
  1860. tovar :
  1861. ref:=ppufile.getpropaccesslist;
  1862. toasm :
  1863. asmname:=stringdup(ppufile.getstring);
  1864. toaddr :
  1865. addroffset:=ppufile.getaword;
  1866. end;
  1867. ppuload_platform(ppufile);
  1868. end;
  1869. procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
  1870. begin
  1871. inherited ppuwrite(ppufile);
  1872. ppufile.putbyte(byte(abstyp));
  1873. case abstyp of
  1874. tovar :
  1875. ppufile.putpropaccesslist(ref);
  1876. toasm :
  1877. ppufile.putstring(asmname^);
  1878. toaddr :
  1879. ppufile.putaword(addroffset);
  1880. end;
  1881. writeentry(ppufile,ibabsolutevarsym);
  1882. end;
  1883. procedure tabsolutevarsym.buildderef;
  1884. begin
  1885. inherited buildderef;
  1886. if (abstyp=tovar) then
  1887. ref.buildderef;
  1888. end;
  1889. procedure tabsolutevarsym.deref;
  1890. begin
  1891. inherited deref;
  1892. { own absolute deref }
  1893. if (abstyp=tovar) then
  1894. ref.resolve;
  1895. end;
  1896. function tabsolutevarsym.mangledname : TSymStr;
  1897. begin
  1898. case abstyp of
  1899. toasm :
  1900. mangledname:=asmname^;
  1901. toaddr :
  1902. mangledname:='$'+tostr(addroffset);
  1903. else
  1904. internalerror(200411062);
  1905. end;
  1906. end;
  1907. {****************************************************************************
  1908. TCONSTSYM
  1909. ****************************************************************************}
  1910. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
  1911. begin
  1912. inherited create(constsym,n);
  1913. fillchar(value, sizeof(value), #0);
  1914. consttyp:=t;
  1915. value.valueord:=v;
  1916. constdef:=def;
  1917. end;
  1918. constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
  1919. begin
  1920. inherited create(constsym,n);
  1921. fillchar(value, sizeof(value), #0);
  1922. consttyp:=t;
  1923. value.valueordptr:=v;
  1924. constdef:=def;
  1925. end;
  1926. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
  1927. begin
  1928. inherited create(constsym,n);
  1929. fillchar(value, sizeof(value), #0);
  1930. consttyp:=t;
  1931. value.valueptr:=v;
  1932. constdef:=def;
  1933. end;
  1934. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def: tdef);
  1935. begin
  1936. inherited create(constsym,n);
  1937. fillchar(value, sizeof(value), #0);
  1938. consttyp:=t;
  1939. value.valueptr:=str;
  1940. if assigned(def) then
  1941. constdef:=def
  1942. else
  1943. constdef:=getarraydef(cansichartype,l);
  1944. value.len:=l;
  1945. end;
  1946. constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  1947. begin
  1948. inherited create(constsym,n);
  1949. fillchar(value, sizeof(value), #0);
  1950. consttyp:=t;
  1951. pcompilerwidestring(value.valueptr):=pw;
  1952. constdef:=getarraydef(cwidechartype,getlengthwidestring(pw));
  1953. value.len:=getlengthwidestring(pw);
  1954. end;
  1955. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1956. var
  1957. pd : pbestreal;
  1958. ps : pnormalset;
  1959. pc : pchar;
  1960. pw : pcompilerwidestring;
  1961. i : longint;
  1962. begin
  1963. inherited ppuload(constsym,ppufile);
  1964. constdef:=nil;
  1965. consttyp:=tconsttyp(ppufile.getbyte);
  1966. fillchar(value, sizeof(value), #0);
  1967. case consttyp of
  1968. constord :
  1969. begin
  1970. ppufile.getderef(constdefderef);
  1971. value.valueord:=ppufile.getexprint;
  1972. end;
  1973. constpointer :
  1974. begin
  1975. ppufile.getderef(constdefderef);
  1976. value.valueordptr:=ppufile.getptruint;
  1977. end;
  1978. constwstring :
  1979. begin
  1980. initwidestring(pw);
  1981. setlengthwidestring(pw,ppufile.getlongint);
  1982. { don't use getdata, because the compilerwidechars may have to
  1983. be byteswapped
  1984. }
  1985. {$if sizeof(tcompilerwidechar) = 2}
  1986. for i:=0 to pw^.len-1 do
  1987. pw^.data[i]:=ppufile.getword;
  1988. {$elseif sizeof(tcompilerwidechar) = 4}
  1989. for i:=0 to pw^.len-1 do
  1990. pw^.data[i]:=cardinal(ppufile.getlongint);
  1991. {$else}
  1992. {$error Unsupported tcompilerwidechar size}
  1993. {$endif}
  1994. pcompilerwidestring(value.valueptr):=pw;
  1995. end;
  1996. conststring,
  1997. constresourcestring :
  1998. begin
  1999. value.len:=ppufile.getlongint;
  2000. getmem(pc,value.len+1);
  2001. ppufile.getdata(pc^,value.len);
  2002. pc[value.len]:=#0;
  2003. value.valueptr:=pc;
  2004. end;
  2005. constreal :
  2006. begin
  2007. ppufile.getderef(constdefderef);
  2008. new(pd);
  2009. pd^:=ppufile.getreal;
  2010. value.valueptr:=pd;
  2011. end;
  2012. constset :
  2013. begin
  2014. ppufile.getderef(constdefderef);
  2015. new(ps);
  2016. ppufile.getnormalset(ps^);
  2017. value.valueptr:=ps;
  2018. end;
  2019. constguid :
  2020. begin
  2021. new(pguid(value.valueptr));
  2022. ppufile.getdata(value.valueptr^,sizeof(tguid));
  2023. end;
  2024. constnil : ;
  2025. else
  2026. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  2027. end;
  2028. ppuload_platform(ppufile);
  2029. end;
  2030. destructor tconstsym.destroy;
  2031. begin
  2032. case consttyp of
  2033. conststring,
  2034. constresourcestring :
  2035. freemem(pchar(value.valueptr),value.len+1);
  2036. constwstring :
  2037. donewidestring(pcompilerwidestring(value.valueptr));
  2038. constreal :
  2039. dispose(pbestreal(value.valueptr));
  2040. constset :
  2041. dispose(pnormalset(value.valueptr));
  2042. constguid :
  2043. dispose(pguid(value.valueptr));
  2044. end;
  2045. inherited destroy;
  2046. end;
  2047. procedure tconstsym.buildderef;
  2048. begin
  2049. if consttyp in [constord,constreal,constpointer,constset] then
  2050. constdefderef.build(constdef);
  2051. end;
  2052. procedure tconstsym.deref;
  2053. begin
  2054. if consttyp in [constord,constreal,constpointer,constset] then
  2055. constdef:=tdef(constdefderef.resolve);
  2056. end;
  2057. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  2058. begin
  2059. inherited ppuwrite(ppufile);
  2060. ppufile.putbyte(byte(consttyp));
  2061. case consttyp of
  2062. constnil : ;
  2063. constord :
  2064. begin
  2065. ppufile.putderef(constdefderef);
  2066. ppufile.putexprint(value.valueord);
  2067. end;
  2068. constpointer :
  2069. begin
  2070. ppufile.putderef(constdefderef);
  2071. ppufile.putptruint(value.valueordptr);
  2072. end;
  2073. constwstring :
  2074. begin
  2075. ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
  2076. ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
  2077. end;
  2078. conststring,
  2079. constresourcestring :
  2080. begin
  2081. ppufile.putlongint(value.len);
  2082. ppufile.putdata(pchar(value.valueptr)^,value.len);
  2083. end;
  2084. constreal :
  2085. begin
  2086. ppufile.putderef(constdefderef);
  2087. ppufile.putreal(pbestreal(value.valueptr)^);
  2088. end;
  2089. constset :
  2090. begin
  2091. ppufile.putderef(constdefderef);
  2092. ppufile.putnormalset(value.valueptr^);
  2093. end;
  2094. constguid :
  2095. ppufile.putdata(value.valueptr^,sizeof(tguid));
  2096. else
  2097. internalerror(13);
  2098. end;
  2099. writeentry(ppufile,ibconstsym);
  2100. end;
  2101. {****************************************************************************
  2102. TENUMSYM
  2103. ****************************************************************************}
  2104. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  2105. begin
  2106. inherited create(enumsym,n);
  2107. definition:=def;
  2108. value:=v;
  2109. end;
  2110. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  2111. begin
  2112. inherited ppuload(enumsym,ppufile);
  2113. ppufile.getderef(definitionderef);
  2114. value:=ppufile.getlongint;
  2115. ppuload_platform(ppufile);
  2116. end;
  2117. procedure tenumsym.buildderef;
  2118. begin
  2119. definitionderef.build(definition);
  2120. end;
  2121. procedure tenumsym.deref;
  2122. begin
  2123. definition:=tenumdef(definitionderef.resolve);
  2124. end;
  2125. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  2126. begin
  2127. inherited ppuwrite(ppufile);
  2128. ppufile.putderef(definitionderef);
  2129. ppufile.putlongint(value);
  2130. writeentry(ppufile,ibenumsym);
  2131. end;
  2132. {****************************************************************************
  2133. TTYPESYM
  2134. ****************************************************************************}
  2135. constructor ttypesym.create(const n : string;def:tdef);
  2136. begin
  2137. inherited create(typesym,n);
  2138. typedef:=def;
  2139. { register the typesym for the definition }
  2140. if assigned(typedef) and
  2141. (typedef.typ<>errordef) and
  2142. not(assigned(typedef.typesym)) then
  2143. typedef.typesym:=self;
  2144. end;
  2145. destructor ttypesym.destroy;
  2146. begin
  2147. inherited destroy;
  2148. end;
  2149. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  2150. begin
  2151. inherited ppuload(typesym,ppufile);
  2152. ppufile.getderef(typedefderef);
  2153. fprettyname:=ppufile.getansistring;
  2154. ppuload_platform(ppufile);
  2155. end;
  2156. procedure ttypesym.buildderef;
  2157. begin
  2158. typedefderef.build(typedef);
  2159. end;
  2160. procedure ttypesym.deref;
  2161. begin
  2162. typedef:=tdef(typedefderef.resolve);
  2163. end;
  2164. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  2165. begin
  2166. inherited ppuwrite(ppufile);
  2167. ppufile.putderef(typedefderef);
  2168. ppufile.putansistring(fprettyname);
  2169. writeentry(ppufile,ibtypesym);
  2170. end;
  2171. function ttypesym.prettyname : string;
  2172. begin
  2173. if fprettyname<>'' then
  2174. result:=fprettyname
  2175. else
  2176. result:=inherited prettyname;
  2177. end;
  2178. {****************************************************************************
  2179. TSYSSYM
  2180. ****************************************************************************}
  2181. constructor tsyssym.create(const n : string;l : longint);
  2182. begin
  2183. inherited create(syssym,n);
  2184. number:=l;
  2185. end;
  2186. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  2187. begin
  2188. inherited ppuload(syssym,ppufile);
  2189. number:=ppufile.getlongint;
  2190. ppuload_platform(ppufile);
  2191. end;
  2192. destructor tsyssym.destroy;
  2193. begin
  2194. inherited destroy;
  2195. end;
  2196. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  2197. begin
  2198. inherited ppuwrite(ppufile);
  2199. ppufile.putlongint(number);
  2200. writeentry(ppufile,ibsyssym);
  2201. end;
  2202. {*****************************************************************************
  2203. TMacro
  2204. *****************************************************************************}
  2205. constructor tmacro.create(const n : string);
  2206. begin
  2207. inherited create(macrosym,n);
  2208. owner:=nil;
  2209. defined:=false;
  2210. is_used:=false;
  2211. is_compiler_var:=false;
  2212. buftext:=nil;
  2213. buflen:=0;
  2214. end;
  2215. constructor tmacro.ppuload(ppufile:tcompilerppufile);
  2216. begin
  2217. inherited ppuload(macrosym,ppufile);
  2218. defined:=boolean(ppufile.getbyte);
  2219. is_compiler_var:=boolean(ppufile.getbyte);
  2220. is_used:=false;
  2221. buflen:= ppufile.getlongint;
  2222. if buflen > 0 then
  2223. begin
  2224. getmem(buftext, buflen);
  2225. ppufile.getdata(buftext^, buflen)
  2226. end
  2227. else
  2228. buftext:=nil;
  2229. end;
  2230. destructor tmacro.destroy;
  2231. begin
  2232. if assigned(buftext) then
  2233. freemem(buftext);
  2234. inherited destroy;
  2235. end;
  2236. procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
  2237. begin
  2238. inherited ppuwrite(ppufile);
  2239. ppufile.putbyte(byte(defined));
  2240. ppufile.putbyte(byte(is_compiler_var));
  2241. ppufile.putlongint(buflen);
  2242. if buflen > 0 then
  2243. ppufile.putdata(buftext^,buflen);
  2244. writeentry(ppufile,ibmacrosym);
  2245. end;
  2246. function tmacro.GetCopy:tmacro;
  2247. var
  2248. p : tmacro;
  2249. begin
  2250. p:=tmacro.create(realname);
  2251. p.defined:=defined;
  2252. p.is_used:=is_used;
  2253. p.is_compiler_var:=is_compiler_var;
  2254. p.buflen:=buflen;
  2255. if assigned(buftext) then
  2256. begin
  2257. getmem(p.buftext,buflen);
  2258. move(buftext^,p.buftext^,buflen);
  2259. end;
  2260. Result:=p;
  2261. end;
  2262. end.