symtable.pas 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526
  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. next:=symtablestack;
  1538. symtablestack:=self;
  1539. inherited ppuload(ppufile);
  1540. { now we can deref the syms and defs }
  1541. deref;
  1542. { restore symtablestack }
  1543. symtablestack:=next;
  1544. { read dbx count }
  1545. {$ifdef GDB}
  1546. if (current_module.flags and uf_has_dbx)<>0 then
  1547. begin
  1548. b:=ppufile.readentry;
  1549. if b<>ibdbxcount then
  1550. Message(unit_f_ppu_dbx_count_problem)
  1551. else
  1552. dbx_count:=ppufile.getlongint;
  1553. {$IfDef EXTDEBUG}
  1554. writeln('Read dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1555. {$ENDIF EXTDEBUG}
  1556. { we can't use dbx_vcount, because we don't know
  1557. if the object file will be loaded before or afeter PM }
  1558. dbx_count_ok := {true}false;
  1559. end
  1560. else
  1561. begin
  1562. dbx_count:=-1;
  1563. dbx_count_ok:=false;
  1564. end;
  1565. {$endif GDB}
  1566. end;
  1567. procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1568. begin
  1569. { write the symtable entries }
  1570. inherited ppuwrite(ppufile);
  1571. { write dbx count }
  1572. {$ifdef GDB}
  1573. if cs_gdb_dbx in aktglobalswitches then
  1574. begin
  1575. {$IfDef EXTDEBUG}
  1576. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1577. {$ENDIF EXTDEBUG}
  1578. ppufile.do_crc:=false;
  1579. ppufile.putlongint(dbx_count);
  1580. ppufile.writeentry(ibdbxcount);
  1581. ppufile.do_crc:=true;
  1582. end;
  1583. {$endif GDB}
  1584. end;
  1585. procedure tglobalsymtable.insert(sym:tsymentry);
  1586. var
  1587. hsym : tsym;
  1588. begin
  1589. { also check the global symtable }
  1590. if assigned(next) and
  1591. (next.unitid=0) then
  1592. begin
  1593. hsym:=tsym(next.search(sym.name));
  1594. if assigned(hsym) then
  1595. begin
  1596. { Delphi you can have a symbol with the same name as the
  1597. unit, the unit can then not be accessed anymore using
  1598. <unit>.<id>, so we can hide the symbol }
  1599. if (m_duplicate_names in aktmodeswitches) and
  1600. (hsym.typ=symconst.unitsym) then
  1601. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  1602. else
  1603. begin
  1604. DuplicateSym(hsym);
  1605. exit;
  1606. end;
  1607. end;
  1608. end;
  1609. hsym:=tsym(search(sym.name));
  1610. if assigned(hsym) then
  1611. begin
  1612. { Delphi you can have a symbol with the same name as the
  1613. unit, the unit can then not be accessed anymore using
  1614. <unit>.<id>, so we can hide the symbol }
  1615. if (m_duplicate_names in aktmodeswitches) and
  1616. (hsym.typ=symconst.unitsym) then
  1617. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  1618. else
  1619. begin
  1620. DuplicateSym(hsym);
  1621. exit;
  1622. end;
  1623. end;
  1624. inherited insert(sym);
  1625. end;
  1626. procedure tglobalsymtable.insertvardata(sym : tsymentry);
  1627. begin
  1628. inherited insertvardata(sym);
  1629. { this symbol can't be loaded to a register }
  1630. if sym.typ=varsym then
  1631. begin
  1632. exclude(tvarsym(sym).varoptions,vo_regable);
  1633. exclude(tvarsym(sym).varoptions,vo_fpuregable);
  1634. end;
  1635. end;
  1636. {$ifdef GDB}
  1637. function tglobalsymtable.getnewtypecount : word;
  1638. begin
  1639. if not (cs_gdb_dbx in aktglobalswitches) then
  1640. getnewtypecount:=inherited getnewtypecount
  1641. else
  1642. begin
  1643. getnewtypecount:=unittypecount;
  1644. inc(unittypecount);
  1645. end;
  1646. end;
  1647. {$endif}
  1648. {****************************************************************************
  1649. TWITHSYMTABLE
  1650. ****************************************************************************}
  1651. constructor twithsymtable.create(aowner:tdef;asymsearch:TDictionary);
  1652. begin
  1653. inherited create('');
  1654. symtabletype:=withsymtable;
  1655. direct_with:=false;
  1656. withnode:=nil;
  1657. withrefnode:=nil;
  1658. use_count:=1;
  1659. { we don't need the symsearch }
  1660. symsearch.free;
  1661. { set the defaults }
  1662. symsearch:=asymsearch;
  1663. defowner:=aowner;
  1664. end;
  1665. destructor twithsymtable.destroy;
  1666. begin
  1667. symsearch:=nil;
  1668. inherited destroy;
  1669. end;
  1670. procedure twithsymtable.clear;
  1671. begin
  1672. { remove no entry from a withsymtable as it is only a pointer to the
  1673. recorddef or objectdef symtable }
  1674. end;
  1675. {****************************************************************************
  1676. TSTT_ExceptionSymtable
  1677. ****************************************************************************}
  1678. constructor tstt_exceptsymtable.create;
  1679. begin
  1680. inherited create('');
  1681. symtabletype:=stt_exceptsymtable;
  1682. end;
  1683. {*****************************************************************************
  1684. Helper Routines
  1685. *****************************************************************************}
  1686. function findunitsymtable(st:tsymtable):tsymtable;
  1687. begin
  1688. findunitsymtable:=nil;
  1689. repeat
  1690. if not assigned(st) then
  1691. internalerror(5566561);
  1692. case st.symtabletype of
  1693. localsymtable,
  1694. parasymtable,
  1695. staticsymtable :
  1696. exit;
  1697. globalsymtable :
  1698. begin
  1699. findunitsymtable:=st;
  1700. exit;
  1701. end;
  1702. objectsymtable :
  1703. st:=st.defowner.owner;
  1704. recordsymtable :
  1705. begin
  1706. { don't continue when the current
  1707. symtable is used for variant records }
  1708. if trecorddef(st.defowner).isunion then
  1709. begin
  1710. findunitsymtable:=nil;
  1711. exit;
  1712. end
  1713. else
  1714. st:=st.defowner.owner;
  1715. end;
  1716. else
  1717. internalerror(5566562);
  1718. end;
  1719. until false;
  1720. end;
  1721. procedure duplicatesym(sym:tsym);
  1722. var
  1723. st : tsymtable;
  1724. begin
  1725. Message1(sym_e_duplicate_id,sym.realname);
  1726. st:=findunitsymtable(sym.owner);
  1727. with sym.fileinfo do
  1728. begin
  1729. if assigned(st) and (st.unitid<>0) then
  1730. Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
  1731. else
  1732. Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
  1733. end;
  1734. end;
  1735. {*****************************************************************************
  1736. Search
  1737. *****************************************************************************}
  1738. function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
  1739. var
  1740. speedvalue : cardinal;
  1741. begin
  1742. speedvalue:=getspeedvalue(s);
  1743. srsymtable:=symtablestack;
  1744. while assigned(srsymtable) do
  1745. begin
  1746. srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
  1747. if assigned(srsym) and
  1748. tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
  1749. begin
  1750. searchsym:=true;
  1751. exit;
  1752. end
  1753. else
  1754. srsymtable:=srsymtable.next;
  1755. end;
  1756. searchsym:=false;
  1757. end;
  1758. function searchsymonlyin(p : tsymtable;const s : stringid):tsym;
  1759. var
  1760. srsym : tsym;
  1761. begin
  1762. { the caller have to take care if srsym=nil }
  1763. if assigned(p) then
  1764. begin
  1765. srsym:=tsym(p.search(s));
  1766. if assigned(srsym) then
  1767. begin
  1768. searchsymonlyin:=srsym;
  1769. exit;
  1770. end;
  1771. { also check in the local symtbale if it exists }
  1772. if (p=tsymtable(current_module.globalsymtable)) then
  1773. begin
  1774. srsym:=tsym(current_module.localsymtable.search(s));
  1775. if assigned(srsym) then
  1776. begin
  1777. searchsymonlyin:=srsym;
  1778. exit;
  1779. end;
  1780. end
  1781. end;
  1782. searchsymonlyin:=nil;
  1783. end;
  1784. function searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
  1785. var
  1786. speedvalue : cardinal;
  1787. topclassh : tobjectdef;
  1788. sym : tsym;
  1789. begin
  1790. speedvalue:=getspeedvalue(s);
  1791. { when the class passed is defined in this unit we
  1792. need to use the scope of that class. This is a trick
  1793. that can be used to access protected members in other
  1794. units. At least kylix supports it this way (PFV) }
  1795. if assigned(classh) and
  1796. (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
  1797. (classh.owner.unitid=0) then
  1798. topclassh:=classh
  1799. else
  1800. topclassh:=nil;
  1801. sym:=nil;
  1802. while assigned(classh) do
  1803. begin
  1804. sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
  1805. if assigned(sym) then
  1806. begin
  1807. if assigned(topclassh) then
  1808. begin
  1809. if tstoredsym(sym).is_visible_for_object(topclassh) then
  1810. break;
  1811. end
  1812. else
  1813. begin
  1814. if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
  1815. break;
  1816. end;
  1817. end;
  1818. classh:=classh.childof;
  1819. end;
  1820. searchsym_in_class:=sym;
  1821. end;
  1822. function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
  1823. var
  1824. symowner: tsymtable;
  1825. begin
  1826. if not(cs_compilesystem in aktmoduleswitches) then
  1827. srsym := ttypesym(searchsymonlyin(systemunit,s))
  1828. else
  1829. searchsym(s,tsym(srsym),symowner);
  1830. searchsystype :=
  1831. assigned(srsym) and
  1832. (srsym.typ = typesym);
  1833. end;
  1834. function searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
  1835. begin
  1836. if not(cs_compilesystem in aktmoduleswitches) then
  1837. begin
  1838. srsym := tvarsym(searchsymonlyin(systemunit,s));
  1839. symowner := systemunit;
  1840. end
  1841. else
  1842. searchsym(s,tsym(srsym),symowner);
  1843. searchsysvar :=
  1844. assigned(srsym) and
  1845. (srsym.typ = varsym);
  1846. end;
  1847. function search_class_member(pd : tobjectdef;const s : string):tsym;
  1848. { searches n in symtable of pd and all anchestors }
  1849. var
  1850. speedvalue : cardinal;
  1851. srsym : tsym;
  1852. begin
  1853. speedvalue:=getspeedvalue(s);
  1854. while assigned(pd) do
  1855. begin
  1856. srsym:=tsym(pd.symtable.speedsearch(s,speedvalue));
  1857. if assigned(srsym) then
  1858. begin
  1859. search_class_member:=srsym;
  1860. exit;
  1861. end;
  1862. pd:=pd.childof;
  1863. end;
  1864. search_class_member:=nil;
  1865. end;
  1866. {*****************************************************************************
  1867. Definition Helpers
  1868. *****************************************************************************}
  1869. procedure globaldef(const s : string;var t:ttype);
  1870. var st : string;
  1871. symt : tsymtable;
  1872. srsym : tsym;
  1873. srsymtable : tsymtable;
  1874. begin
  1875. srsym := nil;
  1876. if pos('.',s) > 0 then
  1877. begin
  1878. st := copy(s,1,pos('.',s)-1);
  1879. searchsym(st,srsym,srsymtable);
  1880. st := copy(s,pos('.',s)+1,255);
  1881. if assigned(srsym) then
  1882. begin
  1883. if srsym.typ = unitsym then
  1884. begin
  1885. symt := tunitsym(srsym).unitsymtable;
  1886. srsym := tsym(symt.search(st));
  1887. end else srsym := nil;
  1888. end;
  1889. end else st := s;
  1890. if srsym = nil then
  1891. searchsym(st,srsym,srsymtable);
  1892. if srsym = nil then
  1893. srsym:=searchsymonlyin(systemunit,st);
  1894. if (not assigned(srsym)) or
  1895. (srsym.typ<>typesym) then
  1896. begin
  1897. Message(type_e_type_id_expected);
  1898. t:=generrortype;
  1899. exit;
  1900. end;
  1901. t := ttypesym(srsym).restype;
  1902. end;
  1903. {****************************************************************************
  1904. Object Helpers
  1905. ****************************************************************************}
  1906. var
  1907. _defaultprop : tpropertysym;
  1908. procedure tstoredsymtable.testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
  1909. begin
  1910. if (tsym(p).typ=propertysym) and
  1911. (ppo_defaultproperty in tpropertysym(p).propoptions) then
  1912. _defaultprop:=tpropertysym(p);
  1913. end;
  1914. function search_default_property(pd : tobjectdef) : tpropertysym;
  1915. { returns the default property of a class, searches also anchestors }
  1916. begin
  1917. _defaultprop:=nil;
  1918. while assigned(pd) do
  1919. begin
  1920. pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,nil);
  1921. if assigned(_defaultprop) then
  1922. break;
  1923. pd:=pd.childof;
  1924. end;
  1925. search_default_property:=_defaultprop;
  1926. end;
  1927. {$ifdef UNITALIASES}
  1928. {****************************************************************************
  1929. TUNIT_ALIAS
  1930. ****************************************************************************}
  1931. constructor tunit_alias.create(const n:string);
  1932. var
  1933. i : longint;
  1934. begin
  1935. i:=pos('=',n);
  1936. if i=0 then
  1937. fail;
  1938. inherited createname(Copy(n,1,i-1));
  1939. newname:=stringdup(Copy(n,i+1,255));
  1940. end;
  1941. destructor tunit_alias.destroy;
  1942. begin
  1943. stringdispose(newname);
  1944. inherited destroy;
  1945. end;
  1946. procedure addunitalias(const n:string);
  1947. begin
  1948. unitaliases^.insert(tunit_alias,init(Upper(n))));
  1949. end;
  1950. function getunitalias(const n:string):string;
  1951. var
  1952. p : punit_alias;
  1953. begin
  1954. p:=punit_alias(unitaliases^.search(Upper(n)));
  1955. if assigned(p) then
  1956. getunitalias:=punit_alias(p).newname^
  1957. else
  1958. getunitalias:=n;
  1959. end;
  1960. {$endif UNITALIASES}
  1961. {****************************************************************************
  1962. Symtable Stack
  1963. ****************************************************************************}
  1964. procedure dellexlevel;
  1965. var
  1966. p : tsymtable;
  1967. begin
  1968. p:=symtablestack;
  1969. symtablestack:=p.next;
  1970. { symbol tables of unit interfaces are never disposed }
  1971. { this is handle by the unit unitm }
  1972. if not(p.symtabletype in [globalsymtable,stt_exceptsymtable]) then
  1973. p.free;
  1974. end;
  1975. procedure RestoreUnitSyms;
  1976. var
  1977. p : tsymtable;
  1978. begin
  1979. p:=symtablestack;
  1980. while assigned(p) do
  1981. begin
  1982. if (p.symtabletype=globalsymtable) and
  1983. assigned(tglobalsymtable(p).unitsym) and
  1984. ((tglobalsymtable(p).unitsym.owner=current_module.globalsymtable) or
  1985. (tglobalsymtable(p).unitsym.owner=current_module.localsymtable)) then
  1986. tglobalsymtable(p).unitsym.restoreunitsym;
  1987. p:=p.next;
  1988. end;
  1989. end;
  1990. {$ifdef DEBUG}
  1991. procedure test_symtablestack;
  1992. var
  1993. p : tsymtable;
  1994. i : longint;
  1995. begin
  1996. p:=symtablestack;
  1997. i:=0;
  1998. while assigned(p) do
  1999. begin
  2000. inc(i);
  2001. p:=p.next;
  2002. if i>500 then
  2003. Message(sym_f_internal_error_in_symtablestack);
  2004. end;
  2005. end;
  2006. procedure list_symtablestack;
  2007. var
  2008. p : tsymtable;
  2009. i : longint;
  2010. begin
  2011. p:=symtablestack;
  2012. i:=0;
  2013. while assigned(p) do
  2014. begin
  2015. inc(i);
  2016. writeln(i,' ',p.name^);
  2017. p:=p.next;
  2018. if i>500 then
  2019. Message(sym_f_internal_error_in_symtablestack);
  2020. end;
  2021. end;
  2022. {$endif DEBUG}
  2023. {****************************************************************************
  2024. Init/Done Symtable
  2025. ****************************************************************************}
  2026. procedure InitSymtable;
  2027. var
  2028. token : ttoken;
  2029. begin
  2030. { Reset symbolstack }
  2031. registerdef:=false;
  2032. read_member:=false;
  2033. symtablestack:=nil;
  2034. systemunit:=nil;
  2035. {$ifdef GDB}
  2036. firstglobaldef:=nil;
  2037. lastglobaldef:=nil;
  2038. globaltypecount:=1;
  2039. pglobaltypecount:=@globaltypecount;
  2040. {$endif GDB}
  2041. { create error syms and def }
  2042. generrorsym:=terrorsym.create;
  2043. generrortype.setdef(terrordef.create);
  2044. {$ifdef UNITALIASES}
  2045. { unit aliases }
  2046. unitaliases:=tdictionary.create;
  2047. {$endif}
  2048. for token:=first_overloaded to last_overloaded do
  2049. overloaded_operators[token]:=nil;
  2050. end;
  2051. procedure DoneSymtable;
  2052. begin
  2053. generrorsym.free;
  2054. generrortype.def.free;
  2055. {$ifdef UNITALIASES}
  2056. unitaliases.free;
  2057. {$endif}
  2058. end;
  2059. end.
  2060. {
  2061. $Log$
  2062. Revision 1.89 2002-12-29 14:57:50 peter
  2063. * unit loading changed to first register units and load them
  2064. afterwards. This is needed to support uses xxx in yyy correctly
  2065. * unit dependency check fixed
  2066. Revision 1.88 2002/12/27 18:07:45 peter
  2067. * fix crashes when searching symbols
  2068. Revision 1.87 2002/12/25 01:26:56 peter
  2069. * duplicate procsym-unitsym fix
  2070. Revision 1.86 2002/12/21 13:07:34 peter
  2071. * type redefine fix for tb0437
  2072. Revision 1.85 2002/12/07 14:27:10 carl
  2073. * 3% memory optimization
  2074. * changed some types
  2075. + added type checking with different size for call node and for
  2076. parameters
  2077. Revision 1.84 2002/12/06 17:51:11 peter
  2078. * merged cdecl and array fixes
  2079. Revision 1.83 2002/11/30 11:12:48 carl
  2080. + checking for symbols used with hint directives is done mostly in pexpr
  2081. only now
  2082. Revision 1.82 2002/11/29 22:31:20 carl
  2083. + unimplemented hint directive added
  2084. * hint directive parsing implemented
  2085. * warning on these directives
  2086. Revision 1.81 2002/11/27 20:04:09 peter
  2087. * tvarsym.get_push_size replaced by paramanager.push_size
  2088. Revision 1.80 2002/11/22 22:45:49 carl
  2089. + small optimization for speed
  2090. Revision 1.79 2002/11/19 16:26:33 pierre
  2091. * correct a stabs generation problem that lead to use errordef in stabs
  2092. Revision 1.78 2002/11/18 17:32:00 peter
  2093. * pass proccalloption to ret_in_xxx and push_xxx functions
  2094. Revision 1.77 2002/11/15 01:58:54 peter
  2095. * merged changes from 1.0.7 up to 04-11
  2096. - -V option for generating bug report tracing
  2097. - more tracing for option parsing
  2098. - errors for cdecl and high()
  2099. - win32 import stabs
  2100. - win32 records<=8 are returned in eax:edx (turned off by default)
  2101. - heaptrc update
  2102. - more info for temp management in .s file with EXTDEBUG
  2103. Revision 1.76 2002/11/09 15:29:28 carl
  2104. + bss / constant alignment fixes
  2105. * avoid incrementing address/datasize in local symtable for const's
  2106. Revision 1.75 2002/10/14 19:44:43 peter
  2107. * threadvars need 4 bytes extra for storing the threadvar index
  2108. Revision 1.74 2002/10/06 19:41:31 peter
  2109. * Add finalization of typed consts
  2110. * Finalization of globals in the main program
  2111. Revision 1.73 2002/10/05 12:43:29 carl
  2112. * fixes for Delphi 6 compilation
  2113. (warning : Some features do not work under Delphi)
  2114. Revision 1.72 2002/09/09 19:41:46 peter
  2115. * real fix internalerror for dup ids in union sym
  2116. Revision 1.71 2002/09/09 17:34:16 peter
  2117. * tdicationary.replace added to replace and item in a dictionary. This
  2118. is only allowed for the same name
  2119. * varsyms are inserted in symtable before the types are parsed. This
  2120. fixes the long standing "var longint : longint" bug
  2121. - consume_idlist and idstringlist removed. The loops are inserted
  2122. at the callers place and uses the symtable for duplicate id checking
  2123. Revision 1.70 2002/09/05 19:29:45 peter
  2124. * memdebug enhancements
  2125. Revision 1.69 2002/08/25 19:25:21 peter
  2126. * sym.insert_in_data removed
  2127. * symtable.insertvardata/insertconstdata added
  2128. * removed insert_in_data call from symtable.insert, it needs to be
  2129. called separatly. This allows to deref the address calculation
  2130. * procedures now calculate the parast addresses after the procedure
  2131. directives are parsed. This fixes the cdecl parast problem
  2132. * push_addr_param has an extra argument that specifies if cdecl is used
  2133. or not
  2134. Revision 1.68 2002/08/18 20:06:27 peter
  2135. * inlining is now also allowed in interface
  2136. * renamed write/load to ppuwrite/ppuload
  2137. * tnode storing in ppu
  2138. * nld,ncon,nbas are already updated for storing in ppu
  2139. Revision 1.67 2002/08/17 09:23:43 florian
  2140. * first part of procinfo rewrite
  2141. Revision 1.66 2002/08/11 13:24:15 peter
  2142. * saving of asmsymbols in ppu supported
  2143. * asmsymbollist global is removed and moved into a new class
  2144. tasmlibrarydata that will hold the info of a .a file which
  2145. corresponds with a single module. Added librarydata to tmodule
  2146. to keep the library info stored for the module. In the future the
  2147. objectfiles will also be stored to the tasmlibrarydata class
  2148. * all getlabel/newasmsymbol and friends are moved to the new class
  2149. Revision 1.65 2002/07/23 09:51:27 daniel
  2150. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2151. are worth comitting.
  2152. Revision 1.64 2002/07/16 15:34:21 florian
  2153. * exit is now a syssym instead of a keyword
  2154. Revision 1.63 2002/07/15 19:44:53 florian
  2155. * fixed crash with default parameters and stdcall calling convention
  2156. Revision 1.62 2002/07/01 18:46:28 peter
  2157. * internal linker
  2158. * reorganized aasm layer
  2159. Revision 1.61 2002/05/18 13:34:19 peter
  2160. * readded missing revisions
  2161. Revision 1.60 2002/05/16 19:46:45 carl
  2162. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2163. + try to fix temp allocation (still in ifdef)
  2164. + generic constructor calls
  2165. + start of tassembler / tmodulebase class cleanup
  2166. Revision 1.58 2002/05/12 16:53:15 peter
  2167. * moved entry and exitcode to ncgutil and cgobj
  2168. * foreach gets extra argument for passing local data to the
  2169. iterator function
  2170. * -CR checks also class typecasts at runtime by changing them
  2171. into as
  2172. * fixed compiler to cycle with the -CR option
  2173. * fixed stabs with elf writer, finally the global variables can
  2174. be watched
  2175. * removed a lot of routines from cga unit and replaced them by
  2176. calls to cgobj
  2177. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2178. u32bit then the other is typecasted also to u32bit without giving
  2179. a rangecheck warning/error.
  2180. * fixed pascal calling method with reversing also the high tree in
  2181. the parast, detected by tcalcst3 test
  2182. Revision 1.57 2002/04/04 19:06:05 peter
  2183. * removed unused units
  2184. * use tlocation.size in cg.a_*loc*() routines
  2185. Revision 1.56 2002/03/04 19:10:11 peter
  2186. * removed compiler warnings
  2187. Revision 1.55 2002/02/03 09:30:07 peter
  2188. * more fixes for protected handling
  2189. Revision 1.54 2002/01/29 21:30:25 peter
  2190. * allow also dup id in delphi mode in interfaces
  2191. Revision 1.53 2002/01/29 19:46:00 peter
  2192. * fixed recordsymtable.insert_in() for inserting variant record fields
  2193. to not used symtable.insert() because that also updates alignmentinfo
  2194. which was already set
  2195. Revision 1.52 2002/01/24 18:25:50 peter
  2196. * implicit result variable generation for assembler routines
  2197. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  2198. }