symtable.pas 83 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  4. This unit handles the symbol tables
  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 symtable;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,cclasses,
  24. { global }
  25. cpuinfo,globtype,tokens,
  26. { symtable }
  27. symconst,symbase,symtype,symdef,symsym,
  28. { ppu }
  29. ppu,symppu,
  30. { assembler }
  31. aasmbase,aasmtai,aasmcpu,
  32. { cg }
  33. paramgr
  34. ;
  35. {****************************************************************************
  36. Symtable types
  37. ****************************************************************************}
  38. type
  39. tstoredsymtable = class(tsymtable)
  40. private
  41. b_needs_init_final : boolean;
  42. procedure _needs_init_final(p : tnamedindexitem;arg:pointer);
  43. procedure check_forward(sym : TNamedIndexItem;arg:pointer);
  44. procedure labeldefined(p : TNamedIndexItem;arg:pointer);
  45. procedure unitsymbolused(p : TNamedIndexItem;arg:pointer);
  46. procedure varsymbolused(p : TNamedIndexItem;arg:pointer);
  47. procedure TestPrivate(p : TNamedIndexItem;arg:pointer);
  48. procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
  49. {$ifdef GDB}
  50. private
  51. procedure concatstab(p : TNamedIndexItem;arg:pointer);
  52. procedure resetstab(p : TNamedIndexItem;arg:pointer);
  53. procedure concattypestab(p : TNamedIndexItem;arg:pointer);
  54. {$endif}
  55. procedure unchain_overloads(p : TNamedIndexItem;arg:pointer);
  56. procedure loaddefs(ppufile:tcompilerppufile);
  57. procedure loadsyms(ppufile:tcompilerppufile);
  58. procedure writedefs(ppufile:tcompilerppufile);
  59. procedure writesyms(ppufile:tcompilerppufile);
  60. public
  61. { load/write }
  62. procedure ppuload(ppufile:tcompilerppufile);virtual;
  63. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  64. procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
  65. procedure write_references(ppufile:tcompilerppufile;locals:boolean);virtual;
  66. procedure deref;virtual;
  67. procedure derefimpl;virtual;
  68. procedure insert(sym : tsymentry);override;
  69. function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override;
  70. procedure allsymbolsused;
  71. procedure allprivatesused;
  72. procedure allunitsused;
  73. procedure check_forwards;
  74. procedure checklabels;
  75. function needs_init_final : boolean;
  76. procedure unchain_overloaded;
  77. procedure chainoperators;
  78. {$ifdef GDB}
  79. procedure concatstabto(asmlist : taasmoutput);virtual;
  80. function getnewtypecount : word; override;
  81. {$endif GDB}
  82. procedure testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
  83. end;
  84. tabstractrecordsymtable = class(tstoredsymtable)
  85. public
  86. procedure ppuload(ppufile:tcompilerppufile);override;
  87. procedure ppuwrite(ppufile:tcompilerppufile);override;
  88. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  89. procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
  90. procedure insertvardata(sym : tsymentry);override;
  91. end;
  92. trecordsymtable = class(tabstractrecordsymtable)
  93. public
  94. constructor create;
  95. procedure insert_in(tsymt : tsymtable;offset : longint);
  96. end;
  97. tobjectsymtable = class(tabstractrecordsymtable)
  98. public
  99. constructor create(const n:string);
  100. procedure insert(sym : tsymentry);override;
  101. end;
  102. tabstractlocalsymtable = class(tstoredsymtable)
  103. public
  104. procedure ppuload(ppufile:tcompilerppufile);override;
  105. procedure ppuwrite(ppufile:tcompilerppufile);override;
  106. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  107. procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
  108. end;
  109. tlocalsymtable = class(tabstractlocalsymtable)
  110. public
  111. constructor create;
  112. procedure insert(sym : tsymentry);override;
  113. procedure insertvardata(sym : tsymentry);override;
  114. procedure insertconstdata(sym : tsymentry);override;
  115. end;
  116. tparasymtable = class(tabstractlocalsymtable)
  117. public
  118. constructor create;
  119. procedure insert(sym : tsymentry);override;
  120. procedure insertvardata(sym : tsymentry);override;
  121. end;
  122. tabstractunitsymtable = class(tstoredsymtable)
  123. public
  124. {$ifdef GDB}
  125. dbx_count : longint;
  126. prev_dbx_counter : plongint;
  127. dbx_count_ok : boolean;
  128. is_stab_written : boolean;
  129. {$endif GDB}
  130. constructor create(const n : string);
  131. {$ifdef GDB}
  132. procedure concattypestabto(asmlist : taasmoutput);
  133. {$endif GDB}
  134. procedure insertvardata(sym : tsymentry);override;
  135. procedure insertconstdata(sym : tsymentry);override;
  136. end;
  137. tglobalsymtable = class(tabstractunitsymtable)
  138. public
  139. unitsym : tunitsym;
  140. unittypecount : word;
  141. constructor create(const n : string);
  142. destructor destroy;override;
  143. procedure ppuload(ppufile:tcompilerppufile);override;
  144. procedure ppuwrite(ppufile:tcompilerppufile);override;
  145. procedure insert(sym : tsymentry);override;
  146. procedure insertvardata(sym : tsymentry);override;
  147. {$ifdef GDB}
  148. function getnewtypecount : word; override;
  149. {$endif}
  150. end;
  151. tstaticsymtable = class(tabstractunitsymtable)
  152. public
  153. constructor create(const n : string);
  154. procedure ppuload(ppufile:tcompilerppufile);override;
  155. procedure ppuwrite(ppufile:tcompilerppufile);override;
  156. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  157. procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
  158. procedure insert(sym : tsymentry);override;
  159. procedure insertvardata(sym : tsymentry);override;
  160. end;
  161. twithsymtable = class(tsymtable)
  162. direct_with : boolean;
  163. { in fact it is a tnode }
  164. withnode : pointer;
  165. { tnode to load of direct with var }
  166. { already usable before firstwith
  167. needed for firstpass of function parameters PM }
  168. withrefnode : pointer;
  169. use_count : longint;
  170. constructor create(aowner:tdef;asymsearch:TDictionary);
  171. destructor destroy;override;
  172. procedure clear;override;
  173. end;
  174. tstt_exceptsymtable = class(tsymtable)
  175. public
  176. constructor create;
  177. end;
  178. var
  179. constsymtable : tsymtable; { symtable were the constants can be inserted }
  180. systemunit : tglobalsymtable; { pointer to the system unit }
  181. read_member : boolean; { reading members of an symtable }
  182. lexlevel : byte; { level of code }
  183. { 1 for main procedure }
  184. { 2 for normal function or proc }
  185. { higher for locals }
  186. {****************************************************************************
  187. Functions
  188. ****************************************************************************}
  189. {*** Misc ***}
  190. procedure globaldef(const s : string;var t:ttype);
  191. function findunitsymtable(st:tsymtable):tsymtable;
  192. procedure duplicatesym(sym:tsym);
  193. {*** Search ***}
  194. function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
  195. function searchsymonlyin(p : tsymtable;const s : stringid):tsym;
  196. function searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
  197. function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
  198. function searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
  199. function search_class_member(pd : tobjectdef;const s : string):tsym;
  200. {*** Object Helpers ***}
  201. function search_default_property(pd : tobjectdef) : tpropertysym;
  202. {*** symtable stack ***}
  203. procedure dellexlevel;
  204. procedure RestoreUnitSyms;
  205. {$ifdef DEBUG}
  206. procedure test_symtablestack;
  207. procedure list_symtablestack;
  208. {$endif DEBUG}
  209. {$ifdef UNITALIASES}
  210. type
  211. punit_alias = ^tunit_alias;
  212. tunit_alias = object(TNamedIndexItem)
  213. newname : pstring;
  214. constructor init(const n:string);
  215. destructor done;virtual;
  216. end;
  217. var
  218. unitaliases : pdictionary;
  219. procedure addunitalias(const n:string);
  220. function getunitalias(const n:string):string;
  221. {$endif UNITALIASES}
  222. {*** Init / Done ***}
  223. procedure InitSymtable;
  224. procedure DoneSymtable;
  225. type
  226. toverloaded_operators = array[NOTOKEN..last_overloaded] of tprocsym;
  227. var
  228. overloaded_operators : toverloaded_operators;
  229. { unequal is not equal}
  230. const
  231. overloaded_names : array [NOTOKEN..last_overloaded] of string[16] =
  232. ('error',
  233. 'plus','minus','star','slash','equal',
  234. 'greater','lower','greater_or_equal',
  235. 'lower_or_equal',
  236. 'sym_diff','starstar',
  237. 'as','is','in','or',
  238. 'and','div','mod','not','shl','shr','xor',
  239. 'assign');
  240. implementation
  241. uses
  242. { global }
  243. verbose,globals,
  244. { target }
  245. systems,
  246. { module }
  247. fmodule,
  248. {$ifdef GDB}
  249. gdb,
  250. {$endif GDB}
  251. { codegen }
  252. cgbase
  253. ;
  254. {*****************************************************************************
  255. TStoredSymtable
  256. *****************************************************************************}
  257. procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile);
  258. begin
  259. { load definitions }
  260. loaddefs(ppufile);
  261. { load symbols }
  262. loadsyms(ppufile);
  263. end;
  264. procedure tstoredsymtable.ppuwrite(ppufile:tcompilerppufile);
  265. begin
  266. { write definitions }
  267. writedefs(ppufile);
  268. { write symbols }
  269. writesyms(ppufile);
  270. end;
  271. procedure tstoredsymtable.loaddefs(ppufile:tcompilerppufile);
  272. var
  273. hp : tdef;
  274. b : byte;
  275. begin
  276. { load start of definition section, which holds the amount of defs }
  277. if ppufile.readentry<>ibstartdefs then
  278. Message(unit_f_ppu_read_error);
  279. ppufile.getlongint;
  280. { read definitions }
  281. repeat
  282. b:=ppufile.readentry;
  283. case b of
  284. ibpointerdef : hp:=tpointerdef.ppuload(ppufile);
  285. ibarraydef : hp:=tarraydef.ppuload(ppufile);
  286. iborddef : hp:=torddef.ppuload(ppufile);
  287. ibfloatdef : hp:=tfloatdef.ppuload(ppufile);
  288. ibprocdef : hp:=tprocdef.ppuload(ppufile);
  289. ibshortstringdef : hp:=tstringdef.loadshort(ppufile);
  290. iblongstringdef : hp:=tstringdef.loadlong(ppufile);
  291. ibansistringdef : hp:=tstringdef.loadansi(ppufile);
  292. ibwidestringdef : hp:=tstringdef.loadwide(ppufile);
  293. ibrecorddef : hp:=trecorddef.ppuload(ppufile);
  294. ibobjectdef : hp:=tobjectdef.ppuload(ppufile);
  295. ibenumdef : hp:=tenumdef.ppuload(ppufile);
  296. ibsetdef : hp:=tsetdef.ppuload(ppufile);
  297. ibprocvardef : hp:=tprocvardef.ppuload(ppufile);
  298. ibfiledef : hp:=tfiledef.ppuload(ppufile);
  299. ibclassrefdef : hp:=tclassrefdef.ppuload(ppufile);
  300. ibformaldef : hp:=tformaldef.ppuload(ppufile);
  301. ibvariantdef : hp:=tvariantdef.ppuload(ppufile);
  302. ibenddefs : break;
  303. ibend : Message(unit_f_ppu_read_error);
  304. else
  305. Message1(unit_f_ppu_invalid_entry,tostr(b));
  306. end;
  307. hp.owner:=self;
  308. defindex.insert(hp);
  309. until false;
  310. end;
  311. procedure tstoredsymtable.loadsyms(ppufile:tcompilerppufile);
  312. var
  313. b : byte;
  314. sym : tsym;
  315. begin
  316. { load start of definition section, which holds the amount of defs }
  317. if ppufile.readentry<>ibstartsyms then
  318. Message(unit_f_ppu_read_error);
  319. { skip amount of symbols, not used currently }
  320. ppufile.getlongint;
  321. { load datasize,dataalignment of this symboltable }
  322. datasize:=ppufile.getlongint;
  323. dataalignment:=byte(ppufile.getlongint);
  324. { now read the symbols }
  325. repeat
  326. b:=ppufile.readentry;
  327. case b of
  328. ibtypesym : sym:=ttypesym.ppuload(ppufile);
  329. ibprocsym : sym:=tprocsym.ppuload(ppufile);
  330. ibconstsym : sym:=tconstsym.ppuload(ppufile);
  331. ibvarsym : sym:=tvarsym.ppuload(ppufile);
  332. ibfuncretsym : sym:=tfuncretsym.ppuload(ppufile);
  333. ibabsolutesym : sym:=tabsolutesym.ppuload(ppufile);
  334. ibenumsym : sym:=tenumsym.ppuload(ppufile);
  335. ibtypedconstsym : sym:=ttypedconstsym.ppuload(ppufile);
  336. ibpropertysym : sym:=tpropertysym.ppuload(ppufile);
  337. ibunitsym : sym:=tunitsym.ppuload(ppufile);
  338. iblabelsym : sym:=tlabelsym.ppuload(ppufile);
  339. ibsyssym : sym:=tsyssym.ppuload(ppufile);
  340. ibrttisym : sym:=trttisym.ppuload(ppufile);
  341. ibendsyms : break;
  342. ibend : Message(unit_f_ppu_read_error);
  343. else
  344. Message1(unit_f_ppu_invalid_entry,tostr(b));
  345. end;
  346. sym.owner:=self;
  347. symindex.insert(sym);
  348. symsearch.insert(sym);
  349. until false;
  350. end;
  351. procedure tstoredsymtable.writedefs(ppufile:tcompilerppufile);
  352. var
  353. pd : tstoreddef;
  354. begin
  355. { each definition get a number, write then the amount of defs to the
  356. ibstartdef entry }
  357. ppufile.putlongint(defindex.count);
  358. ppufile.writeentry(ibstartdefs);
  359. { now write the definition }
  360. pd:=tstoreddef(defindex.first);
  361. while assigned(pd) do
  362. begin
  363. pd.ppuwrite(ppufile);
  364. pd:=tstoreddef(pd.indexnext);
  365. end;
  366. { write end of definitions }
  367. ppufile.writeentry(ibenddefs);
  368. end;
  369. procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
  370. var
  371. pd : tstoredsym;
  372. begin
  373. { each definition get a number, write then the amount of syms and the
  374. datasize to the ibsymdef entry }
  375. ppufile.putlongint(symindex.count);
  376. ppufile.putlongint(datasize);
  377. ppufile.putlongint(dataalignment);
  378. ppufile.writeentry(ibstartsyms);
  379. { foreach is used to write all symbols }
  380. pd:=tstoredsym(symindex.first);
  381. while assigned(pd) do
  382. begin
  383. pd.ppuwrite(ppufile);
  384. pd:=tstoredsym(pd.indexnext);
  385. end;
  386. { end of symbols }
  387. ppufile.writeentry(ibendsyms);
  388. end;
  389. procedure tstoredsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  390. var
  391. b : byte;
  392. sym : tstoredsym;
  393. prdef : tstoreddef;
  394. begin
  395. b:=ppufile.readentry;
  396. if b <> ibbeginsymtablebrowser then
  397. Message1(unit_f_ppu_invalid_entry,tostr(b));
  398. repeat
  399. b:=ppufile.readentry;
  400. case b of
  401. ibsymref :
  402. begin
  403. sym:=tstoredsym(ppufile.getderef);
  404. resolvesym(pointer(sym));
  405. if assigned(sym) then
  406. sym.load_references(ppufile,locals);
  407. end;
  408. ibdefref :
  409. begin
  410. prdef:=tstoreddef(ppufile.getderef);
  411. resolvedef(pointer(prdef));
  412. if assigned(prdef) then
  413. begin
  414. if prdef.deftype<>procdef then
  415. Message(unit_f_ppu_read_error);
  416. tprocdef(prdef).load_references(ppufile,locals);
  417. end;
  418. end;
  419. ibendsymtablebrowser :
  420. break;
  421. else
  422. Message1(unit_f_ppu_invalid_entry,tostr(b));
  423. end;
  424. until false;
  425. end;
  426. procedure tstoredsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  427. var
  428. pd : tstoredsym;
  429. begin
  430. ppufile.writeentry(ibbeginsymtablebrowser);
  431. { write all symbols }
  432. pd:=tstoredsym(symindex.first);
  433. while assigned(pd) do
  434. begin
  435. pd.write_references(ppufile,locals);
  436. pd:=tstoredsym(pd.indexnext);
  437. end;
  438. ppufile.writeentry(ibendsymtablebrowser);
  439. end;
  440. procedure tstoredsymtable.deref;
  441. var
  442. hp : tdef;
  443. hs : tsym;
  444. begin
  445. { first deref the interface ttype symbols. This is needs
  446. to be done before the interface defs are derefed, because
  447. the interface defs can contain references to the type symbols
  448. which then already need to contain a resolved restype field (PFV) }
  449. hs:=tsym(symindex.first);
  450. while assigned(hs) do
  451. begin
  452. if hs.typ=typesym then
  453. hs.deref;
  454. hs:=tsym(hs.indexnext);
  455. end;
  456. { deref the interface definitions }
  457. hp:=tdef(defindex.first);
  458. while assigned(hp) do
  459. begin
  460. hp.deref;
  461. hp:=tdef(hp.indexnext);
  462. end;
  463. { deref the interface symbols }
  464. hs:=tsym(symindex.first);
  465. while assigned(hs) do
  466. begin
  467. if hs.typ<>typesym then
  468. hs.deref;
  469. hs:=tsym(hs.indexnext);
  470. end;
  471. end;
  472. procedure tstoredsymtable.derefimpl;
  473. var
  474. hp : tdef;
  475. begin
  476. { deref the implementation part of definitions }
  477. hp:=tdef(defindex.first);
  478. while assigned(hp) do
  479. begin
  480. hp.derefimpl;
  481. hp:=tdef(hp.indexnext);
  482. end;
  483. end;
  484. procedure tstoredsymtable.insert(sym:tsymentry);
  485. var
  486. hsym : tsym;
  487. begin
  488. { set owner and sym indexnb }
  489. sym.owner:=self;
  490. { check the current symtable }
  491. hsym:=tsym(search(sym.name));
  492. if assigned(hsym) then
  493. begin
  494. { in TP and Delphi you can have a local with the
  495. same name as the function, the function is then hidden for
  496. the user. (Under delphi it can still be accessed using result),
  497. but don't allow hiding of RESULT }
  498. if (m_duplicate_names in aktmodeswitches) and
  499. (hsym.typ=funcretsym) and
  500. not((m_result in aktmodeswitches) and
  501. (hsym.name='RESULT')) then
  502. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  503. else
  504. begin
  505. DuplicateSym(hsym);
  506. exit;
  507. end;
  508. end;
  509. { register definition of typesym }
  510. if (sym.typ = typesym) and
  511. assigned(ttypesym(sym).restype.def) then
  512. begin
  513. if not(assigned(ttypesym(sym).restype.def.owner)) and
  514. (ttypesym(sym).restype.def.deftype<>errordef) then
  515. registerdef(ttypesym(sym).restype.def);
  516. {$ifdef GDB}
  517. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  518. (symtabletype in [globalsymtable,staticsymtable]) then
  519. begin
  520. ttypesym(sym).isusedinstab := true;
  521. {sym.concatstabto(debuglist);}
  522. end;
  523. {$endif GDB}
  524. end;
  525. { insert in index and search hash }
  526. symindex.insert(sym);
  527. symsearch.insert(sym);
  528. end;
  529. function tstoredsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
  530. var
  531. hp : tstoredsym;
  532. newref : tref;
  533. begin
  534. hp:=tstoredsym(inherited speedsearch(s,speedvalue));
  535. if assigned(hp) then
  536. begin
  537. { reject non static members in static procedures }
  538. if (symtabletype=objectsymtable) and
  539. not(sp_static in hp.symoptions) and
  540. allow_only_static then
  541. Message(sym_e_only_static_in_static);
  542. { unit uses count }
  543. if (unitid<>0) and
  544. (symtabletype = globalsymtable) and
  545. assigned(tglobalsymtable(self).unitsym) then
  546. inc(tglobalsymtable(self).unitsym.refs);
  547. {$ifdef GDB}
  548. { if it is a type, we need the stabs of this type
  549. this might be the cause of the class debug problems
  550. as TCHILDCLASS.Create did not generate appropriate
  551. stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
  552. if (cs_debuginfo in aktmoduleswitches) and
  553. (hp.typ=typesym) and
  554. make_ref then
  555. begin
  556. if assigned(ttypesym(hp).restype.def) then
  557. tstoreddef(ttypesym(hp).restype.def).numberstring
  558. else
  559. ttypesym(hp).isusedinstab:=true;
  560. end;
  561. {$endif GDB}
  562. { unitsym are only loaded for browsing PM }
  563. { this was buggy anyway because we could use }
  564. { unitsyms from other units in _USES !! }
  565. {if (symtabletype=unitsymtable) and (hp.typ=unitsym) and
  566. assigned(current_module) and (current_module.globalsymtable<>.load) then
  567. hp:=nil;}
  568. if make_ref and (cs_browser in aktmoduleswitches) then
  569. begin
  570. newref:=tref.create(hp.lastref,@akttokenpos);
  571. { for symbols that are in tables without browser info or syssyms }
  572. if hp.refcount=0 then
  573. begin
  574. hp.defref:=newref;
  575. hp.lastref:=newref;
  576. end
  577. else
  578. if resolving_forward and assigned(hp.defref) then
  579. { put it as second reference }
  580. begin
  581. newref.nextref:=hp.defref.nextref;
  582. hp.defref.nextref:=newref;
  583. hp.lastref.nextref:=nil;
  584. end
  585. else
  586. hp.lastref:=newref;
  587. inc(hp.refcount);
  588. end;
  589. if make_ref then
  590. inc(hp.refs);
  591. end; { value was not found }
  592. speedsearch:=hp;
  593. end;
  594. {**************************************
  595. Callbacks
  596. **************************************}
  597. procedure TStoredSymtable.check_forward(sym : TNamedIndexItem;arg:pointer);
  598. begin
  599. if tsym(sym).typ=procsym then
  600. tprocsym(sym).check_forward
  601. { check also object method table }
  602. { we needn't to test the def list }
  603. { because each object has to have a type sym }
  604. else
  605. if (tsym(sym).typ=typesym) and
  606. assigned(ttypesym(sym).restype.def) and
  607. (ttypesym(sym).restype.def.deftype=objectdef) then
  608. tobjectdef(ttypesym(sym).restype.def).check_forwards;
  609. end;
  610. procedure TStoredSymtable.labeldefined(p : TNamedIndexItem;arg:pointer);
  611. begin
  612. if (tsym(p).typ=labelsym) and
  613. not(tlabelsym(p).defined) then
  614. begin
  615. if tlabelsym(p).used then
  616. Message1(sym_e_label_used_and_not_defined,tlabelsym(p).realname)
  617. else
  618. Message1(sym_w_label_not_defined,tlabelsym(p).realname);
  619. end;
  620. end;
  621. procedure TStoredSymtable.unitsymbolused(p : TNamedIndexItem;arg:pointer);
  622. begin
  623. if (tsym(p).typ=unitsym) and
  624. (tunitsym(p).refs=0) and
  625. { do not claim for unit name itself !! }
  626. assigned(tunitsym(p).unitsymtable) and
  627. (tunitsym(p).unitsymtable.symtabletype=globalsymtable) then
  628. MessagePos2(tsym(p).fileinfo,sym_n_unit_not_used,p.name,current_module.modulename^);
  629. end;
  630. procedure TStoredSymtable.varsymbolused(p : TNamedIndexItem;arg:pointer);
  631. begin
  632. if (tsym(p).typ=varsym) and
  633. ((tsym(p).owner.symtabletype in
  634. [parasymtable,localsymtable,objectsymtable,staticsymtable])) then
  635. begin
  636. { unused symbol should be reported only if no }
  637. { error is reported }
  638. { if the symbol is in a register it is used }
  639. { also don't count the value parameters which have local copies }
  640. { also don't claim for high param of open parameters (PM) }
  641. if (Errorcount<>0) or
  642. (copy(p.name,1,3)='val') or
  643. (copy(p.name,1,6)='hidden') or
  644. (copy(p.name,1,4)='high') then
  645. exit;
  646. if (tvarsym(p).refs=0) then
  647. begin
  648. if (tsym(p).owner.symtabletype=parasymtable) or (vo_is_local_copy in tvarsym(p).varoptions) then
  649. begin
  650. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname);
  651. end
  652. else if (tsym(p).owner.symtabletype=objectsymtable) then
  653. MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
  654. else
  655. MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_not_used,tsym(p).realname);
  656. end
  657. else if tvarsym(p).varstate=vs_assigned then
  658. begin
  659. if (tsym(p).owner.symtabletype=parasymtable) then
  660. begin
  661. if not(tvarsym(p).varspez in [vs_var,vs_out]) then
  662. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname)
  663. end
  664. else if (vo_is_local_copy in tvarsym(p).varoptions) then
  665. begin
  666. if not(tvarsym(p).varspez in [vs_var,vs_out]) then
  667. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname);
  668. end
  669. else if (tsym(p).owner.symtabletype=objectsymtable) then
  670. MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_only_set,tsym(p).owner.realname^,tsym(p).realname)
  671. else if (tsym(p).owner.symtabletype<>parasymtable) then
  672. if not (vo_is_exported in tvarsym(p).varoptions) then
  673. MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
  674. end;
  675. end
  676. else if ((tsym(p).owner.symtabletype in
  677. [objectsymtable,parasymtable,localsymtable,staticsymtable])) then
  678. begin
  679. if (Errorcount<>0) then
  680. exit;
  681. { do not claim for inherited private fields !! }
  682. if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
  683. MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
  684. { units references are problematic }
  685. else if (tstoredsym(p).refs=0) and not(tsym(p).typ in [funcretsym,enumsym,unitsym]) then
  686. if (tsym(p).typ<>procsym) or not (tprocsym(p).is_global) or
  687. { all program functions are declared global
  688. but unused should still be signaled PM }
  689. ((tsym(p).owner.symtabletype=staticsymtable) and
  690. not current_module.is_unit) then
  691. MessagePos2(tsym(p).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(p).typ],tsym(p).realname);
  692. end;
  693. end;
  694. procedure TStoredSymtable.TestPrivate(p : TNamedIndexItem;arg:pointer);
  695. begin
  696. if sp_private in tsym(p).symoptions then
  697. varsymbolused(p,arg);
  698. end;
  699. procedure TStoredSymtable.objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
  700. begin
  701. {
  702. Don't test simple object aliases PM
  703. }
  704. if (tsym(p).typ=typesym) and
  705. (ttypesym(p).restype.def.deftype=objectdef) and
  706. (ttypesym(p).restype.def.typesym=tsym(p)) then
  707. tobjectdef(ttypesym(p).restype.def).symtable.foreach({$ifdef FPCPROCVAR}@{$endif}TestPrivate,nil);
  708. end;
  709. procedure tstoredsymtable.unchain_overloads(p : TNamedIndexItem;arg:pointer);
  710. begin
  711. if tsym(p).typ=procsym then
  712. tprocsym(p).unchain_overload;
  713. end;
  714. {$ifdef GDB}
  715. procedure TStoredSymtable.concatstab(p : TNamedIndexItem;arg:pointer);
  716. begin
  717. if tsym(p).typ <> procsym then
  718. tstoredsym(p).concatstabto(TAAsmOutput(arg));
  719. end;
  720. procedure TStoredSymtable.resetstab(p : TNamedIndexItem;arg:pointer);
  721. begin
  722. if tsym(p).typ <> procsym then
  723. tstoredsym(p).isstabwritten:=false;
  724. end;
  725. procedure TStoredSymtable.concattypestab(p : TNamedIndexItem;arg:pointer);
  726. begin
  727. if tsym(p).typ = typesym then
  728. begin
  729. tstoredsym(p).isstabwritten:=false;
  730. tstoredsym(p).concatstabto(TAAsmOutput(arg));
  731. end;
  732. end;
  733. function tstoredsymtable.getnewtypecount : word;
  734. begin
  735. getnewtypecount:=pglobaltypecount^;
  736. inc(pglobaltypecount^);
  737. end;
  738. {$endif GDB}
  739. procedure tstoredsymtable.chainoperators;
  740. var
  741. t : ttoken;
  742. srsym : tsym;
  743. srsymtable,
  744. storesymtablestack : tsymtable;
  745. begin
  746. storesymtablestack:=symtablestack;
  747. symtablestack:=self;
  748. make_ref:=false;
  749. for t:=first_overloaded to last_overloaded do
  750. begin
  751. overloaded_operators[t]:=nil;
  752. { each operator has a unique lowercased internal name PM }
  753. while assigned(symtablestack) do
  754. begin
  755. searchsym(overloaded_names[t],srsym,srsymtable);
  756. if not assigned(srsym) then
  757. begin
  758. if (t=_STARSTAR) then
  759. begin
  760. symtablestack:=systemunit;
  761. searchsym('POWER',srsym,srsymtable);
  762. end;
  763. end;
  764. if assigned(srsym) then
  765. begin
  766. if (srsym.typ<>procsym) then
  767. internalerror(12344321);
  768. { use this procsym as start ? }
  769. if not assigned(overloaded_operators[t]) then
  770. overloaded_operators[t]:=tprocsym(srsym)
  771. else
  772. { already got a procsym, only add defs of the current procsym }
  773. Tprocsym(srsym).concat_procdefs_to(overloaded_operators[t]);
  774. symtablestack:=srsym.owner.next;
  775. end
  776. else
  777. begin
  778. symtablestack:=nil;
  779. end;
  780. { search for same procsym in other units }
  781. end;
  782. symtablestack:=self;
  783. end;
  784. make_ref:=true;
  785. symtablestack:=storesymtablestack;
  786. end;
  787. {***********************************************
  788. Process all entries
  789. ***********************************************}
  790. { checks, if all procsyms and methods are defined }
  791. procedure tstoredsymtable.check_forwards;
  792. begin
  793. foreach({$ifdef FPCPROCVAR}@{$endif}check_forward,nil);
  794. end;
  795. procedure tstoredsymtable.checklabels;
  796. begin
  797. foreach({$ifdef FPCPROCVAR}@{$endif}labeldefined,nil);
  798. end;
  799. procedure tstoredsymtable.allunitsused;
  800. begin
  801. foreach({$ifdef FPCPROCVAR}@{$endif}unitsymbolused,nil);
  802. end;
  803. procedure tstoredsymtable.allsymbolsused;
  804. begin
  805. foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused,nil);
  806. end;
  807. procedure tstoredsymtable.allprivatesused;
  808. begin
  809. foreach({$ifdef FPCPROCVAR}@{$endif}objectprivatesymbolused,nil);
  810. end;
  811. procedure tstoredsymtable.unchain_overloaded;
  812. begin
  813. foreach({$ifdef FPCPROCVAR}@{$endif}unchain_overloads,nil);
  814. end;
  815. {$ifdef GDB}
  816. procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
  817. begin
  818. if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
  819. foreach({$ifdef FPCPROCVAR}@{$endif}resetstab,nil);
  820. foreach({$ifdef FPCPROCVAR}@{$endif}concatstab,asmlist);
  821. end;
  822. {$endif}
  823. procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer);
  824. begin
  825. if b_needs_init_final then
  826. exit;
  827. case tsym(p).typ of
  828. varsym :
  829. begin
  830. if not(is_class(tvarsym(p).vartype.def)) and
  831. tstoreddef(tvarsym(p).vartype.def).needs_inittable then
  832. b_needs_init_final:=true;
  833. end;
  834. typedconstsym :
  835. begin
  836. if ttypedconstsym(p).is_writable and
  837. tstoreddef(ttypedconstsym(p).typedconsttype.def).needs_inittable then
  838. b_needs_init_final:=true;
  839. end;
  840. end;
  841. end;
  842. { returns true, if p contains data which needs init/final code }
  843. function tstoredsymtable.needs_init_final : boolean;
  844. begin
  845. b_needs_init_final:=false;
  846. foreach({$ifdef FPCPROCVAR}@{$endif}_needs_init_final,nil);
  847. needs_init_final:=b_needs_init_final;
  848. end;
  849. {****************************************************************************
  850. TAbstractRecordSymtable
  851. ****************************************************************************}
  852. procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
  853. var
  854. storesymtable : tsymtable;
  855. begin
  856. storesymtable:=aktrecordsymtable;
  857. aktrecordsymtable:=self;
  858. inherited ppuload(ppufile);
  859. aktrecordsymtable:=storesymtable;
  860. end;
  861. procedure tabstractrecordsymtable.ppuwrite(ppufile:tcompilerppufile);
  862. var
  863. oldtyp : byte;
  864. storesymtable : tsymtable;
  865. begin
  866. storesymtable:=aktrecordsymtable;
  867. aktrecordsymtable:=self;
  868. oldtyp:=ppufile.entrytyp;
  869. ppufile.entrytyp:=subentryid;
  870. inherited ppuwrite(ppufile);
  871. ppufile.entrytyp:=oldtyp;
  872. aktrecordsymtable:=storesymtable;
  873. end;
  874. procedure tabstractrecordsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  875. var
  876. storesymtable : tsymtable;
  877. begin
  878. storesymtable:=aktrecordsymtable;
  879. aktrecordsymtable:=self;
  880. inherited load_references(ppufile,locals);
  881. aktrecordsymtable:=storesymtable;
  882. end;
  883. procedure tabstractrecordsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  884. var
  885. storesymtable : tsymtable;
  886. begin
  887. storesymtable:=aktrecordsymtable;
  888. aktrecordsymtable:=self;
  889. inherited write_references(ppufile,locals);
  890. aktrecordsymtable:=storesymtable;
  891. end;
  892. procedure tabstractrecordsymtable.insertvardata(sym : tsymentry);
  893. var
  894. l,varalign : longint;
  895. vardef : tdef;
  896. begin
  897. if sym.typ<>varsym then
  898. internalerror(200208251);
  899. l:=tvarsym(sym).getvaluesize;
  900. vardef:=tvarsym(sym).vartype.def;
  901. { this symbol can't be loaded to a register }
  902. exclude(tvarsym(sym).varoptions,vo_regable);
  903. exclude(tvarsym(sym).varoptions,vo_fpuregable);
  904. { get the alignment size }
  905. if (aktalignment.recordalignmax=-1) then
  906. begin
  907. varalign:=vardef.alignment;
  908. if (varalign>4) and
  909. ((varalign mod 4)<>0) and
  910. (vardef.deftype=arraydef) then
  911. Message1(sym_w_wrong_C_pack,vardef.typename);
  912. if varalign=0 then
  913. varalign:=l;
  914. if (dataalignment<aktalignment.maxCrecordalign) then
  915. begin
  916. if (varalign>16) and (dataalignment<32) then
  917. dataalignment:=32
  918. else if (varalign>12) and (dataalignment<16) then
  919. dataalignment:=16
  920. { 12 is needed for long double }
  921. else if (varalign>8) and (dataalignment<12) then
  922. dataalignment:=12
  923. else if (varalign>4) and (dataalignment<8) then
  924. dataalignment:=8
  925. else if (varalign>2) and (dataalignment<4) then
  926. dataalignment:=4
  927. else if (varalign>1) and (dataalignment<2) then
  928. dataalignment:=2;
  929. end;
  930. dataalignment:=min(dataalignment,aktalignment.maxCrecordalign);
  931. end
  932. else
  933. varalign:=vardef.alignment;
  934. if varalign=0 then
  935. varalign:=size_2_align(l);
  936. varalign:=used_align(varalign,aktalignment.recordalignmin,dataalignment);
  937. tvarsym(sym).address:=align(datasize,varalign);
  938. datasize:=tvarsym(sym).address+l;
  939. end;
  940. {****************************************************************************
  941. TRecordSymtable
  942. ****************************************************************************}
  943. constructor trecordsymtable.create;
  944. begin
  945. inherited create('');
  946. symtabletype:=recordsymtable;
  947. end;
  948. { this procedure is reserved for inserting case variant into
  949. a record symtable }
  950. { the offset is the location of the start of the variant
  951. and datasize and dataalignment corresponds to
  952. the complete size (see code in pdecl unit) PM }
  953. procedure trecordsymtable.insert_in(tsymt : tsymtable;offset : longint);
  954. var
  955. ps,nps : tvarsym;
  956. pd,npd : tdef;
  957. storesize,storealign : longint;
  958. begin
  959. storesize:=tsymt.datasize;
  960. storealign:=tsymt.dataalignment;
  961. tsymt.datasize:=offset;
  962. ps:=tvarsym(symindex.first);
  963. while assigned(ps) do
  964. begin
  965. nps:=tvarsym(ps.indexnext);
  966. { remove from current symtable }
  967. symindex.deleteindex(ps);
  968. ps.left:=nil;
  969. ps.right:=nil;
  970. { add to symt }
  971. ps.owner:=tsymt;
  972. tsymt.datasize:=ps.address+offset;
  973. tsymt.symindex.insert(ps);
  974. tsymt.symsearch.insert(ps);
  975. { update address }
  976. ps.address:=tsymt.datasize;
  977. { next }
  978. ps:=nps;
  979. end;
  980. pd:=tdef(defindex.first);
  981. while assigned(pd) do
  982. begin
  983. npd:=tdef(pd.indexnext);
  984. defindex.deleteindex(pd);
  985. pd.left:=nil;
  986. pd.right:=nil;
  987. tsymt.registerdef(pd);
  988. pd:=npd;
  989. end;
  990. tsymt.datasize:=storesize;
  991. tsymt.dataalignment:=storealign;
  992. end;
  993. {****************************************************************************
  994. TObjectSymtable
  995. ****************************************************************************}
  996. constructor tobjectsymtable.create(const n:string);
  997. begin
  998. inherited create(n);
  999. symtabletype:=objectsymtable;
  1000. end;
  1001. procedure tobjectsymtable.insert(sym:tsymentry);
  1002. var
  1003. hsym : tsym;
  1004. begin
  1005. { check for duplicate field id in inherited classes }
  1006. if (sym.typ=varsym) and
  1007. assigned(defowner) and
  1008. (
  1009. not(m_delphi in aktmodeswitches) or
  1010. is_object(tdef(defowner))
  1011. ) then
  1012. begin
  1013. { but private ids can be reused }
  1014. hsym:=search_class_member(tobjectdef(defowner),sym.name);
  1015. if assigned(hsym) and
  1016. tstoredsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
  1017. begin
  1018. DuplicateSym(hsym);
  1019. exit;
  1020. end;
  1021. end;
  1022. inherited insert(sym);
  1023. end;
  1024. {****************************************************************************
  1025. TAbstractLocalSymtable
  1026. ****************************************************************************}
  1027. procedure tabstractlocalsymtable.ppuload(ppufile:tcompilerppufile);
  1028. var
  1029. storesymtable : tsymtable;
  1030. begin
  1031. storesymtable:=aktlocalsymtable;
  1032. aktlocalsymtable:=self;
  1033. inherited ppuload(ppufile);
  1034. aktlocalsymtable:=storesymtable;
  1035. end;
  1036. procedure tabstractlocalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1037. var
  1038. oldtyp : byte;
  1039. storesymtable : tsymtable;
  1040. begin
  1041. storesymtable:=aktlocalsymtable;
  1042. aktlocalsymtable:=self;
  1043. oldtyp:=ppufile.entrytyp;
  1044. ppufile.entrytyp:=subentryid;
  1045. { write definitions }
  1046. writedefs(ppufile);
  1047. { write symbols }
  1048. writesyms(ppufile);
  1049. ppufile.entrytyp:=oldtyp;
  1050. aktlocalsymtable:=storesymtable;
  1051. end;
  1052. procedure tabstractlocalsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  1053. var
  1054. storesymtable : tsymtable;
  1055. begin
  1056. storesymtable:=aktlocalsymtable;
  1057. aktlocalsymtable:=self;
  1058. inherited load_references(ppufile,locals);
  1059. aktlocalsymtable:=storesymtable;
  1060. end;
  1061. procedure tabstractlocalsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  1062. var
  1063. storesymtable : tsymtable;
  1064. begin
  1065. storesymtable:=aktlocalsymtable;
  1066. aktlocalsymtable:=self;
  1067. inherited write_references(ppufile,locals);
  1068. aktlocalsymtable:=storesymtable;
  1069. end;
  1070. {****************************************************************************
  1071. TLocalSymtable
  1072. ****************************************************************************}
  1073. constructor tlocalsymtable.create;
  1074. begin
  1075. inherited create('');
  1076. symtabletype:=localsymtable;
  1077. end;
  1078. procedure tlocalsymtable.insert(sym:tsymentry);
  1079. var
  1080. hsym : tsym;
  1081. begin
  1082. if assigned(next) then
  1083. begin
  1084. if (next.symtabletype=parasymtable) then
  1085. begin
  1086. hsym:=tsym(next.search(sym.name));
  1087. if assigned(hsym) then
  1088. begin
  1089. { a parameter and the function can have the same
  1090. name in TP and Delphi, but RESULT not }
  1091. if (m_duplicate_names in aktmodeswitches) and
  1092. (sym.typ=funcretsym) and
  1093. not((m_result in aktmodeswitches) and
  1094. (sym.name='RESULT')) then
  1095. sym.name:='hidden'+sym.name
  1096. else
  1097. begin
  1098. DuplicateSym(hsym);
  1099. exit;
  1100. end;
  1101. end;
  1102. end;
  1103. { check for duplicate id in local symtable of methods }
  1104. if assigned(next.next) and
  1105. { funcretsym is allowed !! }
  1106. (sym.typ <> funcretsym) and
  1107. (next.next.symtabletype=objectsymtable) then
  1108. begin
  1109. hsym:=search_class_member(tobjectdef(next.next.defowner),sym.name);
  1110. if assigned(hsym) and
  1111. { private ids can be reused }
  1112. (not(sp_private in hsym.symoptions) or
  1113. (hsym.owner.defowner.owner.symtabletype<>globalsymtable)) then
  1114. begin
  1115. { delphi allows to reuse the names in a class, but not
  1116. in object (tp7 compatible) }
  1117. if not((m_delphi in aktmodeswitches) and
  1118. is_class(tdef(next.next.defowner))) then
  1119. begin
  1120. DuplicateSym(hsym);
  1121. exit;
  1122. end;
  1123. end;
  1124. end;
  1125. end;
  1126. inherited insert(sym);
  1127. end;
  1128. procedure tlocalsymtable.insertvardata(sym : tsymentry);
  1129. var
  1130. l,varalign : longint;
  1131. begin
  1132. if not(sym.typ in [varsym,funcretsym]) then
  1133. internalerror(200208255);
  1134. case sym.typ of
  1135. varsym :
  1136. begin
  1137. tvarsym(sym).varstate:=vs_declared;
  1138. l:=tvarsym(sym).getvaluesize;
  1139. varalign:=size_2_align(l);
  1140. varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
  1141. {$ifdef powerpc}
  1142. { on the powerpc, the local variables are accessed with a positiv offset }
  1143. tvarsym(sym).address:=align(datasize,varalign);
  1144. datasize:=tvarsym(sym).address+l;
  1145. {$else powerpc}
  1146. tvarsym(sym).address:=align(datasize+l,varalign);
  1147. datasize:=tvarsym(sym).address;
  1148. {$endif powerpc}
  1149. end;
  1150. funcretsym :
  1151. begin
  1152. { if retoffset is already set then reuse it, this is needed
  1153. when inserting the result variable }
  1154. if procinfo.return_offset<>0 then
  1155. tfuncretsym(sym).address:=procinfo.return_offset
  1156. else
  1157. begin
  1158. { allocate space in local if ret in register }
  1159. if paramanager.ret_in_reg(tfuncretsym(sym).returntype.def,
  1160. tprocdef(sym.owner.defowner).proccalloption) then
  1161. begin
  1162. l:=tfuncretsym(sym).returntype.def.size;
  1163. varalign:=size_2_align(l);
  1164. varalign:=used_align(varalign,aktalignment.localalignmin,dataalignment);
  1165. tfuncretsym(sym).address:=align(datasize+l,varalign);
  1166. datasize:=tfuncretsym(sym).address;
  1167. procinfo.return_offset:=-tfuncretsym(sym).address;
  1168. end;
  1169. end;
  1170. end;
  1171. end;
  1172. end;
  1173. procedure tlocalsymtable.insertconstdata(sym : tsymentry);
  1174. { this does not affect the local stack space, since all
  1175. typed constansts and initialized variables are always
  1176. put in the .data / .rodata section
  1177. }
  1178. var
  1179. storefilepos : tfileposinfo;
  1180. curconstsegment : taasmoutput;
  1181. l : longint;
  1182. begin
  1183. { Note: this is the same code as tabstractunitsymtable.insertconstdata }
  1184. if sym.typ<>typedconstsym then
  1185. internalerror(200208254);
  1186. storefilepos:=aktfilepos;
  1187. aktfilepos:=tsym(sym).fileinfo;
  1188. if ttypedconstsym(sym).is_writable then
  1189. curconstsegment:=datasegment
  1190. else
  1191. curconstsegment:=consts;
  1192. l:=ttypedconstsym(sym).getsize;
  1193. { insert cut for smartlinking or alignment }
  1194. if (cs_create_smart in aktmoduleswitches) then
  1195. curconstSegment.concat(Tai_cut.Create);
  1196. curconstSegment.concat(Tai_align.create(const_align(l)));
  1197. {$ifdef GDB}
  1198. if cs_debuginfo in aktmoduleswitches then
  1199. ttypedconstsym(sym).concatstabto(curconstsegment);
  1200. {$endif GDB}
  1201. if (cs_create_smart in aktmoduleswitches) or
  1202. DLLSource then
  1203. begin
  1204. curconstSegment.concat(Tai_symbol.Createdataname_global(
  1205. ttypedconstsym(sym).mangledname,l));
  1206. end
  1207. else
  1208. begin
  1209. curconstSegment.concat(Tai_symbol.Createdataname(
  1210. ttypedconstsym(sym).mangledname,l));
  1211. end;
  1212. aktfilepos:=storefilepos;
  1213. end;
  1214. {****************************************************************************
  1215. TParaSymtable
  1216. ****************************************************************************}
  1217. constructor tparasymtable.create;
  1218. begin
  1219. inherited create('');
  1220. symtabletype:=parasymtable;
  1221. dataalignment:=aktalignment.paraalign;
  1222. end;
  1223. procedure tparasymtable.insert(sym:tsymentry);
  1224. var
  1225. hsym : tsym;
  1226. begin
  1227. { check for duplicate id in para symtable of methods }
  1228. if assigned(procinfo) and
  1229. assigned(procinfo._class) and
  1230. { but not in nested procedures !}
  1231. (not(assigned(procinfo.parent)) or
  1232. (assigned(procinfo.parent) and
  1233. not(assigned(procinfo.parent._class)))
  1234. ) and
  1235. { funcretsym is allowed !! }
  1236. (sym.typ<>funcretsym) then
  1237. begin
  1238. hsym:=search_class_member(procinfo._class,sym.name);
  1239. { private ids can be reused }
  1240. if assigned(hsym) and
  1241. tstoredsym(hsym).is_visible_for_object(procinfo._class) then
  1242. begin
  1243. { delphi allows to reuse the names in a class, but not
  1244. in object (tp7 compatible) }
  1245. if not((m_delphi in aktmodeswitches) and
  1246. is_class_or_interface(procinfo._class)) then
  1247. begin
  1248. DuplicateSym(hsym);
  1249. exit;
  1250. end;
  1251. end;
  1252. end;
  1253. inherited insert(sym);
  1254. end;
  1255. procedure tparasymtable.insertvardata(sym : tsymentry);
  1256. var
  1257. l,varalign : longint;
  1258. begin
  1259. if sym.typ<>varsym then
  1260. internalerror(200208253);
  1261. { retrieve cdecl status }
  1262. if defowner.deftype<>procdef then
  1263. internalerror(200208256);
  1264. { here we need the size of a push instead of the
  1265. size of the data }
  1266. l:=paramanager.push_size(tvarsym(sym).varspez,tvarsym(sym).vartype.def,tprocdef(defowner).proccalloption);
  1267. varalign:=size_2_align(l);
  1268. tvarsym(sym).varstate:=vs_assigned;
  1269. { we need the new datasize already aligned so we can't
  1270. use the align_address here }
  1271. tvarsym(sym).address:=datasize;
  1272. varalign:=used_align(varalign,dataalignment,dataalignment);
  1273. datasize:=align(tvarsym(sym).address+l,varalign);
  1274. end;
  1275. {****************************************************************************
  1276. TAbstractUnitSymtable
  1277. ****************************************************************************}
  1278. constructor tabstractunitsymtable.create(const n : string);
  1279. begin
  1280. inherited create(n);
  1281. symsearch.usehash;
  1282. {$ifdef GDB}
  1283. { reset GDB things }
  1284. prev_dbx_counter := dbx_counter;
  1285. dbx_counter := nil;
  1286. is_stab_written:=false;
  1287. dbx_count := -1;
  1288. {$endif GDB}
  1289. end;
  1290. procedure tabstractunitsymtable.insertvardata(sym : tsymentry);
  1291. var
  1292. l,varalign : longint;
  1293. storefilepos : tfileposinfo;
  1294. begin
  1295. if sym.typ<>varsym then
  1296. internalerror(200208252);
  1297. storefilepos:=aktfilepos;
  1298. aktfilepos:=tsym(sym).fileinfo;
  1299. l:=tvarsym(sym).getvaluesize;
  1300. if (vo_is_thread_var in tvarsym(sym).varoptions) then
  1301. inc(l,pointer_size);
  1302. varalign:=var_align(l);
  1303. tvarsym(sym).address:=align(datasize,varalign);
  1304. { insert cut for smartlinking or alignment }
  1305. if (cs_create_smart in aktmoduleswitches) then
  1306. bssSegment.concat(Tai_cut.Create);
  1307. bssSegment.concat(Tai_align.create(varalign));
  1308. datasize:=tvarsym(sym).address+l;
  1309. {$ifdef GDB}
  1310. if cs_debuginfo in aktmoduleswitches then
  1311. tvarsym(sym).concatstabto(bsssegment);
  1312. {$endif GDB}
  1313. if (symtabletype=globalsymtable) or
  1314. (cs_create_smart in aktmoduleswitches) or
  1315. DLLSource or
  1316. (vo_is_exported in tvarsym(sym).varoptions) or
  1317. (vo_is_C_var in tvarsym(sym).varoptions) then
  1318. bssSegment.concat(Tai_datablock.Create_global(tvarsym(sym).mangledname,l))
  1319. else
  1320. bssSegment.concat(Tai_datablock.Create(tvarsym(sym).mangledname,l));
  1321. aktfilepos:=storefilepos;
  1322. end;
  1323. procedure tabstractunitsymtable.insertconstdata(sym : tsymentry);
  1324. var
  1325. storefilepos : tfileposinfo;
  1326. curconstsegment : taasmoutput;
  1327. l : longint;
  1328. begin
  1329. if sym.typ<>typedconstsym then
  1330. internalerror(200208254);
  1331. storefilepos:=aktfilepos;
  1332. aktfilepos:=tsym(sym).fileinfo;
  1333. if ttypedconstsym(sym).is_writable then
  1334. curconstsegment:=datasegment
  1335. else
  1336. curconstsegment:=consts;
  1337. l:=ttypedconstsym(sym).getsize;
  1338. { insert cut for smartlinking or alignment }
  1339. if (cs_create_smart in aktmoduleswitches) then
  1340. curconstSegment.concat(Tai_cut.Create);
  1341. curconstSegment.concat(Tai_align.create(const_align(l)));
  1342. {$ifdef GDB}
  1343. if cs_debuginfo in aktmoduleswitches then
  1344. ttypedconstsym(sym).concatstabto(curconstsegment);
  1345. {$endif GDB}
  1346. if (symtabletype=globalsymtable) or
  1347. (cs_create_smart in aktmoduleswitches) or
  1348. DLLSource then
  1349. begin
  1350. curconstSegment.concat(Tai_symbol.Createdataname_global(
  1351. ttypedconstsym(sym).mangledname,l));
  1352. end
  1353. else
  1354. begin
  1355. curconstSegment.concat(Tai_symbol.Createdataname(
  1356. ttypedconstsym(sym).mangledname,l));
  1357. end;
  1358. aktfilepos:=storefilepos;
  1359. end;
  1360. {$ifdef GDB}
  1361. procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
  1362. var prev_dbx_count : plongint;
  1363. begin
  1364. if is_stab_written then
  1365. exit;
  1366. if not assigned(name) then
  1367. name := stringdup('Main_program');
  1368. if (symtabletype = globalsymtable) and
  1369. (current_module.globalsymtable<>self) then
  1370. begin
  1371. unitid:=current_module.unitcount;
  1372. inc(current_module.unitcount);
  1373. end;
  1374. asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
  1375. if cs_gdb_dbx in aktglobalswitches then
  1376. begin
  1377. if dbx_count_ok then
  1378. begin
  1379. asmList.concat(tai_comment.Create(strpnew('"repeated" unit '+name^
  1380. +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
  1381. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1382. +tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
  1383. exit;
  1384. end
  1385. else if (current_module.globalsymtable<>self) then
  1386. begin
  1387. prev_dbx_count := dbx_counter;
  1388. dbx_counter := nil;
  1389. do_count_dbx:=false;
  1390. if (symtabletype = globalsymtable) and (unitid<>0) then
  1391. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1392. dbx_counter := @dbx_count;
  1393. dbx_count:=0;
  1394. do_count_dbx:=assigned(dbx_counter);
  1395. end;
  1396. end;
  1397. foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab,asmlist);
  1398. if cs_gdb_dbx in aktglobalswitches then
  1399. begin
  1400. if (current_module.globalsymtable<>self) then
  1401. begin
  1402. dbx_counter := prev_dbx_count;
  1403. do_count_dbx:=false;
  1404. asmList.concat(tai_comment.Create(strpnew('End unit '+name^
  1405. +' has index '+tostr(unitid))));
  1406. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1407. +tostr(N_EINCL)+',0,0,0')));
  1408. do_count_dbx:=assigned(dbx_counter);
  1409. dbx_count_ok := {true}false;
  1410. end;
  1411. end;
  1412. is_stab_written:=true;
  1413. end;
  1414. {$endif GDB}
  1415. {****************************************************************************
  1416. TStaticSymtable
  1417. ****************************************************************************}
  1418. constructor tstaticsymtable.create(const n : string);
  1419. begin
  1420. inherited create(n);
  1421. symtabletype:=staticsymtable;
  1422. end;
  1423. procedure tstaticsymtable.ppuload(ppufile:tcompilerppufile);
  1424. begin
  1425. aktstaticsymtable:=self;
  1426. next:=symtablestack;
  1427. symtablestack:=self;
  1428. inherited ppuload(ppufile);
  1429. { now we can deref the syms and defs }
  1430. deref;
  1431. { restore symtablestack }
  1432. symtablestack:=next;
  1433. end;
  1434. procedure tstaticsymtable.ppuwrite(ppufile:tcompilerppufile);
  1435. begin
  1436. aktstaticsymtable:=self;
  1437. inherited ppuwrite(ppufile);
  1438. end;
  1439. procedure tstaticsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  1440. begin
  1441. aktstaticsymtable:=self;
  1442. inherited load_references(ppufile,locals);
  1443. end;
  1444. procedure tstaticsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  1445. begin
  1446. aktstaticsymtable:=self;
  1447. inherited write_references(ppufile,locals);
  1448. end;
  1449. procedure tstaticsymtable.insert(sym:tsymentry);
  1450. var
  1451. hsym : tsym;
  1452. begin
  1453. { also check the global symtable }
  1454. if assigned(next) and
  1455. (next.unitid=0) then
  1456. begin
  1457. hsym:=tsym(next.search(sym.name));
  1458. if assigned(hsym) then
  1459. begin
  1460. { Delphi you can have a symbol with the same name as the
  1461. unit, the unit can then not be accessed anymore using
  1462. <unit>.<id>, so we can hide the symbol }
  1463. if (m_duplicate_names in aktmodeswitches) and
  1464. (hsym.typ=symconst.unitsym) then
  1465. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  1466. else
  1467. begin
  1468. DuplicateSym(hsym);
  1469. exit;
  1470. end;
  1471. end;
  1472. end;
  1473. inherited insert(sym);
  1474. end;
  1475. procedure tstaticsymtable.insertvardata(sym : tsymentry);
  1476. begin
  1477. inherited insertvardata(sym);
  1478. { enable unitialized warning for local symbols }
  1479. if sym.typ=varsym then
  1480. tvarsym(sym).varstate:=vs_declared;
  1481. end;
  1482. {****************************************************************************
  1483. TGlobalSymtable
  1484. ****************************************************************************}
  1485. constructor tglobalsymtable.create(const n : string);
  1486. begin
  1487. inherited create(n);
  1488. symtabletype:=globalsymtable;
  1489. unitid:=0;
  1490. unitsym:=nil;
  1491. {$ifdef GDB}
  1492. if cs_gdb_dbx in aktglobalswitches then
  1493. begin
  1494. dbx_count := 0;
  1495. unittypecount:=1;
  1496. pglobaltypecount := @unittypecount;
  1497. {unitid:=current_module.unitcount;}
  1498. debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
  1499. debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1500. {inc(current_module.unitcount);}
  1501. { we can't use dbx_vcount, because we don't know
  1502. if the object file will be loaded before or afeter PM }
  1503. dbx_count_ok:=false;
  1504. dbx_counter:=@dbx_count;
  1505. do_count_dbx:=true;
  1506. end;
  1507. {$endif GDB}
  1508. end;
  1509. destructor tglobalsymtable.destroy;
  1510. var
  1511. pus : tunitsym;
  1512. begin
  1513. pus:=unitsym;
  1514. while assigned(pus) do
  1515. begin
  1516. unitsym:=pus.prevsym;
  1517. pus.prevsym:=nil;
  1518. pus.unitsymtable:=nil;
  1519. pus:=unitsym;
  1520. end;
  1521. inherited destroy;
  1522. end;
  1523. procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile);
  1524. {$ifdef GDB}
  1525. var
  1526. b : byte;
  1527. {$endif GDB}
  1528. begin
  1529. {$ifdef GDB}
  1530. if cs_gdb_dbx in aktglobalswitches then
  1531. begin
  1532. UnitTypeCount:=1;
  1533. PglobalTypeCount:=@UnitTypeCount;
  1534. end;
  1535. {$endif GDB}
  1536. symtablelevel:=0;
  1537. {$ifndef NEWMAP}
  1538. current_module.map^[0]:=self;
  1539. {$else NEWMAP}
  1540. current_module.globalsymtable:=self;
  1541. {$endif NEWMAP}
  1542. next:=symtablestack;
  1543. symtablestack:=self;
  1544. inherited ppuload(ppufile);
  1545. { now we can deref the syms and defs }
  1546. deref;
  1547. { restore symtablestack }
  1548. symtablestack:=next;
  1549. {$ifdef NEWMAP}
  1550. { necessary for dependencies }
  1551. current_module.globalsymtable:=nil;
  1552. {$endif NEWMAP}
  1553. { read dbx count }
  1554. {$ifdef GDB}
  1555. if (current_module.flags and uf_has_dbx)<>0 then
  1556. begin
  1557. b:=ppufile.readentry;
  1558. if b<>ibdbxcount then
  1559. Message(unit_f_ppu_dbx_count_problem)
  1560. else
  1561. dbx_count:=ppufile.getlongint;
  1562. {$IfDef EXTDEBUG}
  1563. writeln('Read dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1564. {$ENDIF EXTDEBUG}
  1565. { we can't use dbx_vcount, because we don't know
  1566. if the object file will be loaded before or afeter PM }
  1567. dbx_count_ok := {true}false;
  1568. end
  1569. else
  1570. begin
  1571. dbx_count:=-1;
  1572. dbx_count_ok:=false;
  1573. end;
  1574. {$endif GDB}
  1575. end;
  1576. procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1577. begin
  1578. { write the symtable entries }
  1579. inherited ppuwrite(ppufile);
  1580. { write dbx count }
  1581. {$ifdef GDB}
  1582. if cs_gdb_dbx in aktglobalswitches then
  1583. begin
  1584. {$IfDef EXTDEBUG}
  1585. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1586. {$ENDIF EXTDEBUG}
  1587. ppufile.do_crc:=false;
  1588. ppufile.putlongint(dbx_count);
  1589. ppufile.writeentry(ibdbxcount);
  1590. ppufile.do_crc:=true;
  1591. end;
  1592. {$endif GDB}
  1593. end;
  1594. procedure tglobalsymtable.insert(sym:tsymentry);
  1595. var
  1596. hsym : tsym;
  1597. begin
  1598. { also check the global symtable }
  1599. if assigned(next) and
  1600. (next.unitid=0) then
  1601. begin
  1602. hsym:=tsym(next.search(sym.name));
  1603. if assigned(hsym) then
  1604. begin
  1605. { Delphi you can have a symbol with the same name as the
  1606. unit, the unit can then not be accessed anymore using
  1607. <unit>.<id>, so we can hide the symbol }
  1608. if (m_duplicate_names in aktmodeswitches) and
  1609. (hsym.typ=symconst.unitsym) then
  1610. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  1611. else
  1612. begin
  1613. DuplicateSym(hsym);
  1614. exit;
  1615. end;
  1616. end;
  1617. end;
  1618. hsym:=tsym(search(sym.name));
  1619. if assigned(hsym) then
  1620. begin
  1621. { Delphi you can have a symbol with the same name as the
  1622. unit, the unit can then not be accessed anymore using
  1623. <unit>.<id>, so we can hide the symbol }
  1624. if (m_duplicate_names in aktmodeswitches) and
  1625. (hsym.typ=symconst.unitsym) then
  1626. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  1627. else
  1628. begin
  1629. DuplicateSym(hsym);
  1630. exit;
  1631. end;
  1632. end;
  1633. inherited insert(sym);
  1634. end;
  1635. procedure tglobalsymtable.insertvardata(sym : tsymentry);
  1636. begin
  1637. inherited insertvardata(sym);
  1638. { this symbol can't be loaded to a register }
  1639. if sym.typ=varsym then
  1640. begin
  1641. exclude(tvarsym(sym).varoptions,vo_regable);
  1642. exclude(tvarsym(sym).varoptions,vo_fpuregable);
  1643. end;
  1644. end;
  1645. {$ifdef GDB}
  1646. function tglobalsymtable.getnewtypecount : word;
  1647. begin
  1648. if not (cs_gdb_dbx in aktglobalswitches) then
  1649. getnewtypecount:=inherited getnewtypecount
  1650. else
  1651. begin
  1652. getnewtypecount:=unittypecount;
  1653. inc(unittypecount);
  1654. end;
  1655. end;
  1656. {$endif}
  1657. {****************************************************************************
  1658. TWITHSYMTABLE
  1659. ****************************************************************************}
  1660. constructor twithsymtable.create(aowner:tdef;asymsearch:TDictionary);
  1661. begin
  1662. inherited create('');
  1663. symtabletype:=withsymtable;
  1664. direct_with:=false;
  1665. withnode:=nil;
  1666. withrefnode:=nil;
  1667. use_count:=1;
  1668. { we don't need the symsearch }
  1669. symsearch.free;
  1670. { set the defaults }
  1671. symsearch:=asymsearch;
  1672. defowner:=aowner;
  1673. end;
  1674. destructor twithsymtable.destroy;
  1675. begin
  1676. symsearch:=nil;
  1677. inherited destroy;
  1678. end;
  1679. procedure twithsymtable.clear;
  1680. begin
  1681. { remove no entry from a withsymtable as it is only a pointer to the
  1682. recorddef or objectdef symtable }
  1683. end;
  1684. {****************************************************************************
  1685. TSTT_ExceptionSymtable
  1686. ****************************************************************************}
  1687. constructor tstt_exceptsymtable.create;
  1688. begin
  1689. inherited create('');
  1690. symtabletype:=stt_exceptsymtable;
  1691. end;
  1692. {*****************************************************************************
  1693. Helper Routines
  1694. *****************************************************************************}
  1695. function findunitsymtable(st:tsymtable):tsymtable;
  1696. begin
  1697. findunitsymtable:=nil;
  1698. repeat
  1699. if not assigned(st) then
  1700. internalerror(5566561);
  1701. case st.symtabletype of
  1702. localsymtable,
  1703. parasymtable,
  1704. staticsymtable :
  1705. exit;
  1706. globalsymtable :
  1707. begin
  1708. findunitsymtable:=st;
  1709. exit;
  1710. end;
  1711. objectsymtable :
  1712. st:=st.defowner.owner;
  1713. recordsymtable :
  1714. begin
  1715. { don't continue when the current
  1716. symtable is used for variant records }
  1717. if trecorddef(st.defowner).isunion then
  1718. begin
  1719. findunitsymtable:=nil;
  1720. exit;
  1721. end
  1722. else
  1723. st:=st.defowner.owner;
  1724. end;
  1725. else
  1726. internalerror(5566562);
  1727. end;
  1728. until false;
  1729. end;
  1730. procedure duplicatesym(sym:tsym);
  1731. var
  1732. st : tsymtable;
  1733. begin
  1734. Message1(sym_e_duplicate_id,sym.realname);
  1735. st:=findunitsymtable(sym.owner);
  1736. with sym.fileinfo do
  1737. begin
  1738. if assigned(st) and (st.unitid<>0) then
  1739. Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
  1740. else
  1741. Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
  1742. end;
  1743. end;
  1744. {*****************************************************************************
  1745. Search
  1746. *****************************************************************************}
  1747. function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
  1748. var
  1749. speedvalue : cardinal;
  1750. begin
  1751. speedvalue:=getspeedvalue(s);
  1752. srsymtable:=symtablestack;
  1753. while assigned(srsymtable) do
  1754. begin
  1755. srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
  1756. if assigned(srsym) and
  1757. tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
  1758. begin
  1759. searchsym:=true;
  1760. exit;
  1761. end
  1762. else
  1763. srsymtable:=srsymtable.next;
  1764. end;
  1765. searchsym:=false;
  1766. end;
  1767. function searchsymonlyin(p : tsymtable;const s : stringid):tsym;
  1768. var
  1769. srsym : tsym;
  1770. begin
  1771. { the caller have to take care if srsym=nil }
  1772. if assigned(p) then
  1773. begin
  1774. srsym:=tsym(p.search(s));
  1775. if assigned(srsym) then
  1776. begin
  1777. searchsymonlyin:=srsym;
  1778. exit;
  1779. end;
  1780. { also check in the local symtbale if it exists }
  1781. if (p=tsymtable(current_module.globalsymtable)) then
  1782. begin
  1783. srsym:=tsym(current_module.localsymtable.search(s));
  1784. if assigned(srsym) then
  1785. begin
  1786. searchsymonlyin:=srsym;
  1787. exit;
  1788. end;
  1789. end
  1790. end;
  1791. searchsymonlyin:=nil;
  1792. end;
  1793. function searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
  1794. var
  1795. speedvalue : cardinal;
  1796. topclassh : tobjectdef;
  1797. sym : tsym;
  1798. begin
  1799. speedvalue:=getspeedvalue(s);
  1800. { when the class passed is defined in this unit we
  1801. need to use the scope of that class. This is a trick
  1802. that can be used to access protected members in other
  1803. units. At least kylix supports it this way (PFV) }
  1804. if assigned(classh) and
  1805. (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
  1806. (classh.owner.unitid=0) then
  1807. topclassh:=classh
  1808. else
  1809. topclassh:=nil;
  1810. sym:=nil;
  1811. while assigned(classh) do
  1812. begin
  1813. sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
  1814. if assigned(sym) then
  1815. begin
  1816. if assigned(topclassh) then
  1817. begin
  1818. if tstoredsym(sym).is_visible_for_object(topclassh) then
  1819. break;
  1820. end
  1821. else
  1822. begin
  1823. if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
  1824. break;
  1825. end;
  1826. end;
  1827. classh:=classh.childof;
  1828. end;
  1829. searchsym_in_class:=sym;
  1830. end;
  1831. function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
  1832. var
  1833. symowner: tsymtable;
  1834. begin
  1835. if not(cs_compilesystem in aktmoduleswitches) then
  1836. srsym := ttypesym(searchsymonlyin(systemunit,s))
  1837. else
  1838. searchsym(s,tsym(srsym),symowner);
  1839. searchsystype :=
  1840. assigned(srsym) and
  1841. (srsym.typ = typesym);
  1842. end;
  1843. function searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
  1844. begin
  1845. if not(cs_compilesystem in aktmoduleswitches) then
  1846. begin
  1847. srsym := tvarsym(searchsymonlyin(systemunit,s));
  1848. symowner := systemunit;
  1849. end
  1850. else
  1851. searchsym(s,tsym(srsym),symowner);
  1852. searchsysvar :=
  1853. assigned(srsym) and
  1854. (srsym.typ = varsym);
  1855. end;
  1856. function search_class_member(pd : tobjectdef;const s : string):tsym;
  1857. { searches n in symtable of pd and all anchestors }
  1858. var
  1859. speedvalue : cardinal;
  1860. srsym : tsym;
  1861. begin
  1862. speedvalue:=getspeedvalue(s);
  1863. while assigned(pd) do
  1864. begin
  1865. srsym:=tsym(pd.symtable.speedsearch(s,speedvalue));
  1866. if assigned(srsym) then
  1867. begin
  1868. search_class_member:=srsym;
  1869. exit;
  1870. end;
  1871. pd:=pd.childof;
  1872. end;
  1873. search_class_member:=nil;
  1874. end;
  1875. {*****************************************************************************
  1876. Definition Helpers
  1877. *****************************************************************************}
  1878. procedure globaldef(const s : string;var t:ttype);
  1879. var st : string;
  1880. symt : tsymtable;
  1881. srsym : tsym;
  1882. srsymtable : tsymtable;
  1883. begin
  1884. srsym := nil;
  1885. if pos('.',s) > 0 then
  1886. begin
  1887. st := copy(s,1,pos('.',s)-1);
  1888. searchsym(st,srsym,srsymtable);
  1889. st := copy(s,pos('.',s)+1,255);
  1890. if assigned(srsym) then
  1891. begin
  1892. if srsym.typ = unitsym then
  1893. begin
  1894. symt := tunitsym(srsym).unitsymtable;
  1895. srsym := tsym(symt.search(st));
  1896. end else srsym := nil;
  1897. end;
  1898. end else st := s;
  1899. if srsym = nil then
  1900. searchsym(st,srsym,srsymtable);
  1901. if srsym = nil then
  1902. srsym:=searchsymonlyin(systemunit,st);
  1903. if (not assigned(srsym)) or
  1904. (srsym.typ<>typesym) then
  1905. begin
  1906. Message(type_e_type_id_expected);
  1907. t:=generrortype;
  1908. exit;
  1909. end;
  1910. t := ttypesym(srsym).restype;
  1911. end;
  1912. {****************************************************************************
  1913. Object Helpers
  1914. ****************************************************************************}
  1915. var
  1916. _defaultprop : tpropertysym;
  1917. procedure tstoredsymtable.testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
  1918. begin
  1919. if (tsym(p).typ=propertysym) and
  1920. (ppo_defaultproperty in tpropertysym(p).propoptions) then
  1921. _defaultprop:=tpropertysym(p);
  1922. end;
  1923. function search_default_property(pd : tobjectdef) : tpropertysym;
  1924. { returns the default property of a class, searches also anchestors }
  1925. begin
  1926. _defaultprop:=nil;
  1927. while assigned(pd) do
  1928. begin
  1929. pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,nil);
  1930. if assigned(_defaultprop) then
  1931. break;
  1932. pd:=pd.childof;
  1933. end;
  1934. search_default_property:=_defaultprop;
  1935. end;
  1936. {$ifdef UNITALIASES}
  1937. {****************************************************************************
  1938. TUNIT_ALIAS
  1939. ****************************************************************************}
  1940. constructor tunit_alias.create(const n:string);
  1941. var
  1942. i : longint;
  1943. begin
  1944. i:=pos('=',n);
  1945. if i=0 then
  1946. fail;
  1947. inherited createname(Copy(n,1,i-1));
  1948. newname:=stringdup(Copy(n,i+1,255));
  1949. end;
  1950. destructor tunit_alias.destroy;
  1951. begin
  1952. stringdispose(newname);
  1953. inherited destroy;
  1954. end;
  1955. procedure addunitalias(const n:string);
  1956. begin
  1957. unitaliases^.insert(tunit_alias,init(Upper(n))));
  1958. end;
  1959. function getunitalias(const n:string):string;
  1960. var
  1961. p : punit_alias;
  1962. begin
  1963. p:=punit_alias(unitaliases^.search(Upper(n)));
  1964. if assigned(p) then
  1965. getunitalias:=punit_alias(p).newname^
  1966. else
  1967. getunitalias:=n;
  1968. end;
  1969. {$endif UNITALIASES}
  1970. {****************************************************************************
  1971. Symtable Stack
  1972. ****************************************************************************}
  1973. procedure dellexlevel;
  1974. var
  1975. p : tsymtable;
  1976. begin
  1977. p:=symtablestack;
  1978. symtablestack:=p.next;
  1979. { symbol tables of unit interfaces are never disposed }
  1980. { this is handle by the unit unitm }
  1981. if not(p.symtabletype in [globalsymtable,stt_exceptsymtable]) then
  1982. p.free;
  1983. end;
  1984. procedure RestoreUnitSyms;
  1985. var
  1986. p : tsymtable;
  1987. begin
  1988. p:=symtablestack;
  1989. while assigned(p) do
  1990. begin
  1991. if (p.symtabletype=globalsymtable) and
  1992. assigned(tglobalsymtable(p).unitsym) and
  1993. ((tglobalsymtable(p).unitsym.owner=current_module.globalsymtable) or
  1994. (tglobalsymtable(p).unitsym.owner=current_module.localsymtable)) then
  1995. tglobalsymtable(p).unitsym.restoreunitsym;
  1996. p:=p.next;
  1997. end;
  1998. end;
  1999. {$ifdef DEBUG}
  2000. procedure test_symtablestack;
  2001. var
  2002. p : tsymtable;
  2003. i : longint;
  2004. begin
  2005. p:=symtablestack;
  2006. i:=0;
  2007. while assigned(p) do
  2008. begin
  2009. inc(i);
  2010. p:=p.next;
  2011. if i>500 then
  2012. Message(sym_f_internal_error_in_symtablestack);
  2013. end;
  2014. end;
  2015. procedure list_symtablestack;
  2016. var
  2017. p : tsymtable;
  2018. i : longint;
  2019. begin
  2020. p:=symtablestack;
  2021. i:=0;
  2022. while assigned(p) do
  2023. begin
  2024. inc(i);
  2025. writeln(i,' ',p.name^);
  2026. p:=p.next;
  2027. if i>500 then
  2028. Message(sym_f_internal_error_in_symtablestack);
  2029. end;
  2030. end;
  2031. {$endif DEBUG}
  2032. {****************************************************************************
  2033. Init/Done Symtable
  2034. ****************************************************************************}
  2035. procedure InitSymtable;
  2036. var
  2037. token : ttoken;
  2038. begin
  2039. { Reset symbolstack }
  2040. registerdef:=false;
  2041. read_member:=false;
  2042. symtablestack:=nil;
  2043. systemunit:=nil;
  2044. {$ifdef GDB}
  2045. firstglobaldef:=nil;
  2046. lastglobaldef:=nil;
  2047. globaltypecount:=1;
  2048. pglobaltypecount:=@globaltypecount;
  2049. {$endif GDB}
  2050. { create error syms and def }
  2051. generrorsym:=terrorsym.create;
  2052. generrortype.setdef(terrordef.create);
  2053. {$ifdef UNITALIASES}
  2054. { unit aliases }
  2055. unitaliases:=tdictionary.create;
  2056. {$endif}
  2057. for token:=first_overloaded to last_overloaded do
  2058. overloaded_operators[token]:=nil;
  2059. end;
  2060. procedure DoneSymtable;
  2061. begin
  2062. generrorsym.free;
  2063. generrortype.def.free;
  2064. {$ifdef UNITALIASES}
  2065. unitaliases.free;
  2066. {$endif}
  2067. end;
  2068. end.
  2069. {
  2070. $Log$
  2071. Revision 1.88 2002-12-27 18:07:45 peter
  2072. * fix crashes when searching symbols
  2073. Revision 1.87 2002/12/25 01:26:56 peter
  2074. * duplicate procsym-unitsym fix
  2075. Revision 1.86 2002/12/21 13:07:34 peter
  2076. * type redefine fix for tb0437
  2077. Revision 1.85 2002/12/07 14:27:10 carl
  2078. * 3% memory optimization
  2079. * changed some types
  2080. + added type checking with different size for call node and for
  2081. parameters
  2082. Revision 1.84 2002/12/06 17:51:11 peter
  2083. * merged cdecl and array fixes
  2084. Revision 1.83 2002/11/30 11:12:48 carl
  2085. + checking for symbols used with hint directives is done mostly in pexpr
  2086. only now
  2087. Revision 1.82 2002/11/29 22:31:20 carl
  2088. + unimplemented hint directive added
  2089. * hint directive parsing implemented
  2090. * warning on these directives
  2091. Revision 1.81 2002/11/27 20:04:09 peter
  2092. * tvarsym.get_push_size replaced by paramanager.push_size
  2093. Revision 1.80 2002/11/22 22:45:49 carl
  2094. + small optimization for speed
  2095. Revision 1.79 2002/11/19 16:26:33 pierre
  2096. * correct a stabs generation problem that lead to use errordef in stabs
  2097. Revision 1.78 2002/11/18 17:32:00 peter
  2098. * pass proccalloption to ret_in_xxx and push_xxx functions
  2099. Revision 1.77 2002/11/15 01:58:54 peter
  2100. * merged changes from 1.0.7 up to 04-11
  2101. - -V option for generating bug report tracing
  2102. - more tracing for option parsing
  2103. - errors for cdecl and high()
  2104. - win32 import stabs
  2105. - win32 records<=8 are returned in eax:edx (turned off by default)
  2106. - heaptrc update
  2107. - more info for temp management in .s file with EXTDEBUG
  2108. Revision 1.76 2002/11/09 15:29:28 carl
  2109. + bss / constant alignment fixes
  2110. * avoid incrementing address/datasize in local symtable for const's
  2111. Revision 1.75 2002/10/14 19:44:43 peter
  2112. * threadvars need 4 bytes extra for storing the threadvar index
  2113. Revision 1.74 2002/10/06 19:41:31 peter
  2114. * Add finalization of typed consts
  2115. * Finalization of globals in the main program
  2116. Revision 1.73 2002/10/05 12:43:29 carl
  2117. * fixes for Delphi 6 compilation
  2118. (warning : Some features do not work under Delphi)
  2119. Revision 1.72 2002/09/09 19:41:46 peter
  2120. * real fix internalerror for dup ids in union sym
  2121. Revision 1.71 2002/09/09 17:34:16 peter
  2122. * tdicationary.replace added to replace and item in a dictionary. This
  2123. is only allowed for the same name
  2124. * varsyms are inserted in symtable before the types are parsed. This
  2125. fixes the long standing "var longint : longint" bug
  2126. - consume_idlist and idstringlist removed. The loops are inserted
  2127. at the callers place and uses the symtable for duplicate id checking
  2128. Revision 1.70 2002/09/05 19:29:45 peter
  2129. * memdebug enhancements
  2130. Revision 1.69 2002/08/25 19:25:21 peter
  2131. * sym.insert_in_data removed
  2132. * symtable.insertvardata/insertconstdata added
  2133. * removed insert_in_data call from symtable.insert, it needs to be
  2134. called separatly. This allows to deref the address calculation
  2135. * procedures now calculate the parast addresses after the procedure
  2136. directives are parsed. This fixes the cdecl parast problem
  2137. * push_addr_param has an extra argument that specifies if cdecl is used
  2138. or not
  2139. Revision 1.68 2002/08/18 20:06:27 peter
  2140. * inlining is now also allowed in interface
  2141. * renamed write/load to ppuwrite/ppuload
  2142. * tnode storing in ppu
  2143. * nld,ncon,nbas are already updated for storing in ppu
  2144. Revision 1.67 2002/08/17 09:23:43 florian
  2145. * first part of procinfo rewrite
  2146. Revision 1.66 2002/08/11 13:24:15 peter
  2147. * saving of asmsymbols in ppu supported
  2148. * asmsymbollist global is removed and moved into a new class
  2149. tasmlibrarydata that will hold the info of a .a file which
  2150. corresponds with a single module. Added librarydata to tmodule
  2151. to keep the library info stored for the module. In the future the
  2152. objectfiles will also be stored to the tasmlibrarydata class
  2153. * all getlabel/newasmsymbol and friends are moved to the new class
  2154. Revision 1.65 2002/07/23 09:51:27 daniel
  2155. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2156. are worth comitting.
  2157. Revision 1.64 2002/07/16 15:34:21 florian
  2158. * exit is now a syssym instead of a keyword
  2159. Revision 1.63 2002/07/15 19:44:53 florian
  2160. * fixed crash with default parameters and stdcall calling convention
  2161. Revision 1.62 2002/07/01 18:46:28 peter
  2162. * internal linker
  2163. * reorganized aasm layer
  2164. Revision 1.61 2002/05/18 13:34:19 peter
  2165. * readded missing revisions
  2166. Revision 1.60 2002/05/16 19:46:45 carl
  2167. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2168. + try to fix temp allocation (still in ifdef)
  2169. + generic constructor calls
  2170. + start of tassembler / tmodulebase class cleanup
  2171. Revision 1.58 2002/05/12 16:53:15 peter
  2172. * moved entry and exitcode to ncgutil and cgobj
  2173. * foreach gets extra argument for passing local data to the
  2174. iterator function
  2175. * -CR checks also class typecasts at runtime by changing them
  2176. into as
  2177. * fixed compiler to cycle with the -CR option
  2178. * fixed stabs with elf writer, finally the global variables can
  2179. be watched
  2180. * removed a lot of routines from cga unit and replaced them by
  2181. calls to cgobj
  2182. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2183. u32bit then the other is typecasted also to u32bit without giving
  2184. a rangecheck warning/error.
  2185. * fixed pascal calling method with reversing also the high tree in
  2186. the parast, detected by tcalcst3 test
  2187. Revision 1.57 2002/04/04 19:06:05 peter
  2188. * removed unused units
  2189. * use tlocation.size in cg.a_*loc*() routines
  2190. Revision 1.56 2002/03/04 19:10:11 peter
  2191. * removed compiler warnings
  2192. Revision 1.55 2002/02/03 09:30:07 peter
  2193. * more fixes for protected handling
  2194. Revision 1.54 2002/01/29 21:30:25 peter
  2195. * allow also dup id in delphi mode in interfaces
  2196. Revision 1.53 2002/01/29 19:46:00 peter
  2197. * fixed recordsymtable.insert_in() for inserting variant record fields
  2198. to not used symtable.insert() because that also updates alignmentinfo
  2199. which was already set
  2200. Revision 1.52 2002/01/24 18:25:50 peter
  2201. * implicit result variable generation for assembler routines
  2202. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  2203. }