symsym.pas 82 KB

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