symsym.pas 86 KB

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