symsym.pas 88 KB

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