symsym.pas 82 KB

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