symsym.pas 81 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  4. Implementation for the symbols types of the symtable
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit symsym;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,
  24. { target }
  25. cpuinfo,globtype,
  26. { symtable }
  27. symconst,symbase,symtype,symdef,
  28. { ppu }
  29. ppu,symppu,
  30. {$ifdef var_notification}
  31. cclasses,symnot,
  32. {$endif}
  33. { aasm }
  34. aasmbase,aasmtai,cpubase,
  35. globals
  36. ;
  37. type
  38. {************************************************
  39. TSym
  40. ************************************************}
  41. { this object is the base for all symbol objects }
  42. tstoredsym = class(tsym)
  43. protected
  44. _mangledname : pstring;
  45. public
  46. refs : longint;
  47. lastref,
  48. defref,
  49. lastwritten : tref;
  50. refcount : longint;
  51. {$ifdef GDB}
  52. isstabwritten : boolean;
  53. {$endif GDB}
  54. constructor create(const n : string);
  55. constructor loadsym(ppufile:tcompilerppufile);
  56. destructor destroy;override;
  57. procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
  58. procedure writesym(ppufile:tcompilerppufile);
  59. procedure deref;override;
  60. {$ifdef GDB}
  61. function stabstring : pchar;virtual;
  62. procedure concatstabto(asmlist : taasmoutput);virtual;
  63. {$endif GDB}
  64. procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
  65. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
  66. function is_visible_for_proc(currprocdef:tprocdef):boolean;
  67. function is_visible_for_object(currobjdef:tobjectdef):boolean;
  68. function mangledname : string;
  69. procedure generate_mangledname;virtual;abstract;
  70. end;
  71. tlabelsym = class(tstoredsym)
  72. lab : tasmlabel;
  73. used,
  74. defined : boolean;
  75. code : pointer; { should be tnode }
  76. constructor create(const n : string; l : tasmlabel);
  77. destructor destroy;override;
  78. constructor ppuload(ppufile:tcompilerppufile);
  79. procedure generate_mangledname;override;
  80. procedure ppuwrite(ppufile:tcompilerppufile);override;
  81. end;
  82. tunitsym = class(tstoredsym)
  83. unitsymtable : tsymtable;
  84. prevsym : tunitsym;
  85. constructor create(const n : string;ref : tsymtable);
  86. constructor ppuload(ppufile:tcompilerppufile);
  87. destructor destroy;override;
  88. procedure ppuwrite(ppufile:tcompilerppufile);override;
  89. procedure restoreunitsym;
  90. {$ifdef GDB}
  91. procedure concatstabto(asmlist : taasmoutput);override;
  92. {$endif GDB}
  93. end;
  94. terrorsym = class(tstoredsym)
  95. constructor create;
  96. end;
  97. Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
  98. tprocsym = class(tstoredsym)
  99. protected
  100. pdlistfirst,
  101. pdlistlast : pprocdeflist; { linked list of overloaded procdefs }
  102. function getprocdef(nr:cardinal):Tprocdef;
  103. public
  104. procdef_count : byte;
  105. is_global : boolean;
  106. overloadchecked : boolean;
  107. overloadcount : word; { amount of overloaded functions in this module }
  108. property procdef[nr:cardinal]:Tprocdef read getprocdef;
  109. constructor create(const n : string);
  110. constructor ppuload(ppufile:tcompilerppufile);
  111. destructor destroy;override;
  112. { writes all declarations except the specified one }
  113. procedure write_parameter_lists(skipdef:tprocdef);
  114. { tests, if all procedures definitions are defined and not }
  115. { only forward }
  116. procedure check_forward;
  117. procedure unchain_overload;
  118. procedure ppuwrite(ppufile:tcompilerppufile);override;
  119. procedure deref;override;
  120. procedure addprocdef(p:tprocdef);
  121. procedure add_para_match_to(Aprocsym:Tprocsym);
  122. procedure concat_procdefs_to(s:Tprocsym);
  123. procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  124. function first_procdef:Tprocdef;
  125. function last_procdef:Tprocdef;
  126. function search_procdef_nopara_boolret:Tprocdef;
  127. function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  128. function search_procdef_bypara(params:Tparalinkedlist;
  129. allowconvert,
  130. allowdefault:boolean):Tprocdef;
  131. function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  132. function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
  133. function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
  134. function search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
  135. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  136. {$ifdef GDB}
  137. function stabstring : pchar;override;
  138. procedure concatstabto(asmlist : taasmoutput);override;
  139. {$endif GDB}
  140. end;
  141. ttypesym = class(tstoredsym)
  142. restype : ttype;
  143. {$ifdef GDB}
  144. isusedinstab : boolean;
  145. {$endif GDB}
  146. constructor create(const n : string;const tt : ttype);
  147. constructor ppuload(ppufile:tcompilerppufile);
  148. procedure ppuwrite(ppufile:tcompilerppufile);override;
  149. procedure deref;override;
  150. function gettypedef:tdef;override;
  151. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  152. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  153. {$ifdef GDB}
  154. function stabstring : pchar;override;
  155. procedure concatstabto(asmlist : taasmoutput);override;
  156. {$endif GDB}
  157. end;
  158. tvarsym = class(tstoredsym)
  159. address : longint;
  160. localvarsym : tvarsym;
  161. vartype : ttype;
  162. varoptions : tvaroptions;
  163. reg : tregister; { if reg<>R_NO, then the variable is an register variable }
  164. varspez : tvarspez; { sets the type of access }
  165. varstate : tvarstate;
  166. paraitem : tparaitem;
  167. {$ifdef var_notification}
  168. notifications : Tlinkedlist;
  169. {$endif}
  170. constructor create(const n : string;const tt : ttype);
  171. constructor create_dll(const n : string;const tt : ttype);
  172. constructor create_C(const n,mangled : string;const tt : ttype);
  173. constructor ppuload(ppufile:tcompilerppufile);
  174. destructor destroy;override;
  175. procedure ppuwrite(ppufile:tcompilerppufile);override;
  176. procedure deref;override;
  177. procedure generate_mangledname;override;
  178. procedure set_mangledname(const s:string);
  179. function getsize : longint;
  180. function getvaluesize : longint;
  181. {$ifdef var_notification}
  182. function register_notification(flags:Tnotification_flags;
  183. callback:Tnotification_callback):cardinal;
  184. {$endif}
  185. {$ifdef GDB}
  186. function stabstring : pchar;override;
  187. procedure concatstabto(asmlist : taasmoutput);override;
  188. {$endif GDB}
  189. end;
  190. tpropertysym = class(tstoredsym)
  191. propoptions : tpropertyoptions;
  192. propoverriden : tpropertysym;
  193. proptype,
  194. indextype : ttype;
  195. index,
  196. default : longint;
  197. readaccess,
  198. writeaccess,
  199. storedaccess : tsymlist;
  200. constructor create(const n : string);
  201. destructor destroy;override;
  202. constructor ppuload(ppufile:tcompilerppufile);
  203. function getsize : longint;
  204. procedure ppuwrite(ppufile:tcompilerppufile);override;
  205. function gettypedef:tdef;override;
  206. procedure deref;override;
  207. procedure dooverride(overriden:tpropertysym);
  208. {$ifdef GDB}
  209. function stabstring : pchar;override;
  210. procedure concatstabto(asmlist : taasmoutput);override;
  211. {$endif GDB}
  212. end;
  213. tfuncretsym = class(tstoredsym)
  214. returntype : ttype;
  215. address : longint;
  216. funcretstate : tvarstate;
  217. constructor create(const n : string;const tt : ttype);
  218. constructor ppuload(ppufile:tcompilerppufile);
  219. destructor destroy;override;
  220. procedure ppuwrite(ppufile:tcompilerppufile);override;
  221. procedure deref;override;
  222. {$ifdef GDB}
  223. procedure concatstabto(asmlist : taasmoutput);override;
  224. {$endif GDB}
  225. end;
  226. tabsolutesym = class(tvarsym)
  227. abstyp : absolutetyp;
  228. absseg : boolean;
  229. ref : tstoredsym;
  230. asmname : pstring;
  231. constructor create(const n : string;const tt : ttype);
  232. constructor ppuload(ppufile:tcompilerppufile);
  233. procedure deref;override;
  234. function mangledname : string;
  235. procedure ppuwrite(ppufile:tcompilerppufile);override;
  236. {$ifdef GDB}
  237. procedure concatstabto(asmlist : taasmoutput);override;
  238. {$endif GDB}
  239. end;
  240. ttypedconstsym = class(tstoredsym)
  241. typedconsttype : ttype;
  242. is_writable : boolean;
  243. constructor create(const n : string;p : tdef;writable : boolean);
  244. constructor createtype(const n : string;const tt : ttype;writable : boolean);
  245. constructor ppuload(ppufile:tcompilerppufile);
  246. destructor destroy;override;
  247. procedure generate_mangledname;override;
  248. procedure ppuwrite(ppufile:tcompilerppufile);override;
  249. procedure deref;override;
  250. function getsize:longint;
  251. {$ifdef GDB}
  252. function stabstring : pchar;override;
  253. {$endif GDB}
  254. end;
  255. tconstvalue = record
  256. case integer of
  257. 0: (valueord : tconstexprint);
  258. 1: (valueordptr : tconstptruint);
  259. 2: (valueptr : pointer; len : longint);
  260. end;
  261. tconstsym = class(tstoredsym)
  262. consttype : ttype;
  263. consttyp : tconsttyp;
  264. value : tconstvalue;
  265. resstrindex : longint; { needed for resource strings }
  266. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
  267. constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  268. constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  269. constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
  270. constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  271. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  272. constructor ppuload(ppufile:tcompilerppufile);
  273. destructor destroy;override;
  274. function mangledname : string;
  275. procedure deref;override;
  276. procedure ppuwrite(ppufile:tcompilerppufile);override;
  277. {$ifdef GDB}
  278. function stabstring : pchar;override;
  279. procedure concatstabto(asmlist : taasmoutput);override;
  280. {$endif GDB}
  281. end;
  282. tenumsym = class(tstoredsym)
  283. value : longint;
  284. definition : tenumdef;
  285. nextenum : tenumsym;
  286. constructor create(const n : string;def : tenumdef;v : longint);
  287. constructor ppuload(ppufile:tcompilerppufile);
  288. procedure ppuwrite(ppufile:tcompilerppufile);override;
  289. procedure deref;override;
  290. procedure order;
  291. {$ifdef GDB}
  292. procedure concatstabto(asmlist : taasmoutput);override;
  293. {$endif GDB}
  294. end;
  295. tsyssym = class(tstoredsym)
  296. number : longint;
  297. constructor create(const n : string;l : longint);
  298. constructor ppuload(ppufile:tcompilerppufile);
  299. destructor destroy;override;
  300. procedure ppuwrite(ppufile:tcompilerppufile);override;
  301. {$ifdef GDB}
  302. procedure concatstabto(asmlist : taasmoutput);override;
  303. {$endif GDB}
  304. end;
  305. { compiler generated symbol to point to rtti and init/finalize tables }
  306. trttisym = class(tstoredsym)
  307. lab : tasmsymbol;
  308. rttityp : trttitype;
  309. constructor create(const n:string;rt:trttitype);
  310. constructor ppuload(ppufile:tcompilerppufile);
  311. procedure ppuwrite(ppufile:tcompilerppufile);override;
  312. function mangledname:string;
  313. function get_label:tasmsymbol;
  314. end;
  315. { register variables }
  316. pregvarinfo = ^tregvarinfo;
  317. tregvarinfo = record
  318. regvars : array[1..maxvarregs] of tvarsym;
  319. regvars_para : array[1..maxvarregs] of boolean;
  320. regvars_refs : array[1..maxvarregs] of longint;
  321. fpuregvars : array[1..maxfpuvarregs] of tvarsym;
  322. fpuregvars_para : array[1..maxfpuvarregs] of boolean;
  323. fpuregvars_refs : array[1..maxfpuvarregs] of longint;
  324. end;
  325. var
  326. aktprocsym : tprocsym; { pointer to the symbol for the
  327. currently be parsed procedure }
  328. aktprocdef : tprocdef;
  329. aktcallprocdef : tabstractprocdef; { pointer to the definition of the
  330. currently called procedure,
  331. only set/unset in ncal }
  332. generrorsym : tsym;
  333. otsym : tvarsym;
  334. const
  335. current_object_option : tsymoptions = [sp_public];
  336. { rtti and init/final }
  337. procedure generate_rtti(p:tsym);
  338. procedure generate_inittable(p:tsym);
  339. implementation
  340. uses
  341. {$ifdef Delphi}
  342. sysutils,
  343. {$else Delphi}
  344. strings,
  345. {$endif Delphi}
  346. { global }
  347. verbose,
  348. { target }
  349. systems,
  350. { symtable }
  351. symtable,defutil,defcmp,
  352. {$ifdef GDB}
  353. gdb,
  354. {$endif GDB}
  355. { tree }
  356. node,
  357. { aasm }
  358. aasmcpu,
  359. { module }
  360. fmodule,
  361. { codegen }
  362. paramgr,cgbase,cresstr
  363. ;
  364. {****************************************************************************
  365. Helpers
  366. ****************************************************************************}
  367. {****************************************************************************
  368. TSYM (base for all symtypes)
  369. ****************************************************************************}
  370. constructor tstoredsym.create(const n : string);
  371. begin
  372. inherited create(n);
  373. symoptions:=current_object_option;
  374. {$ifdef GDB}
  375. isstabwritten := false;
  376. {$endif GDB}
  377. fileinfo:=akttokenpos;
  378. defref:=nil;
  379. refs:=0;
  380. lastwritten:=nil;
  381. refcount:=0;
  382. if (cs_browser in aktmoduleswitches) and make_ref then
  383. begin
  384. defref:=tref.create(defref,@akttokenpos);
  385. inc(refcount);
  386. end;
  387. lastref:=defref;
  388. _mangledname:=nil;
  389. end;
  390. constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
  391. var
  392. s : string;
  393. nr : word;
  394. begin
  395. nr:=ppufile.getword;
  396. s:=ppufile.getstring;
  397. inherited create(s);
  398. { force the correct indexnr. must be after create! }
  399. indexnr:=nr;
  400. ppufile.getsmallset(symoptions);
  401. ppufile.getposinfo(fileinfo);
  402. lastref:=nil;
  403. defref:=nil;
  404. refs:=0;
  405. lastwritten:=nil;
  406. refcount:=0;
  407. _mangledname:=nil;
  408. {$ifdef GDB}
  409. isstabwritten := false;
  410. {$endif GDB}
  411. end;
  412. procedure tstoredsym.deref;
  413. begin
  414. end;
  415. procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
  416. var
  417. pos : tfileposinfo;
  418. move_last : boolean;
  419. begin
  420. move_last:=lastwritten=lastref;
  421. while (not ppufile.endofentry) do
  422. begin
  423. ppufile.getposinfo(pos);
  424. inc(refcount);
  425. lastref:=tref.create(lastref,@pos);
  426. lastref.is_written:=true;
  427. if refcount=1 then
  428. defref:=lastref;
  429. end;
  430. if move_last then
  431. lastwritten:=lastref;
  432. end;
  433. { big problem here :
  434. wrong refs were written because of
  435. interface parsing of other units PM
  436. moduleindex must be checked !! }
  437. function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  438. var
  439. ref : tref;
  440. symref_written,move_last : boolean;
  441. begin
  442. write_references:=false;
  443. if lastwritten=lastref then
  444. exit;
  445. { should we update lastref }
  446. move_last:=true;
  447. symref_written:=false;
  448. { write symbol refs }
  449. if assigned(lastwritten) then
  450. ref:=lastwritten
  451. else
  452. ref:=defref;
  453. while assigned(ref) do
  454. begin
  455. if ref.moduleindex=current_module.unit_index then
  456. begin
  457. { write address to this symbol }
  458. if not symref_written then
  459. begin
  460. ppufile.putderef(self);
  461. symref_written:=true;
  462. end;
  463. ppufile.putposinfo(ref.posinfo);
  464. ref.is_written:=true;
  465. if move_last then
  466. lastwritten:=ref;
  467. end
  468. else if not ref.is_written then
  469. move_last:=false
  470. else if move_last then
  471. lastwritten:=ref;
  472. ref:=ref.nextref;
  473. end;
  474. if symref_written then
  475. ppufile.writeentry(ibsymref);
  476. write_references:=symref_written;
  477. end;
  478. destructor tstoredsym.destroy;
  479. begin
  480. if assigned(_mangledname) then
  481. begin
  482. {$ifdef MEMDEBUG}
  483. memmanglednames.start;
  484. {$endif MEMDEBUG}
  485. stringdispose(_mangledname);
  486. {$ifdef MEMDEBUG}
  487. memmanglednames.stop;
  488. {$endif MEMDEBUG}
  489. end;
  490. if assigned(defref) then
  491. begin
  492. {$ifdef MEMDEBUG}
  493. membrowser.start;
  494. {$endif MEMDEBUG}
  495. defref.freechain;
  496. defref.free;
  497. {$ifdef MEMDEBUG}
  498. membrowser.stop;
  499. {$endif MEMDEBUG}
  500. end;
  501. inherited destroy;
  502. end;
  503. procedure tstoredsym.writesym(ppufile:tcompilerppufile);
  504. begin
  505. ppufile.putword(indexnr);
  506. ppufile.putstring(_realname^);
  507. ppufile.putsmallset(symoptions);
  508. ppufile.putposinfo(fileinfo);
  509. end;
  510. {$ifdef GDB}
  511. function tstoredsym.stabstring : pchar;
  512. begin
  513. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  514. tostr(fileinfo.line)+',0');
  515. end;
  516. procedure tstoredsym.concatstabto(asmlist : taasmoutput);
  517. var
  518. stab_str : pchar;
  519. begin
  520. if not isstabwritten then
  521. begin
  522. stab_str := stabstring;
  523. { count_dbx(stab_str); moved to GDB.PAS }
  524. asmList.concat(Tai_stabs.Create(stab_str));
  525. isstabwritten:=true;
  526. end;
  527. end;
  528. {$endif GDB}
  529. function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
  530. begin
  531. is_visible_for_proc:=false;
  532. { private symbols are allowed when we are in the same
  533. module as they are defined }
  534. if (sp_private in symoptions) and
  535. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  536. (owner.defowner.owner.unitid<>0) then
  537. exit;
  538. { protected symbols are vissible in the module that defines them and
  539. also visible to related objects }
  540. if (sp_protected in symoptions) and
  541. (
  542. (
  543. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  544. (owner.defowner.owner.unitid<>0)
  545. ) and
  546. not(
  547. assigned(currprocdef) and
  548. assigned(currprocdef._class) and
  549. currprocdef._class.is_related(tobjectdef(owner.defowner))
  550. )
  551. ) then
  552. exit;
  553. is_visible_for_proc:=true;
  554. end;
  555. function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
  556. begin
  557. is_visible_for_object:=false;
  558. { private symbols are allowed when we are in the same
  559. module as they are defined }
  560. if (sp_private in symoptions) and
  561. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  562. (owner.defowner.owner.unitid<>0) then
  563. exit;
  564. { protected symbols are vissible in the module that defines them and
  565. also visible to related objects }
  566. if (sp_protected in symoptions) and
  567. (
  568. (
  569. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  570. (owner.defowner.owner.unitid<>0)
  571. ) and
  572. not(
  573. assigned(currobjdef) and
  574. currobjdef.is_related(tobjectdef(owner.defowner))
  575. )
  576. ) then
  577. exit;
  578. is_visible_for_object:=true;
  579. end;
  580. function tstoredsym.mangledname : string;
  581. begin
  582. if not assigned(_mangledname) then
  583. begin
  584. generate_mangledname;
  585. if not assigned(_mangledname) then
  586. internalerror(200204171);
  587. end;
  588. mangledname:=_mangledname^
  589. end;
  590. {****************************************************************************
  591. TLABELSYM
  592. ****************************************************************************}
  593. constructor tlabelsym.create(const n : string; l : tasmlabel);
  594. begin
  595. inherited create(n);
  596. typ:=labelsym;
  597. lab:=l;
  598. used:=false;
  599. defined:=false;
  600. code:=nil;
  601. end;
  602. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  603. begin
  604. inherited loadsym(ppufile);
  605. typ:=labelsym;
  606. { this is all dummy
  607. it is only used for local browsing }
  608. lab:=nil;
  609. code:=nil;
  610. used:=false;
  611. defined:=true;
  612. end;
  613. destructor tlabelsym.destroy;
  614. begin
  615. inherited destroy;
  616. end;
  617. procedure tlabelsym.generate_mangledname;
  618. begin
  619. _mangledname:=stringdup(lab.name);
  620. end;
  621. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  622. begin
  623. if owner.symtabletype=globalsymtable then
  624. Message(sym_e_ill_label_decl)
  625. else
  626. begin
  627. inherited writesym(ppufile);
  628. ppufile.writeentry(iblabelsym);
  629. end;
  630. end;
  631. {****************************************************************************
  632. TUNITSYM
  633. ****************************************************************************}
  634. constructor tunitsym.create(const n : string;ref : tsymtable);
  635. var
  636. old_make_ref : boolean;
  637. begin
  638. old_make_ref:=make_ref;
  639. make_ref:=false;
  640. inherited create(n);
  641. make_ref:=old_make_ref;
  642. typ:=unitsym;
  643. unitsymtable:=ref;
  644. if assigned(ref) and
  645. (ref.symtabletype=globalsymtable) then
  646. begin
  647. prevsym:=tglobalsymtable(ref).unitsym;
  648. tglobalsymtable(ref).unitsym:=self;
  649. end;
  650. end;
  651. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  652. begin
  653. inherited loadsym(ppufile);
  654. typ:=unitsym;
  655. unitsymtable:=nil;
  656. prevsym:=nil;
  657. refs:=0;
  658. end;
  659. { we need to remove it from the prevsym chain ! }
  660. procedure tunitsym.restoreunitsym;
  661. var pus,ppus : tunitsym;
  662. begin
  663. if assigned(unitsymtable) and
  664. (unitsymtable.symtabletype=globalsymtable) then
  665. begin
  666. ppus:=nil;
  667. pus:=tglobalsymtable(unitsymtable).unitsym;
  668. if pus=self then
  669. tglobalsymtable(unitsymtable).unitsym:=prevsym
  670. else while assigned(pus) do
  671. begin
  672. if pus=self then
  673. begin
  674. ppus.prevsym:=prevsym;
  675. break;
  676. end
  677. else
  678. begin
  679. ppus:=pus;
  680. pus:=ppus.prevsym;
  681. end;
  682. end;
  683. end;
  684. unitsymtable:=nil;
  685. prevsym:=nil;
  686. end;
  687. destructor tunitsym.destroy;
  688. begin
  689. restoreunitsym;
  690. inherited destroy;
  691. end;
  692. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  693. begin
  694. inherited writesym(ppufile);
  695. ppufile.writeentry(ibunitsym);
  696. end;
  697. {$ifdef GDB}
  698. procedure tunitsym.concatstabto(asmlist : taasmoutput);
  699. begin
  700. {Nothing to write to stabs !}
  701. end;
  702. {$endif GDB}
  703. {****************************************************************************
  704. TPROCSYM
  705. ****************************************************************************}
  706. constructor tprocsym.create(const n : string);
  707. begin
  708. inherited create(n);
  709. typ:=procsym;
  710. pdlistfirst:=nil;
  711. pdlistlast:=nil;
  712. owner:=nil;
  713. is_global:=false;
  714. overloadchecked:=false;
  715. overloadcount:=0;
  716. procdef_count:=0;
  717. end;
  718. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  719. var
  720. pd : tprocdef;
  721. begin
  722. inherited loadsym(ppufile);
  723. typ:=procsym;
  724. pdlistfirst:=nil;
  725. pdlistlast:=nil;
  726. procdef_count:=0;
  727. repeat
  728. pd:=tprocdef(ppufile.getderef);
  729. if pd=nil then
  730. break;
  731. addprocdef(pd);
  732. until false;
  733. is_global:=false;
  734. overloadchecked:=false;
  735. overloadcount:=$ffff; { invalid, not used anymore }
  736. end;
  737. destructor tprocsym.destroy;
  738. var
  739. hp,p : pprocdeflist;
  740. begin
  741. p:=pdlistfirst;
  742. while assigned(p) do
  743. begin
  744. hp:=p^.next;
  745. dispose(p);
  746. p:=hp;
  747. end;
  748. inherited destroy;
  749. end;
  750. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  751. var
  752. p : pprocdeflist;
  753. begin
  754. p:=pdlistfirst;
  755. while assigned(p) do
  756. begin
  757. if p^.def<>skipdef then
  758. MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
  759. p:=p^.next;
  760. end;
  761. end;
  762. procedure tprocsym.check_forward;
  763. var
  764. p : pprocdeflist;
  765. begin
  766. p:=pdlistfirst;
  767. while assigned(p) do
  768. begin
  769. if (p^.def.procsym=self) and
  770. (p^.def.forwarddef) then
  771. begin
  772. MessagePos1(p^.def.fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
  773. { Turn futher error messages off }
  774. p^.def.forwarddef:=false;
  775. end;
  776. p:=p^.next;
  777. end;
  778. end;
  779. procedure tprocsym.deref;
  780. var
  781. p : pprocdeflist;
  782. begin
  783. p:=pdlistfirst;
  784. while assigned(p) do
  785. begin
  786. resolvedef(pointer(p^.def));
  787. p:=p^.next;
  788. end;
  789. end;
  790. procedure tprocsym.addprocdef(p:tprocdef);
  791. var
  792. pd : pprocdeflist;
  793. begin
  794. new(pd);
  795. pd^.def:=p;
  796. pd^.next:=nil;
  797. { Add at end of list to keep always
  798. a correct order, also after loading from ppu }
  799. if assigned(pdlistlast) then
  800. begin
  801. pdlistlast^.next:=pd;
  802. pdlistlast:=pd;
  803. end
  804. else
  805. begin
  806. pdlistfirst:=pd;
  807. pdlistlast:=pd;
  808. end;
  809. inc(procdef_count);
  810. end;
  811. function Tprocsym.getprocdef(nr:cardinal):Tprocdef;
  812. var
  813. i : cardinal;
  814. pd : Pprocdeflist;
  815. begin
  816. pd:=pdlistfirst;
  817. for i:=2 to nr do
  818. begin
  819. if not assigned(pd) then
  820. internalerror(200209051);
  821. pd:=pd^.next;
  822. end;
  823. getprocdef:=pd^.def;
  824. end;
  825. procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
  826. var
  827. pd:Pprocdeflist;
  828. begin
  829. pd:=pdlistfirst;
  830. while assigned(pd) do
  831. begin
  832. if Aprocsym.search_procdef_bypara(pd^.def.para,false,true)=nil then
  833. Aprocsym.addprocdef(pd^.def);
  834. pd:=pd^.next;
  835. end;
  836. end;
  837. procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
  838. var
  839. pd : Pprocdeflist;
  840. begin
  841. pd:=pdlistfirst;
  842. while assigned(pd) do
  843. begin
  844. s.addprocdef(pd^.def);
  845. pd:=pd^.next;
  846. end;
  847. end;
  848. function Tprocsym.first_procdef:Tprocdef;
  849. begin
  850. if assigned(pdlistfirst) then
  851. first_procdef:=pdlistfirst^.def
  852. else
  853. first_procdef:=nil;
  854. end;
  855. function Tprocsym.last_procdef:Tprocdef;
  856. begin
  857. if assigned(pdlistlast) then
  858. last_procdef:=pdlistlast^.def
  859. else
  860. last_procdef:=nil;
  861. end;
  862. procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  863. var
  864. p : Pprocdeflist;
  865. begin
  866. p:=pdlistfirst;
  867. while assigned(p) do
  868. begin
  869. proc2call(p^.def,arg);
  870. p:=p^.next;
  871. end;
  872. end;
  873. function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
  874. var
  875. p : Pprocdeflist;
  876. begin
  877. search_procdef_nopara_boolret:=nil;
  878. p:=pdlistfirst;
  879. while p<>nil do
  880. begin
  881. if p^.def.para.empty and is_boolean(p^.def.rettype.def) then
  882. begin
  883. search_procdef_nopara_boolret:=p^.def;
  884. break;
  885. end;
  886. p:=p^.next;
  887. end;
  888. end;
  889. function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  890. var
  891. p : Pprocdeflist;
  892. begin
  893. search_procdef_bytype:=nil;
  894. p:=pdlistfirst;
  895. while p<>nil do
  896. begin
  897. if p^.def.proctypeoption=pt then
  898. begin
  899. search_procdef_bytype:=p^.def;
  900. break;
  901. end;
  902. p:=p^.next;
  903. end;
  904. end;
  905. function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
  906. allowconvert,
  907. allowdefault:boolean):Tprocdef;
  908. var
  909. pd : Pprocdeflist;
  910. eq : tequaltype;
  911. begin
  912. search_procdef_bypara:=nil;
  913. pd:=pdlistfirst;
  914. while assigned(pd) do
  915. begin
  916. eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault);
  917. if (eq>=te_equal) or
  918. (allowconvert and (eq>te_incompatible)) then
  919. begin
  920. search_procdef_bypara:=pd^.def;
  921. break;
  922. end;
  923. pd:=pd^.next;
  924. end;
  925. end;
  926. function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  927. var
  928. pd : Pprocdeflist;
  929. eq,besteq : tequaltype;
  930. bestpd : tprocdef;
  931. begin
  932. { This function will return the pprocdef of pprocsym that
  933. is the best match for procvardef. When there are multiple
  934. matches it returns nil.}
  935. search_procdef_byprocvardef:=nil;
  936. bestpd:=nil;
  937. besteq:=te_incompatible;
  938. pd:=pdlistfirst;
  939. while assigned(pd) do
  940. begin
  941. eq:=proc_to_procvar_equal(pd^.def,d);
  942. if eq>=te_equal then
  943. begin
  944. { multiple procvars with the same equal level }
  945. if assigned(bestpd) and
  946. (besteq=eq) then
  947. exit;
  948. if eq>besteq then
  949. begin
  950. besteq:=eq;
  951. bestpd:=pd^.def;
  952. end;
  953. end;
  954. pd:=pd^.next;
  955. end;
  956. search_procdef_byprocvardef:=bestpd;
  957. end;
  958. function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
  959. var
  960. pd:Pprocdeflist;
  961. begin
  962. search_procdef_by1paradef:=nil;
  963. pd:=pdlistfirst;
  964. while assigned(pd) do
  965. begin
  966. if equal_defs(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
  967. (Tparaitem(pd^.def.para.first).next=nil) then
  968. begin
  969. search_procdef_by1paradef:=pd^.def;
  970. break;
  971. end;
  972. pd:=pd^.next;
  973. end;
  974. end;
  975. function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
  976. var
  977. convtyp : tconverttype;
  978. pd : pprocdeflist;
  979. bestpd : tprocdef;
  980. eq,
  981. besteq : tequaltype;
  982. hpd : tprocdef;
  983. begin
  984. search_procdef_assignment_operator:=nil;
  985. bestpd:=nil;
  986. besteq:=te_incompatible;
  987. pd:=pdlistfirst;
  988. while assigned(pd) do
  989. begin
  990. if equal_defs(todef,pd^.def.rettype.def) then
  991. begin
  992. eq:=compare_defs_ext(fromdef,Tparaitem(pd^.def.para.first).paratype.def,
  993. nothingn,false,false,convtyp,hpd);
  994. if eq=te_exact then
  995. begin
  996. search_procdef_assignment_operator:=pd^.def;
  997. exit;
  998. end;
  999. if eq>besteq then
  1000. begin
  1001. bestpd:=pd^.def;
  1002. besteq:=eq;
  1003. end;
  1004. end;
  1005. pd:=pd^.next;
  1006. end;
  1007. search_procdef_assignment_operator:=bestpd;
  1008. end;
  1009. function Tprocsym.search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
  1010. var
  1011. convtyp : tconverttype;
  1012. pd : pprocdeflist;
  1013. bestpd : tprocdef;
  1014. eq1,eq2 : tequaltype;
  1015. eqlev,
  1016. bestlev : byte;
  1017. hpd : tprocdef;
  1018. begin
  1019. search_procdef_binary_operator:=nil;
  1020. bestpd:=nil;
  1021. bestlev:=0;
  1022. pd:=pdlistfirst;
  1023. while assigned(pd) do
  1024. begin
  1025. { Compare def1 with the last para (right to left order) }
  1026. eq1:=compare_defs_ext(def1,Tparaitem(pd^.def.para.last).paratype.def,
  1027. nothingn,false,false,convtyp,hpd);
  1028. if eq1<>te_incompatible then
  1029. begin
  1030. { Compare def2 with the first para (right to left order) }
  1031. eq2:=compare_defs_ext(def2,Tparaitem(pd^.def.para.first).paratype.def,
  1032. nothingn,false,false,convtyp,hpd);
  1033. if eq2<>te_incompatible then
  1034. begin
  1035. eqlev:=byte(eq1)+byte(eq2);
  1036. if eqlev=(byte(te_exact)+byte(te_exact)) then
  1037. begin
  1038. search_procdef_binary_operator:=pd^.def;
  1039. exit;
  1040. end;
  1041. if eqlev>bestlev then
  1042. begin
  1043. bestpd:=pd^.def;
  1044. bestlev:=eqlev;
  1045. end;
  1046. end;
  1047. end;
  1048. pd:=pd^.next;
  1049. end;
  1050. search_procdef_binary_operator:=bestpd;
  1051. end;
  1052. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  1053. var
  1054. p : pprocdeflist;
  1055. begin
  1056. inherited writesym(ppufile);
  1057. p:=pdlistfirst;
  1058. while assigned(p) do
  1059. begin
  1060. { only write the proc definitions that belong
  1061. to this procsym }
  1062. if (p^.def.procsym=self) then
  1063. ppufile.putderef(p^.def);
  1064. p:=p^.next;
  1065. end;
  1066. ppufile.putderef(nil);
  1067. ppufile.writeentry(ibprocsym);
  1068. end;
  1069. function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
  1070. var
  1071. p : pprocdeflist;
  1072. begin
  1073. write_references:=false;
  1074. if not inherited write_references(ppufile,locals) then
  1075. exit;
  1076. write_references:=true;
  1077. p:=pdlistfirst;
  1078. while assigned(p) do
  1079. begin
  1080. if (p^.def.procsym=self) then
  1081. p^.def.write_references(ppufile,locals);
  1082. p:=p^.next;
  1083. end;
  1084. end;
  1085. procedure tprocsym.unchain_overload;
  1086. var
  1087. p,hp : pprocdeflist;
  1088. begin
  1089. { remove all overloaded procdefs from the
  1090. procdeflist that are not in the current symtable }
  1091. p:=pdlistfirst;
  1092. { reset new lists }
  1093. pdlistfirst:=nil;
  1094. pdlistlast:=nil;
  1095. while assigned(p) do
  1096. begin
  1097. hp:=p^.next;
  1098. if (p^.def.procsym=self) then
  1099. begin
  1100. { keep, add to list }
  1101. if assigned(pdlistlast) then
  1102. begin
  1103. pdlistlast^.next:=p;
  1104. pdlistlast:=p;
  1105. end
  1106. else
  1107. begin
  1108. pdlistfirst:=p;
  1109. pdlistlast:=p;
  1110. end;
  1111. p^.next:=nil;
  1112. end
  1113. else
  1114. begin
  1115. { remove }
  1116. dispose(p);
  1117. dec(procdef_count);
  1118. end;
  1119. p:=hp;
  1120. end;
  1121. end;
  1122. {$ifdef GDB}
  1123. function tprocsym.stabstring : pchar;
  1124. begin
  1125. internalerror(200111171);
  1126. stabstring:=nil;
  1127. end;
  1128. procedure tprocsym.concatstabto(asmlist : taasmoutput);
  1129. begin
  1130. internalerror(200111172);
  1131. end;
  1132. {$endif GDB}
  1133. {****************************************************************************
  1134. TERRORSYM
  1135. ****************************************************************************}
  1136. constructor terrorsym.create;
  1137. begin
  1138. inherited create('');
  1139. typ:=errorsym;
  1140. end;
  1141. {****************************************************************************
  1142. TPROPERTYSYM
  1143. ****************************************************************************}
  1144. constructor tpropertysym.create(const n : string);
  1145. begin
  1146. inherited create(n);
  1147. typ:=propertysym;
  1148. propoptions:=[];
  1149. index:=0;
  1150. default:=0;
  1151. proptype.reset;
  1152. indextype.reset;
  1153. readaccess:=tsymlist.create;
  1154. writeaccess:=tsymlist.create;
  1155. storedaccess:=tsymlist.create;
  1156. end;
  1157. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  1158. begin
  1159. inherited loadsym(ppufile);
  1160. typ:=propertysym;
  1161. ppufile.getsmallset(propoptions);
  1162. if (ppo_is_override in propoptions) then
  1163. begin
  1164. propoverriden:=tpropertysym(ppufile.getderef);
  1165. { we need to have these objects initialized }
  1166. readaccess:=tsymlist.create;
  1167. writeaccess:=tsymlist.create;
  1168. storedaccess:=tsymlist.create;
  1169. end
  1170. else
  1171. begin
  1172. ppufile.gettype(proptype);
  1173. index:=ppufile.getlongint;
  1174. default:=ppufile.getlongint;
  1175. ppufile.gettype(indextype);
  1176. readaccess:=ppufile.getsymlist;
  1177. writeaccess:=ppufile.getsymlist;
  1178. storedaccess:=ppufile.getsymlist;
  1179. end;
  1180. end;
  1181. destructor tpropertysym.destroy;
  1182. begin
  1183. readaccess.free;
  1184. writeaccess.free;
  1185. storedaccess.free;
  1186. inherited destroy;
  1187. end;
  1188. function tpropertysym.gettypedef:tdef;
  1189. begin
  1190. gettypedef:=proptype.def;
  1191. end;
  1192. procedure tpropertysym.deref;
  1193. begin
  1194. if (ppo_is_override in propoptions) then
  1195. begin
  1196. resolvesym(pointer(propoverriden));
  1197. dooverride(propoverriden);
  1198. end
  1199. else
  1200. begin
  1201. proptype.resolve;
  1202. indextype.resolve;
  1203. readaccess.resolve;
  1204. writeaccess.resolve;
  1205. storedaccess.resolve;
  1206. end;
  1207. end;
  1208. function tpropertysym.getsize : longint;
  1209. begin
  1210. getsize:=0;
  1211. end;
  1212. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  1213. begin
  1214. inherited writesym(ppufile);
  1215. ppufile.putsmallset(propoptions);
  1216. if (ppo_is_override in propoptions) then
  1217. ppufile.putderef(propoverriden)
  1218. else
  1219. begin
  1220. ppufile.puttype(proptype);
  1221. ppufile.putlongint(index);
  1222. ppufile.putlongint(default);
  1223. ppufile.puttype(indextype);
  1224. ppufile.putsymlist(readaccess);
  1225. ppufile.putsymlist(writeaccess);
  1226. ppufile.putsymlist(storedaccess);
  1227. end;
  1228. ppufile.writeentry(ibpropertysym);
  1229. end;
  1230. procedure tpropertysym.dooverride(overriden:tpropertysym);
  1231. begin
  1232. propoverriden:=overriden;
  1233. proptype:=overriden.proptype;
  1234. propoptions:=overriden.propoptions+[ppo_is_override];
  1235. index:=overriden.index;
  1236. default:=overriden.default;
  1237. indextype:=overriden.indextype;
  1238. readaccess.free;
  1239. readaccess:=overriden.readaccess.getcopy;
  1240. writeaccess.free;
  1241. writeaccess:=overriden.writeaccess.getcopy;
  1242. storedaccess.free;
  1243. storedaccess:=overriden.storedaccess.getcopy;
  1244. end;
  1245. {$ifdef GDB}
  1246. function tpropertysym.stabstring : pchar;
  1247. begin
  1248. { !!!! don't know how to handle }
  1249. stabstring:=strpnew('');
  1250. end;
  1251. procedure tpropertysym.concatstabto(asmlist : taasmoutput);
  1252. begin
  1253. { !!!! don't know how to handle }
  1254. end;
  1255. {$endif GDB}
  1256. {****************************************************************************
  1257. TFUNCRETSYM
  1258. ****************************************************************************}
  1259. constructor tfuncretsym.create(const n : string;const tt:ttype);
  1260. begin
  1261. inherited create(n);
  1262. typ:=funcretsym;
  1263. returntype:=tt;
  1264. funcretstate:=vs_declared;
  1265. { address valid for ret in param only }
  1266. { otherwise set by insert }
  1267. address:=procinfo.return_offset;
  1268. end;
  1269. constructor tfuncretsym.ppuload(ppufile:tcompilerppufile);
  1270. begin
  1271. inherited loadsym(ppufile);
  1272. ppufile.gettype(returntype);
  1273. address:=ppufile.getlongint;
  1274. typ:=funcretsym;
  1275. end;
  1276. destructor tfuncretsym.destroy;
  1277. begin
  1278. inherited destroy;
  1279. end;
  1280. procedure tfuncretsym.ppuwrite(ppufile:tcompilerppufile);
  1281. begin
  1282. inherited writesym(ppufile);
  1283. ppufile.puttype(returntype);
  1284. ppufile.putlongint(address);
  1285. ppufile.writeentry(ibfuncretsym);
  1286. funcretstate:=vs_used;
  1287. end;
  1288. procedure tfuncretsym.deref;
  1289. begin
  1290. returntype.resolve;
  1291. end;
  1292. {$ifdef GDB}
  1293. procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
  1294. begin
  1295. { Nothing to do here, it is done in genexitcode }
  1296. end;
  1297. {$endif GDB}
  1298. {****************************************************************************
  1299. TABSOLUTESYM
  1300. ****************************************************************************}
  1301. constructor tabsolutesym.create(const n : string;const tt : ttype);
  1302. begin
  1303. inherited create(n,tt);
  1304. typ:=absolutesym;
  1305. end;
  1306. constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
  1307. begin
  1308. { Note: This needs to load everything of tvarsym.write }
  1309. inherited ppuload(ppufile);
  1310. { load absolute }
  1311. typ:=absolutesym;
  1312. ref:=nil;
  1313. address:=0;
  1314. asmname:=nil;
  1315. abstyp:=absolutetyp(ppufile.getbyte);
  1316. absseg:=false;
  1317. case abstyp of
  1318. tovar :
  1319. asmname:=stringdup(ppufile.getstring);
  1320. toasm :
  1321. asmname:=stringdup(ppufile.getstring);
  1322. toaddr :
  1323. begin
  1324. address:=ppufile.getlongint;
  1325. absseg:=boolean(ppufile.getbyte);
  1326. end;
  1327. end;
  1328. end;
  1329. procedure tabsolutesym.ppuwrite(ppufile:tcompilerppufile);
  1330. var
  1331. hvo : tvaroptions;
  1332. begin
  1333. { Note: This needs to write everything of tvarsym.write }
  1334. inherited writesym(ppufile);
  1335. ppufile.putbyte(byte(varspez));
  1336. ppufile.putlongint(address);
  1337. { write only definition or definitionsym }
  1338. ppufile.puttype(vartype);
  1339. hvo:=varoptions-[vo_regable];
  1340. ppufile.putsmallset(hvo);
  1341. ppufile.putbyte(byte(abstyp));
  1342. case abstyp of
  1343. tovar :
  1344. ppufile.putstring(ref.name);
  1345. toasm :
  1346. ppufile.putstring(asmname^);
  1347. toaddr :
  1348. begin
  1349. ppufile.putlongint(address);
  1350. ppufile.putbyte(byte(absseg));
  1351. end;
  1352. end;
  1353. ppufile.writeentry(ibabsolutesym);
  1354. end;
  1355. procedure tabsolutesym.deref;
  1356. var
  1357. srsym : tsym;
  1358. srsymtable : tsymtable;
  1359. begin
  1360. { inheritance of varsym.deref ! }
  1361. vartype.resolve;
  1362. { own absolute deref }
  1363. if (abstyp=tovar) and (asmname<>nil) then
  1364. begin
  1365. { search previous loaded symtables }
  1366. searchsym(asmname^,srsym,srsymtable);
  1367. if not assigned(srsym) then
  1368. srsym:=searchsymonlyin(owner,asmname^);
  1369. if not assigned(srsym) then
  1370. srsym:=generrorsym;
  1371. ref:=tstoredsym(srsym);
  1372. stringdispose(asmname);
  1373. end;
  1374. end;
  1375. function tabsolutesym.mangledname : string;
  1376. begin
  1377. case abstyp of
  1378. tovar :
  1379. begin
  1380. case ref.typ of
  1381. varsym :
  1382. mangledname:=tvarsym(ref).mangledname;
  1383. else
  1384. internalerror(200111011);
  1385. end;
  1386. end;
  1387. toasm :
  1388. mangledname:=asmname^;
  1389. toaddr :
  1390. mangledname:='$'+tostr(address);
  1391. else
  1392. internalerror(10002);
  1393. end;
  1394. end;
  1395. {$ifdef GDB}
  1396. procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
  1397. begin
  1398. { I don't know how to handle this !! }
  1399. end;
  1400. {$endif GDB}
  1401. {****************************************************************************
  1402. TVARSYM
  1403. ****************************************************************************}
  1404. constructor tvarsym.create(const n : string;const tt : ttype);
  1405. begin
  1406. inherited create(n);
  1407. typ:=varsym;
  1408. vartype:=tt;
  1409. _mangledname:=nil;
  1410. varspez:=vs_value;
  1411. address:=0;
  1412. localvarsym:=nil;
  1413. refs:=0;
  1414. varstate:=vs_used;
  1415. varoptions:=[];
  1416. { can we load the value into a register ? }
  1417. if tstoreddef(tt.def).is_intregable then
  1418. include(varoptions,vo_regable)
  1419. else
  1420. exclude(varoptions,vo_regable);
  1421. if tstoreddef(tt.def).is_fpuregable then
  1422. include(varoptions,vo_fpuregable)
  1423. else
  1424. exclude(varoptions,vo_fpuregable);
  1425. reg:=R_NO;
  1426. end;
  1427. constructor tvarsym.create_dll(const n : string;const tt : ttype);
  1428. begin
  1429. tvarsym(self).create(n,tt);
  1430. include(varoptions,vo_is_dll_var);
  1431. end;
  1432. constructor tvarsym.create_C(const n,mangled : string;const tt : ttype);
  1433. begin
  1434. tvarsym(self).create(n,tt);
  1435. stringdispose(_mangledname);
  1436. _mangledname:=stringdup(mangled);
  1437. end;
  1438. constructor tvarsym.ppuload(ppufile:tcompilerppufile);
  1439. begin
  1440. inherited loadsym(ppufile);
  1441. typ:=varsym;
  1442. reg:=R_NO;
  1443. refs := 0;
  1444. varstate:=vs_used;
  1445. varspez:=tvarspez(ppufile.getbyte);
  1446. address:=ppufile.getlongint;
  1447. localvarsym:=nil;
  1448. ppufile.gettype(vartype);
  1449. ppufile.getsmallset(varoptions);
  1450. if (vo_is_C_var in varoptions) then
  1451. _mangledname:=stringdup(ppufile.getstring);
  1452. end;
  1453. destructor tvarsym.destroy;
  1454. begin
  1455. {$ifdef var_notification}
  1456. if assigned(notifications) then
  1457. notifications.destroy;
  1458. {$endif}
  1459. inherited destroy;
  1460. end;
  1461. procedure tvarsym.deref;
  1462. begin
  1463. vartype.resolve;
  1464. end;
  1465. procedure tvarsym.ppuwrite(ppufile:tcompilerppufile);
  1466. var
  1467. hvo : tvaroptions;
  1468. begin
  1469. inherited writesym(ppufile);
  1470. ppufile.putbyte(byte(varspez));
  1471. ppufile.putlongint(address);
  1472. ppufile.puttype(vartype);
  1473. { symbols which are load are never candidates for a register,
  1474. turn off the regable }
  1475. hvo:=varoptions-[vo_regable,vo_fpuregable];
  1476. ppufile.putsmallset(hvo);
  1477. if (vo_is_C_var in varoptions) then
  1478. ppufile.putstring(mangledname);
  1479. ppufile.writeentry(ibvarsym);
  1480. end;
  1481. procedure tvarsym.generate_mangledname;
  1482. begin
  1483. _mangledname:=stringdup(mangledname_prefix('U',owner)+name);
  1484. end;
  1485. procedure tvarsym.set_mangledname(const s:string);
  1486. begin
  1487. stringdispose(_mangledname);
  1488. _mangledname:=stringdup(s);
  1489. end;
  1490. function tvarsym.getsize : longint;
  1491. begin
  1492. if assigned(vartype.def) then
  1493. getsize:=vartype.def.size
  1494. else
  1495. getsize:=0;
  1496. end;
  1497. function tvarsym.getvaluesize : longint;
  1498. begin
  1499. if assigned(vartype.def) and
  1500. (varspez=vs_value) and
  1501. ((vartype.def.deftype<>arraydef) or
  1502. tarraydef(vartype.def).isDynamicArray or
  1503. (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
  1504. getvaluesize:=vartype.def.size
  1505. else
  1506. getvaluesize:=0;
  1507. end;
  1508. {$ifdef var_notification}
  1509. function Tvarsym.register_notification(flags:Tnotification_flags;callback:
  1510. Tnotification_callback):cardinal;
  1511. var n:Tnotification;
  1512. begin
  1513. if not assigned(notifications) then
  1514. notifications:=Tlinkedlist.create;
  1515. n:=Tnotification.create(flags,callback);
  1516. register_notification:=n.id;
  1517. notifications.concat(n);
  1518. end;
  1519. {$endif}
  1520. {$ifdef GDB}
  1521. function tvarsym.stabstring : pchar;
  1522. var
  1523. st : string;
  1524. begin
  1525. st:=tstoreddef(vartype.def).numberstring;
  1526. if (owner.symtabletype = objectsymtable) and
  1527. (sp_static in symoptions) then
  1528. begin
  1529. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1530. stabstring := strpnew('"'+owner.name^+'__'+name+':'+st+
  1531. '",'+
  1532. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1533. end
  1534. else if (owner.symtabletype = globalsymtable) then
  1535. begin
  1536. { Here we used S instead of
  1537. because with G GDB doesn't look at the address field
  1538. but searches the same name or with a leading underscore
  1539. but these names don't exist in pascal !}
  1540. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1541. stabstring := strpnew('"'+name+':'+st+'",'+
  1542. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1543. end
  1544. else if owner.symtabletype = staticsymtable then
  1545. begin
  1546. stabstring := strpnew('"'+name+':S'+st+'",'+
  1547. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1548. end
  1549. else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
  1550. begin
  1551. case varspez of
  1552. vs_out,
  1553. vs_var : st := 'v'+st;
  1554. vs_value,
  1555. vs_const : if paramanager.push_addr_param(vartype.def,tprocdef(owner.defowner).proccalloption) then
  1556. st := 'v'+st { should be 'i' but 'i' doesn't work }
  1557. else
  1558. st := 'p'+st;
  1559. end;
  1560. stabstring := strpnew('"'+name+':'+st+'",'+
  1561. tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
  1562. tostr(address+owner.address_fixup));
  1563. {offset to ebp => will not work if the framepointer is esp
  1564. so some optimizing will make things harder to debug }
  1565. end
  1566. else if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) then
  1567. if reg<>R_NO then
  1568. begin
  1569. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1570. { this is the register order for GDB}
  1571. stabstring:=strpnew('"'+name+':r'+st+'",'+
  1572. tostr(N_RSYM)+',0,'+
  1573. tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
  1574. end
  1575. else
  1576. { I don't know if this will work (PM) }
  1577. if (vo_is_C_var in varoptions) then
  1578. stabstring := strpnew('"'+name+':S'+st+'",'+
  1579. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
  1580. else
  1581. stabstring := strpnew('"'+name+':'+st+'",'+
  1582. tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner.address_fixup))
  1583. else
  1584. stabstring := inherited stabstring;
  1585. end;
  1586. procedure tvarsym.concatstabto(asmlist : taasmoutput);
  1587. var stab_str : pchar;
  1588. begin
  1589. if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
  1590. (copy(name,1,6)='hidden') then
  1591. exit;
  1592. inherited concatstabto(asmlist);
  1593. if (owner.symtabletype=parasymtable) and
  1594. (reg<>R_NO) then
  1595. begin
  1596. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1597. { this is the register order for GDB}
  1598. stab_str:=strpnew('"'+name+':r'
  1599. +tstoreddef(vartype.def).numberstring+'",'+
  1600. tostr(N_RSYM)+',0,'+
  1601. tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
  1602. asmList.concat(Tai_stabs.Create(stab_str));
  1603. end;
  1604. end;
  1605. {$endif GDB}
  1606. {****************************************************************************
  1607. TTYPEDCONSTSYM
  1608. *****************************************************************************}
  1609. constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
  1610. begin
  1611. inherited create(n);
  1612. typ:=typedconstsym;
  1613. typedconsttype.setdef(p);
  1614. is_writable:=writable;
  1615. end;
  1616. constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
  1617. begin
  1618. inherited create(n);
  1619. typ:=typedconstsym;
  1620. typedconsttype:=tt;
  1621. is_writable:=writable;
  1622. end;
  1623. constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
  1624. begin
  1625. inherited loadsym(ppufile);
  1626. typ:=typedconstsym;
  1627. ppufile.gettype(typedconsttype);
  1628. is_writable:=boolean(ppufile.getbyte);
  1629. end;
  1630. destructor ttypedconstsym.destroy;
  1631. begin
  1632. inherited destroy;
  1633. end;
  1634. procedure ttypedconstsym.generate_mangledname;
  1635. begin
  1636. _mangledname:=stringdup(mangledname_prefix('TC',owner)+name);
  1637. end;
  1638. function ttypedconstsym.getsize : longint;
  1639. begin
  1640. if assigned(typedconsttype.def) then
  1641. getsize:=typedconsttype.def.size
  1642. else
  1643. getsize:=0;
  1644. end;
  1645. procedure ttypedconstsym.deref;
  1646. begin
  1647. typedconsttype.resolve;
  1648. end;
  1649. procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);
  1650. begin
  1651. inherited writesym(ppufile);
  1652. ppufile.puttype(typedconsttype);
  1653. ppufile.putbyte(byte(is_writable));
  1654. ppufile.writeentry(ibtypedconstsym);
  1655. end;
  1656. {$ifdef GDB}
  1657. function ttypedconstsym.stabstring : pchar;
  1658. var
  1659. st : char;
  1660. begin
  1661. if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then
  1662. st := 'G'
  1663. else
  1664. st := 'S';
  1665. stabstring := strpnew('"'+name+':'+st+
  1666. tstoreddef(typedconsttype.def).numberstring+'",'+tostr(n_STSYM)+',0,'+
  1667. tostr(fileinfo.line)+','+mangledname);
  1668. end;
  1669. {$endif GDB}
  1670. {****************************************************************************
  1671. TCONSTSYM
  1672. ****************************************************************************}
  1673. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
  1674. begin
  1675. inherited create(n);
  1676. fillchar(value, sizeof(value), #0);
  1677. typ:=constsym;
  1678. consttyp:=t;
  1679. value.valueord:=v;
  1680. ResStrIndex:=0;
  1681. consttype.reset;
  1682. end;
  1683. constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  1684. begin
  1685. inherited create(n);
  1686. fillchar(value, sizeof(value), #0);
  1687. typ:=constsym;
  1688. consttyp:=t;
  1689. value.valueord:=v;
  1690. ResStrIndex:=0;
  1691. consttype:=tt;
  1692. end;
  1693. constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  1694. begin
  1695. inherited create(n);
  1696. fillchar(value, sizeof(value), #0);
  1697. typ:=constsym;
  1698. consttyp:=t;
  1699. value.valueordptr:=v;
  1700. ResStrIndex:=0;
  1701. consttype:=tt;
  1702. end;
  1703. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
  1704. begin
  1705. inherited create(n);
  1706. fillchar(value, sizeof(value), #0);
  1707. typ:=constsym;
  1708. consttyp:=t;
  1709. value.valueptr:=v;
  1710. ResStrIndex:=0;
  1711. consttype.reset;
  1712. end;
  1713. constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  1714. begin
  1715. inherited create(n);
  1716. fillchar(value, sizeof(value), #0);
  1717. typ:=constsym;
  1718. consttyp:=t;
  1719. value.valueptr:=v;
  1720. ResStrIndex:=0;
  1721. consttype:=tt;
  1722. end;
  1723. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1724. begin
  1725. inherited create(n);
  1726. fillchar(value, sizeof(value), #0);
  1727. typ:=constsym;
  1728. consttyp:=t;
  1729. value.valueptr:=str;
  1730. consttype.reset;
  1731. value.len:=l;
  1732. if t=constresourcestring then
  1733. ResStrIndex:=ResourceStrings.Register(name,pchar(value.valueptr),value.len);
  1734. end;
  1735. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1736. var
  1737. pd : pbestreal;
  1738. ps : pnormalset;
  1739. pc : pchar;
  1740. begin
  1741. inherited loadsym(ppufile);
  1742. typ:=constsym;
  1743. consttype.reset;
  1744. consttyp:=tconsttyp(ppufile.getbyte);
  1745. fillchar(value, sizeof(value), #0);
  1746. case consttyp of
  1747. constint:
  1748. value.valueord:=ppufile.getexprint;
  1749. constwchar,
  1750. constbool,
  1751. constchar :
  1752. value.valueord:=ppufile.getlongint;
  1753. constord :
  1754. begin
  1755. ppufile.gettype(consttype);
  1756. value.valueord:=ppufile.getexprint;
  1757. end;
  1758. constpointer :
  1759. begin
  1760. ppufile.gettype(consttype);
  1761. value.valueordptr:=ppufile.getptruint;
  1762. end;
  1763. conststring,
  1764. constresourcestring :
  1765. begin
  1766. value.len:=ppufile.getlongint;
  1767. getmem(pc,value.len+1);
  1768. ppufile.getdata(pc^,value.len);
  1769. if consttyp=constresourcestring then
  1770. ResStrIndex:=ppufile.getlongint;
  1771. value.valueptr:=pc;
  1772. end;
  1773. constreal :
  1774. begin
  1775. new(pd);
  1776. pd^:=ppufile.getreal;
  1777. value.valueptr:=pd;
  1778. end;
  1779. constset :
  1780. begin
  1781. ppufile.gettype(consttype);
  1782. new(ps);
  1783. ppufile.getnormalset(ps^);
  1784. value.valueptr:=ps;
  1785. end;
  1786. constguid :
  1787. begin
  1788. new(pguid(value.valueptr));
  1789. ppufile.getdata(value.valueptr^,sizeof(tguid));
  1790. end;
  1791. constnil : ;
  1792. else
  1793. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1794. end;
  1795. end;
  1796. destructor tconstsym.destroy;
  1797. begin
  1798. case consttyp of
  1799. conststring,
  1800. constresourcestring :
  1801. freemem(pchar(value.valueptr),value.len+1);
  1802. constreal :
  1803. dispose(pbestreal(value.valueptr));
  1804. constset :
  1805. dispose(pnormalset(value.valueptr));
  1806. constguid :
  1807. dispose(pguid(value.valueptr));
  1808. end;
  1809. inherited destroy;
  1810. end;
  1811. function tconstsym.mangledname : string;
  1812. begin
  1813. mangledname:=name;
  1814. end;
  1815. procedure tconstsym.deref;
  1816. begin
  1817. if consttyp in [constord,constpointer,constset] then
  1818. consttype.resolve;
  1819. end;
  1820. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  1821. begin
  1822. inherited writesym(ppufile);
  1823. ppufile.putbyte(byte(consttyp));
  1824. case consttyp of
  1825. constnil : ;
  1826. constint:
  1827. ppufile.putexprint(value.valueord);
  1828. constbool,
  1829. constchar :
  1830. ppufile.putlongint(value.valueord);
  1831. constord :
  1832. begin
  1833. ppufile.puttype(consttype);
  1834. ppufile.putexprint(value.valueord);
  1835. end;
  1836. constpointer :
  1837. begin
  1838. ppufile.puttype(consttype);
  1839. ppufile.putptruint(value.valueordptr);
  1840. end;
  1841. conststring,
  1842. constresourcestring :
  1843. begin
  1844. ppufile.putlongint(value.len);
  1845. ppufile.putdata(pchar(value.valueptr)^,value.len);
  1846. if consttyp=constresourcestring then
  1847. ppufile.putlongint(ResStrIndex);
  1848. end;
  1849. constreal :
  1850. ppufile.putreal(pbestreal(value.valueptr)^);
  1851. constset :
  1852. begin
  1853. ppufile.puttype(consttype);
  1854. ppufile.putnormalset(value.valueptr^);
  1855. end;
  1856. constguid :
  1857. ppufile.putdata(value.valueptr^,sizeof(tguid));
  1858. else
  1859. internalerror(13);
  1860. end;
  1861. ppufile.writeentry(ibconstsym);
  1862. end;
  1863. {$ifdef GDB}
  1864. function tconstsym.stabstring : pchar;
  1865. var st : string;
  1866. begin
  1867. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  1868. case consttyp of
  1869. conststring : begin
  1870. st := 's'''+strpas(pchar(value.valueptr))+'''';
  1871. end;
  1872. constbool,
  1873. constint,
  1874. constord,
  1875. constchar : st := 'i'+int64tostr(value.valueord);
  1876. constpointer :
  1877. st := 'i'+int64tostr(value.valueordptr);
  1878. constreal : begin
  1879. system.str(pbestreal(value.valueptr)^,st);
  1880. st := 'r'+st;
  1881. end;
  1882. { if we don't know just put zero !! }
  1883. else st:='i0';
  1884. {***SETCONST}
  1885. {constset:;} {*** I don't know what to do with a set.}
  1886. { sets are not recognized by GDB}
  1887. {***}
  1888. end;
  1889. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  1890. tostr(fileinfo.line)+',0');
  1891. end;
  1892. procedure tconstsym.concatstabto(asmlist : taasmoutput);
  1893. begin
  1894. if consttyp <> conststring then
  1895. inherited concatstabto(asmlist);
  1896. end;
  1897. {$endif GDB}
  1898. {****************************************************************************
  1899. TENUMSYM
  1900. ****************************************************************************}
  1901. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  1902. begin
  1903. inherited create(n);
  1904. typ:=enumsym;
  1905. definition:=def;
  1906. value:=v;
  1907. { check for jumps }
  1908. if v>def.max+1 then
  1909. def.has_jumps:=true;
  1910. { update low and high }
  1911. if def.min>v then
  1912. def.setmin(v);
  1913. if def.max<v then
  1914. def.setmax(v);
  1915. order;
  1916. end;
  1917. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  1918. begin
  1919. inherited loadsym(ppufile);
  1920. typ:=enumsym;
  1921. definition:=tenumdef(ppufile.getderef);
  1922. value:=ppufile.getlongint;
  1923. nextenum := Nil;
  1924. end;
  1925. procedure tenumsym.deref;
  1926. begin
  1927. resolvedef(pointer(definition));
  1928. order;
  1929. end;
  1930. procedure tenumsym.order;
  1931. var
  1932. sym : tenumsym;
  1933. begin
  1934. sym := tenumsym(definition.firstenum);
  1935. if sym = nil then
  1936. begin
  1937. definition.firstenum := self;
  1938. nextenum := nil;
  1939. exit;
  1940. end;
  1941. { reorder the symbols in increasing value }
  1942. if value < sym.value then
  1943. begin
  1944. nextenum := sym;
  1945. definition.firstenum := self;
  1946. end
  1947. else
  1948. begin
  1949. while (sym.value <= value) and assigned(sym.nextenum) do
  1950. sym := sym.nextenum;
  1951. nextenum := sym.nextenum;
  1952. sym.nextenum := self;
  1953. end;
  1954. end;
  1955. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  1956. begin
  1957. inherited writesym(ppufile);
  1958. ppufile.putderef(definition);
  1959. ppufile.putlongint(value);
  1960. ppufile.writeentry(ibenumsym);
  1961. end;
  1962. {$ifdef GDB}
  1963. procedure tenumsym.concatstabto(asmlist : taasmoutput);
  1964. begin
  1965. {enum elements have no stab !}
  1966. end;
  1967. {$EndIf GDB}
  1968. {****************************************************************************
  1969. TTYPESYM
  1970. ****************************************************************************}
  1971. constructor ttypesym.create(const n : string;const tt : ttype);
  1972. begin
  1973. inherited create(n);
  1974. typ:=typesym;
  1975. restype:=tt;
  1976. {$ifdef GDB}
  1977. isusedinstab := false;
  1978. {$endif GDB}
  1979. { register the typesym for the definition }
  1980. if assigned(restype.def) and
  1981. (restype.def.deftype<>errordef) and
  1982. not(assigned(restype.def.typesym)) then
  1983. restype.def.typesym:=self;
  1984. end;
  1985. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  1986. begin
  1987. inherited loadsym(ppufile);
  1988. typ:=typesym;
  1989. {$ifdef GDB}
  1990. isusedinstab := false;
  1991. {$endif GDB}
  1992. ppufile.gettype(restype);
  1993. end;
  1994. function ttypesym.gettypedef:tdef;
  1995. begin
  1996. gettypedef:=restype.def;
  1997. end;
  1998. procedure ttypesym.deref;
  1999. begin
  2000. restype.resolve;
  2001. end;
  2002. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  2003. begin
  2004. inherited writesym(ppufile);
  2005. ppufile.puttype(restype);
  2006. ppufile.writeentry(ibtypesym);
  2007. end;
  2008. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  2009. begin
  2010. inherited load_references(ppufile,locals);
  2011. if (restype.def.deftype=recorddef) then
  2012. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  2013. if (restype.def.deftype=objectdef) then
  2014. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  2015. end;
  2016. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  2017. begin
  2018. if not inherited write_references(ppufile,locals) then
  2019. begin
  2020. { write address of this symbol if record or object
  2021. even if no real refs are there
  2022. because we need it for the symtable }
  2023. if (restype.def.deftype in [recorddef,objectdef]) then
  2024. begin
  2025. ppufile.putderef(self);
  2026. ppufile.writeentry(ibsymref);
  2027. end;
  2028. end;
  2029. write_references:=true;
  2030. if (restype.def.deftype=recorddef) then
  2031. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  2032. if (restype.def.deftype=objectdef) then
  2033. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  2034. end;
  2035. {$ifdef GDB}
  2036. function ttypesym.stabstring : pchar;
  2037. var
  2038. stabchar : string[2];
  2039. short : string;
  2040. begin
  2041. if restype.def.deftype in tagtypes then
  2042. stabchar := 'Tt'
  2043. else
  2044. stabchar := 't';
  2045. short := '"'+name+':'+stabchar+tstoreddef(restype.def).numberstring
  2046. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  2047. stabstring := strpnew(short);
  2048. end;
  2049. procedure ttypesym.concatstabto(asmlist : taasmoutput);
  2050. begin
  2051. {not stabs for forward defs }
  2052. if assigned(restype.def) then
  2053. if (restype.def.typesym = self) then
  2054. tstoreddef(restype.def).concatstabto(asmlist)
  2055. else
  2056. inherited concatstabto(asmlist);
  2057. end;
  2058. {$endif GDB}
  2059. {****************************************************************************
  2060. TSYSSYM
  2061. ****************************************************************************}
  2062. constructor tsyssym.create(const n : string;l : longint);
  2063. begin
  2064. inherited create(n);
  2065. typ:=syssym;
  2066. number:=l;
  2067. end;
  2068. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  2069. begin
  2070. inherited loadsym(ppufile);
  2071. typ:=syssym;
  2072. number:=ppufile.getlongint;
  2073. end;
  2074. destructor tsyssym.destroy;
  2075. begin
  2076. inherited destroy;
  2077. end;
  2078. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  2079. begin
  2080. inherited writesym(ppufile);
  2081. ppufile.putlongint(number);
  2082. ppufile.writeentry(ibsyssym);
  2083. end;
  2084. {$ifdef GDB}
  2085. procedure tsyssym.concatstabto(asmlist : taasmoutput);
  2086. begin
  2087. end;
  2088. {$endif GDB}
  2089. {****************************************************************************
  2090. TRTTISYM
  2091. ****************************************************************************}
  2092. constructor trttisym.create(const n:string;rt:trttitype);
  2093. const
  2094. prefix : array[trttitype] of string[5]=('$rtti','$init');
  2095. begin
  2096. inherited create(prefix[rt]+n);
  2097. typ:=rttisym;
  2098. lab:=nil;
  2099. rttityp:=rt;
  2100. end;
  2101. constructor trttisym.ppuload(ppufile:tcompilerppufile);
  2102. begin
  2103. inherited loadsym(ppufile);
  2104. typ:=rttisym;
  2105. lab:=nil;
  2106. rttityp:=trttitype(ppufile.getbyte);
  2107. end;
  2108. procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
  2109. begin
  2110. inherited writesym(ppufile);
  2111. ppufile.putbyte(byte(rttityp));
  2112. ppufile.writeentry(ibrttisym);
  2113. end;
  2114. function trttisym.mangledname : string;
  2115. const
  2116. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2117. var
  2118. s : string;
  2119. p : tsymtable;
  2120. begin
  2121. s:='';
  2122. p:=owner;
  2123. while assigned(p) and (p.symtabletype=localsymtable) do
  2124. begin
  2125. s:=s+'_'+p.defowner.name;
  2126. p:=p.defowner.owner;
  2127. end;
  2128. if not(p.symtabletype in [globalsymtable,staticsymtable]) then
  2129. internalerror(200108265);
  2130. mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
  2131. end;
  2132. function trttisym.get_label:tasmsymbol;
  2133. begin
  2134. { the label is always a global label }
  2135. if not assigned(lab) then
  2136. lab:=objectlibrary.newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
  2137. get_label:=lab;
  2138. end;
  2139. { persistent rtti generation }
  2140. procedure generate_rtti(p:tsym);
  2141. var
  2142. rsym : trttisym;
  2143. def : tstoreddef;
  2144. begin
  2145. { rtti can only be generated for classes that are always typesyms }
  2146. if not(p.typ=typesym) then
  2147. internalerror(200108261);
  2148. def:=tstoreddef(ttypesym(p).restype.def);
  2149. { only create rtti once for each definition }
  2150. if not(df_has_rttitable in def.defoptions) then
  2151. begin
  2152. { definition should be in the same symtable as the symbol }
  2153. if p.owner<>def.owner then
  2154. internalerror(200108262);
  2155. { create rttisym }
  2156. rsym:=trttisym.create(p.name,fullrtti);
  2157. p.owner.insert(rsym);
  2158. { register rttisym in definition }
  2159. include(def.defoptions,df_has_rttitable);
  2160. def.rttitablesym:=rsym;
  2161. { write rtti data }
  2162. def.write_child_rtti_data(fullrtti);
  2163. if (cs_create_smart in aktmoduleswitches) then
  2164. rttiList.concat(Tai_cut.Create);
  2165. rttilist.concat(tai_align.create(const_align(pointer_size)));
  2166. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2167. def.write_rtti_data(fullrtti);
  2168. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2169. end;
  2170. end;
  2171. { persistent init table generation }
  2172. procedure generate_inittable(p:tsym);
  2173. var
  2174. rsym : trttisym;
  2175. def : tstoreddef;
  2176. begin
  2177. { anonymous types are also allowed for records that can be varsym }
  2178. case p.typ of
  2179. typesym :
  2180. def:=tstoreddef(ttypesym(p).restype.def);
  2181. varsym :
  2182. def:=tstoreddef(tvarsym(p).vartype.def);
  2183. else
  2184. internalerror(200108263);
  2185. end;
  2186. { only create inittable once for each definition }
  2187. if not(df_has_inittable in def.defoptions) then
  2188. begin
  2189. { definition should be in the same symtable as the symbol }
  2190. if p.owner<>def.owner then
  2191. internalerror(200108264);
  2192. { create rttisym }
  2193. rsym:=trttisym.create(p.name,initrtti);
  2194. p.owner.insert(rsym);
  2195. { register rttisym in definition }
  2196. include(def.defoptions,df_has_inittable);
  2197. def.inittablesym:=rsym;
  2198. { write inittable data }
  2199. def.write_child_rtti_data(initrtti);
  2200. if (cs_create_smart in aktmoduleswitches) then
  2201. rttiList.concat(Tai_cut.Create);
  2202. rttilist.concat(tai_align.create(const_align(pointer_size)));
  2203. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2204. def.write_rtti_data(initrtti);
  2205. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2206. end;
  2207. end;
  2208. end.
  2209. {
  2210. $Log$
  2211. Revision 1.84 2002-12-20 16:02:22 peter
  2212. * fix stupid copy&paste bug in binary operator search
  2213. Revision 1.83 2002/12/16 22:08:31 peter
  2214. * fix order of procdefs in procsym, procdefs are now always appended
  2215. so that loading from a ppu will keep the same order. This is
  2216. important for the generation of VMTs
  2217. Revision 1.82 2002/12/11 22:39:23 peter
  2218. * better error message when no operator is found for equal
  2219. Revision 1.81 2002/12/07 14:27:10 carl
  2220. * 3% memory optimization
  2221. * changed some types
  2222. + added type checking with different size for call node and for
  2223. parameters
  2224. Revision 1.80 2002/12/06 17:51:11 peter
  2225. * merged cdecl and array fixes
  2226. Revision 1.79 2002/11/27 20:04:10 peter
  2227. * tvarsym.get_push_size replaced by paramanager.push_size
  2228. Revision 1.78 2002/11/27 02:34:20 peter
  2229. * only find real equal procvars
  2230. Revision 1.77 2002/11/25 18:43:34 carl
  2231. - removed the invalid if <> checking (Delphi is strange on this)
  2232. + implemented abstract warning on instance creation of class with
  2233. abstract methods.
  2234. * some error message cleanups
  2235. Revision 1.76 2002/11/25 17:43:26 peter
  2236. * splitted defbase in defutil,symutil,defcmp
  2237. * merged isconvertable and is_equal into compare_defs(_ext)
  2238. * made operator search faster by walking the list only once
  2239. Revision 1.75 2002/11/23 22:50:09 carl
  2240. * some small speed optimizations
  2241. + added several new warnings/hints
  2242. Revision 1.74 2002/11/22 22:48:11 carl
  2243. * memory optimization with tconstsym (1.5%)
  2244. Revision 1.73 2002/11/18 17:31:59 peter
  2245. * pass proccalloption to ret_in_xxx and push_xxx functions
  2246. Revision 1.72 2002/11/17 16:31:57 carl
  2247. * memory optimization (3-4%) : cleanup of tai fields,
  2248. cleanup of tdef and tsym fields.
  2249. * make it work for m68k
  2250. Revision 1.71 2002/11/09 15:30:07 carl
  2251. + align RTTI tables
  2252. Revision 1.70 2002/10/13 21:33:37 peter
  2253. * give correct fileposition for undefined forward procs
  2254. Revision 1.69 2002/10/05 12:43:29 carl
  2255. * fixes for Delphi 6 compilation
  2256. (warning : Some features do not work under Delphi)
  2257. Revision 1.68 2002/10/05 00:52:20 peter
  2258. * split boolean check in two lines for easier debugging
  2259. Revision 1.67 2002/09/26 12:04:53 florian
  2260. + constsym with type=constguid can be written to ppu now,
  2261. fixes web bug 1820
  2262. Revision 1.66 2002/09/16 14:11:13 peter
  2263. * add argument to equal_paras() to support default values or not
  2264. Revision 1.65 2002/09/09 17:34:16 peter
  2265. * tdicationary.replace added to replace and item in a dictionary. This
  2266. is only allowed for the same name
  2267. * varsyms are inserted in symtable before the types are parsed. This
  2268. fixes the long standing "var longint : longint" bug
  2269. - consume_idlist and idstringlist removed. The loops are inserted
  2270. at the callers place and uses the symtable for duplicate id checking
  2271. Revision 1.64 2002/09/08 11:10:17 carl
  2272. * bugfix 2109 (bad imho, but only way)
  2273. Revision 1.63 2002/09/07 18:17:41 florian
  2274. + tvarsym.paraitem added
  2275. Revision 1.62 2002/09/07 15:25:10 peter
  2276. * old logs removed and tabs fixed
  2277. Revision 1.61 2002/09/05 19:29:45 peter
  2278. * memdebug enhancements
  2279. Revision 1.60 2002/09/05 14:51:42 peter
  2280. * internalerror instead of crash in getprocdef
  2281. Revision 1.59 2002/09/03 16:26:27 daniel
  2282. * Make Tprocdef.defs protected
  2283. Revision 1.58 2002/09/01 08:01:16 daniel
  2284. * Removed sets from Tcallnode.det_resulttype
  2285. + Added read/write notifications of variables. These will be usefull
  2286. for providing information for several optimizations. For example
  2287. the value of the loop variable of a for loop does matter is the
  2288. variable is read after the for loop, but if it's no longer used
  2289. or written, it doesn't matter and this can be used to optimize
  2290. the loop code generation.
  2291. Revision 1.57 2002/08/25 19:25:21 peter
  2292. * sym.insert_in_data removed
  2293. * symtable.insertvardata/insertconstdata added
  2294. * removed insert_in_data call from symtable.insert, it needs to be
  2295. called separatly. This allows to deref the address calculation
  2296. * procedures now calculate the parast addresses after the procedure
  2297. directives are parsed. This fixes the cdecl parast problem
  2298. * push_addr_param has an extra argument that specifies if cdecl is used
  2299. or not
  2300. Revision 1.56 2002/08/25 09:06:21 peter
  2301. * fixed loop in concat_procdefs
  2302. Revision 1.55 2002/08/20 16:54:40 peter
  2303. * write address of varsym always
  2304. Revision 1.54 2002/08/20 10:31:26 daniel
  2305. * Tcallnode.det_resulttype rewritten
  2306. Revision 1.53 2002/08/18 20:06:27 peter
  2307. * inlining is now also allowed in interface
  2308. * renamed write/load to ppuwrite/ppuload
  2309. * tnode storing in ppu
  2310. * nld,ncon,nbas are already updated for storing in ppu
  2311. Revision 1.52 2002/08/17 09:23:42 florian
  2312. * first part of procinfo rewrite
  2313. Revision 1.51 2002/08/16 14:24:59 carl
  2314. * issameref() to test if two references are the same (then emit no opcodes)
  2315. + ret_in_reg to replace ret_in_acc
  2316. (fix some register allocation bugs at the same time)
  2317. + save_std_register now has an extra parameter which is the
  2318. usedinproc registers
  2319. Revision 1.50 2002/08/13 21:40:57 florian
  2320. * more fixes for ppc calling conventions
  2321. Revision 1.49 2002/08/12 15:08:40 carl
  2322. + stab register indexes for powerpc (moved from gdb to cpubase)
  2323. + tprocessor enumeration moved to cpuinfo
  2324. + linker in target_info is now a class
  2325. * many many updates for m68k (will soon start to compile)
  2326. - removed some ifdef or correct them for correct cpu
  2327. Revision 1.48 2002/08/11 14:32:28 peter
  2328. * renamed current_library to objectlibrary
  2329. Revision 1.47 2002/08/11 13:24:14 peter
  2330. * saving of asmsymbols in ppu supported
  2331. * asmsymbollist global is removed and moved into a new class
  2332. tasmlibrarydata that will hold the info of a .a file which
  2333. corresponds with a single module. Added librarydata to tmodule
  2334. to keep the library info stored for the module. In the future the
  2335. objectfiles will also be stored to the tasmlibrarydata class
  2336. * all getlabel/newasmsymbol and friends are moved to the new class
  2337. Revision 1.46 2002/07/23 10:13:23 daniel
  2338. * Added important comment
  2339. Revision 1.45 2002/07/23 09:51:26 daniel
  2340. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2341. are worth comitting.
  2342. Revision 1.44 2002/07/20 17:45:29 daniel
  2343. * Register variables are now possible for global variables too. This is
  2344. important for small programs without procedures.
  2345. Revision 1.43 2002/07/20 11:57:58 florian
  2346. * types.pas renamed to defbase.pas because D6 contains a types
  2347. unit so this would conflicts if D6 programms are compiled
  2348. + Willamette/SSE2 instructions to assembler added
  2349. Revision 1.42 2002/07/11 14:41:31 florian
  2350. * start of the new generic parameter handling
  2351. }