symsym.pas 65 KB

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