symsym.pas 91 KB

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