symtable.pas 81 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475
  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. unittypecount : word;
  140. unitsym : tunitsym;
  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 : longint; { 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:=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. { deref the interface definitions }
  446. hp:=tdef(defindex.first);
  447. while assigned(hp) do
  448. begin
  449. hp.deref;
  450. hp:=tdef(hp.indexnext);
  451. end;
  452. { first deref the interface ttype symbols }
  453. hs:=tsym(symindex.first);
  454. while assigned(hs) do
  455. begin
  456. if hs.typ=typesym then
  457. hs.deref;
  458. hs:=tsym(hs.indexnext);
  459. end;
  460. { deref the interface symbols }
  461. hs:=tsym(symindex.first);
  462. while assigned(hs) do
  463. begin
  464. if hs.typ<>typesym then
  465. hs.deref;
  466. hs:=tsym(hs.indexnext);
  467. end;
  468. end;
  469. procedure tstoredsymtable.derefimpl;
  470. var
  471. hp : tdef;
  472. begin
  473. { deref the implementation part of definitions }
  474. hp:=tdef(defindex.first);
  475. while assigned(hp) do
  476. begin
  477. hp.derefimpl;
  478. hp:=tdef(hp.indexnext);
  479. end;
  480. end;
  481. procedure tstoredsymtable.insert(sym:tsymentry);
  482. var
  483. hsym : tsym;
  484. begin
  485. { set owner and sym indexnb }
  486. sym.owner:=self;
  487. { check the current symtable }
  488. hsym:=tsym(search(sym.name));
  489. if assigned(hsym) then
  490. begin
  491. { in TP and Delphi you can have a local with the
  492. same name as the function, the function is then hidden for
  493. the user. (Under delphi it can still be accessed using result),
  494. but don't allow hiding of RESULT }
  495. if (m_duplicate_names in aktmodeswitches) and
  496. (hsym.typ=funcretsym) and
  497. not((m_result in aktmodeswitches) and
  498. (hsym.name='RESULT')) then
  499. hsym.owner.rename(hsym.name,'hidden'+hsym.name)
  500. else
  501. begin
  502. DuplicateSym(hsym);
  503. exit;
  504. end;
  505. end;
  506. { register definition of typesym }
  507. if (sym.typ = typesym) and
  508. assigned(ttypesym(sym).restype.def) then
  509. begin
  510. if not(assigned(ttypesym(sym).restype.def.owner)) and
  511. (ttypesym(sym).restype.def.deftype<>errordef) then
  512. registerdef(ttypesym(sym).restype.def);
  513. {$ifdef GDB}
  514. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  515. (symtabletype in [globalsymtable,staticsymtable]) then
  516. begin
  517. ttypesym(sym).isusedinstab := true;
  518. {sym.concatstabto(debuglist);}
  519. end;
  520. {$endif GDB}
  521. end;
  522. { insert in index and search hash }
  523. symindex.insert(sym);
  524. symsearch.insert(sym);
  525. end;
  526. function tstoredsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
  527. var
  528. hp : tstoredsym;
  529. newref : tref;
  530. begin
  531. hp:=tstoredsym(inherited speedsearch(s,speedvalue));
  532. if assigned(hp) then
  533. begin
  534. { reject non static members in static procedures }
  535. if (symtabletype=objectsymtable) and
  536. not(sp_static in hp.symoptions) and
  537. allow_only_static then
  538. Message(sym_e_only_static_in_static);
  539. { unit uses count }
  540. if (unitid<>0) and
  541. (symtabletype = globalsymtable) and
  542. assigned(tglobalsymtable(self).unitsym) then
  543. inc(tglobalsymtable(self).unitsym.refs);
  544. {$ifdef GDB}
  545. { if it is a type, we need the stabs of this type
  546. this might be the cause of the class debug problems
  547. as TCHILDCLASS.Create did not generate appropriate
  548. stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
  549. if (cs_debuginfo in aktmoduleswitches) and
  550. (hp.typ=typesym) and
  551. make_ref then
  552. begin
  553. if assigned(ttypesym(hp).restype.def) then
  554. tstoreddef(ttypesym(hp).restype.def).numberstring
  555. else
  556. ttypesym(hp).isusedinstab:=true;
  557. end;
  558. {$endif GDB}
  559. { unitsym are only loaded for browsing PM }
  560. { this was buggy anyway because we could use }
  561. { unitsyms from other units in _USES !! }
  562. {if (symtabletype=unitsymtable) and (hp.typ=unitsym) and
  563. assigned(current_module) and (current_module.globalsymtable<>.load) then
  564. hp:=nil;}
  565. if assigned(hp) and
  566. make_ref and
  567. (cs_browser in aktmoduleswitches) then
  568. begin
  569. newref:=tref.create(hp.lastref,@akttokenpos);
  570. { for symbols that are in tables without
  571. browser info or syssyms (PM) }
  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 assigned(hp) and make_ref then
  590. begin
  591. inc(hp.refs);
  592. end;
  593. end;
  594. speedsearch:=hp;
  595. end;
  596. {**************************************
  597. Callbacks
  598. **************************************}
  599. procedure TStoredSymtable.check_forward(sym : TNamedIndexItem;arg:pointer);
  600. begin
  601. if tsym(sym).typ=procsym then
  602. tprocsym(sym).check_forward
  603. { check also object method table }
  604. { we needn't to test the def list }
  605. { because each object has to have a type sym }
  606. else
  607. if (tsym(sym).typ=typesym) and
  608. assigned(ttypesym(sym).restype.def) and
  609. (ttypesym(sym).restype.def.deftype=objectdef) then
  610. tobjectdef(ttypesym(sym).restype.def).check_forwards;
  611. end;
  612. procedure TStoredSymtable.labeldefined(p : TNamedIndexItem;arg:pointer);
  613. begin
  614. if (tsym(p).typ=labelsym) and
  615. not(tlabelsym(p).defined) then
  616. begin
  617. if tlabelsym(p).used then
  618. Message1(sym_e_label_used_and_not_defined,tlabelsym(p).realname)
  619. else
  620. Message1(sym_w_label_not_defined,tlabelsym(p).realname);
  621. end;
  622. end;
  623. procedure TStoredSymtable.unitsymbolused(p : TNamedIndexItem;arg:pointer);
  624. begin
  625. if (tsym(p).typ=unitsym) and
  626. (tunitsym(p).refs=0) and
  627. { do not claim for unit name itself !! }
  628. assigned(tunitsym(p).unitsymtable) and
  629. (tunitsym(p).unitsymtable.symtabletype=globalsymtable) then
  630. MessagePos2(tsym(p).fileinfo,sym_n_unit_not_used,p.name,current_module.modulename^);
  631. end;
  632. procedure TStoredSymtable.varsymbolused(p : TNamedIndexItem;arg:pointer);
  633. begin
  634. if (tsym(p).typ=varsym) and
  635. ((tsym(p).owner.symtabletype in
  636. [parasymtable,localsymtable,objectsymtable,staticsymtable])) then
  637. begin
  638. { unused symbol should be reported only if no }
  639. { error is reported }
  640. { if the symbol is in a register it is used }
  641. { also don't count the value parameters which have local copies }
  642. { also don't claim for high param of open parameters (PM) }
  643. if (Errorcount<>0) or
  644. (copy(p.name,1,3)='val') or
  645. (copy(p.name,1,4)='high') then
  646. exit;
  647. if (tvarsym(p).refs=0) then
  648. begin
  649. if (tsym(p).owner.symtabletype=parasymtable) or (vo_is_local_copy in tvarsym(p).varoptions) then
  650. begin
  651. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname);
  652. end
  653. else if (tsym(p).owner.symtabletype=objectsymtable) then
  654. MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
  655. else
  656. MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_not_used,tsym(p).realname);
  657. end
  658. else if tvarsym(p).varstate=vs_assigned then
  659. begin
  660. if (tsym(p).owner.symtabletype=parasymtable) then
  661. begin
  662. if not(tvarsym(p).varspez in [vs_var,vs_out]) then
  663. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname)
  664. end
  665. else if (vo_is_local_copy in tvarsym(p).varoptions) then
  666. begin
  667. if not(tvarsym(p).varspez in [vs_var,vs_out]) then
  668. MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname);
  669. end
  670. else if (tsym(p).owner.symtabletype=objectsymtable) then
  671. MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_only_set,tsym(p).owner.realname^,tsym(p).realname)
  672. else if (tsym(p).owner.symtabletype<>parasymtable) then
  673. if not (vo_is_exported in tvarsym(p).varoptions) then
  674. MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
  675. end;
  676. end
  677. else if ((tsym(p).owner.symtabletype in
  678. [objectsymtable,parasymtable,localsymtable,staticsymtable])) then
  679. begin
  680. if (Errorcount<>0) then
  681. exit;
  682. { do not claim for inherited private fields !! }
  683. if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
  684. MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
  685. { units references are problematic }
  686. else if (tstoredsym(p).refs=0) and not(tsym(p).typ in [funcretsym,enumsym,unitsym]) then
  687. if (tsym(p).typ<>procsym) or not (tprocsym(p).is_global) or
  688. { all program functions are declared global
  689. but unused should still be signaled PM }
  690. ((tsym(p).owner.symtabletype=staticsymtable) and
  691. not current_module.is_unit) then
  692. MessagePos2(tsym(p).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(p).typ],tsym(p).realname);
  693. end;
  694. end;
  695. procedure TStoredSymtable.TestPrivate(p : TNamedIndexItem;arg:pointer);
  696. begin
  697. if sp_private in tsym(p).symoptions then
  698. varsymbolused(p,arg);
  699. end;
  700. procedure TStoredSymtable.objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
  701. begin
  702. {
  703. Don't test simple object aliases PM
  704. }
  705. if (tsym(p).typ=typesym) and
  706. (ttypesym(p).restype.def.deftype=objectdef) and
  707. (ttypesym(p).restype.def.typesym=tsym(p)) then
  708. tobjectdef(ttypesym(p).restype.def).symtable.foreach({$ifdef FPCPROCVAR}@{$endif}TestPrivate,nil);
  709. end;
  710. procedure tstoredsymtable.unchain_overloads(p : TNamedIndexItem;arg:pointer);
  711. begin
  712. if tsym(p).typ=procsym then
  713. tprocsym(p).unchain_overload;
  714. end;
  715. {$ifdef GDB}
  716. procedure TStoredSymtable.concatstab(p : TNamedIndexItem;arg:pointer);
  717. begin
  718. if tsym(p).typ <> procsym then
  719. tstoredsym(p).concatstabto(TAAsmOutput(arg));
  720. end;
  721. procedure TStoredSymtable.resetstab(p : TNamedIndexItem;arg:pointer);
  722. begin
  723. if tsym(p).typ <> procsym then
  724. tstoredsym(p).isstabwritten:=false;
  725. end;
  726. procedure TStoredSymtable.concattypestab(p : TNamedIndexItem;arg:pointer);
  727. begin
  728. if tsym(p).typ = typesym then
  729. begin
  730. tstoredsym(p).isstabwritten:=false;
  731. tstoredsym(p).concatstabto(TAAsmOutput(arg));
  732. end;
  733. end;
  734. function tstoredsymtable.getnewtypecount : word;
  735. begin
  736. getnewtypecount:=pglobaltypecount^;
  737. inc(pglobaltypecount^);
  738. end;
  739. {$endif GDB}
  740. procedure tstoredsymtable.chainoperators;
  741. var
  742. t : ttoken;
  743. srsym : tsym;
  744. srsymtable,
  745. storesymtablestack : tsymtable;
  746. begin
  747. storesymtablestack:=symtablestack;
  748. symtablestack:=self;
  749. make_ref:=false;
  750. for t:=first_overloaded to last_overloaded do
  751. begin
  752. overloaded_operators[t]:=nil;
  753. { each operator has a unique lowercased internal name PM }
  754. while assigned(symtablestack) do
  755. begin
  756. searchsym(overloaded_names[t],srsym,srsymtable);
  757. if not assigned(srsym) then
  758. begin
  759. if (t=_STARSTAR) then
  760. begin
  761. symtablestack:=systemunit;
  762. searchsym('POWER',srsym,srsymtable);
  763. end;
  764. end;
  765. if assigned(srsym) then
  766. begin
  767. if (srsym.typ<>procsym) then
  768. internalerror(12344321);
  769. { use this procsym as start ? }
  770. if not assigned(overloaded_operators[t]) then
  771. overloaded_operators[t]:=tprocsym(srsym)
  772. else
  773. { already got a procsym, only add defs of the current procsym }
  774. Tprocsym(srsym).concat_procdefs_to(overloaded_operators[t]);
  775. symtablestack:=srsym.owner.next;
  776. end
  777. else
  778. begin
  779. symtablestack:=nil;
  780. end;
  781. { search for same procsym in other units }
  782. end;
  783. symtablestack:=self;
  784. end;
  785. make_ref:=true;
  786. symtablestack:=storesymtablestack;
  787. end;
  788. {***********************************************
  789. Process all entries
  790. ***********************************************}
  791. { checks, if all procsyms and methods are defined }
  792. procedure tstoredsymtable.check_forwards;
  793. begin
  794. foreach({$ifdef FPCPROCVAR}@{$endif}check_forward,nil);
  795. end;
  796. procedure tstoredsymtable.checklabels;
  797. begin
  798. foreach({$ifdef FPCPROCVAR}@{$endif}labeldefined,nil);
  799. end;
  800. procedure tstoredsymtable.allunitsused;
  801. begin
  802. foreach({$ifdef FPCPROCVAR}@{$endif}unitsymbolused,nil);
  803. end;
  804. procedure tstoredsymtable.allsymbolsused;
  805. begin
  806. foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused,nil);
  807. end;
  808. procedure tstoredsymtable.allprivatesused;
  809. begin
  810. foreach({$ifdef FPCPROCVAR}@{$endif}objectprivatesymbolused,nil);
  811. end;
  812. procedure tstoredsymtable.unchain_overloaded;
  813. begin
  814. foreach({$ifdef FPCPROCVAR}@{$endif}unchain_overloads,nil);
  815. end;
  816. {$ifdef GDB}
  817. procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
  818. begin
  819. if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
  820. foreach({$ifdef FPCPROCVAR}@{$endif}resetstab,nil);
  821. foreach({$ifdef FPCPROCVAR}@{$endif}concatstab,asmlist);
  822. end;
  823. {$endif}
  824. procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer);
  825. begin
  826. if b_needs_init_final then
  827. exit;
  828. case tsym(p).typ of
  829. varsym :
  830. begin
  831. if not(is_class(tvarsym(p).vartype.def)) and
  832. tstoreddef(tvarsym(p).vartype.def).needs_inittable then
  833. b_needs_init_final:=true;
  834. end;
  835. typedconstsym :
  836. begin
  837. if ttypedconstsym(p).is_writable and
  838. tstoreddef(ttypedconstsym(p).typedconsttype.def).needs_inittable then
  839. b_needs_init_final:=true;
  840. end;
  841. end;
  842. end;
  843. { returns true, if p contains data which needs init/final code }
  844. function tstoredsymtable.needs_init_final : boolean;
  845. begin
  846. b_needs_init_final:=false;
  847. foreach({$ifdef FPCPROCVAR}@{$endif}_needs_init_final,nil);
  848. needs_init_final:=b_needs_init_final;
  849. end;
  850. {****************************************************************************
  851. TAbstractRecordSymtable
  852. ****************************************************************************}
  853. procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
  854. var
  855. storesymtable : tsymtable;
  856. begin
  857. storesymtable:=aktrecordsymtable;
  858. aktrecordsymtable:=self;
  859. inherited ppuload(ppufile);
  860. aktrecordsymtable:=storesymtable;
  861. end;
  862. procedure tabstractrecordsymtable.ppuwrite(ppufile:tcompilerppufile);
  863. var
  864. oldtyp : byte;
  865. storesymtable : tsymtable;
  866. begin
  867. storesymtable:=aktrecordsymtable;
  868. aktrecordsymtable:=self;
  869. oldtyp:=ppufile.entrytyp;
  870. ppufile.entrytyp:=subentryid;
  871. inherited ppuwrite(ppufile);
  872. ppufile.entrytyp:=oldtyp;
  873. aktrecordsymtable:=storesymtable;
  874. end;
  875. procedure tabstractrecordsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  876. var
  877. storesymtable : tsymtable;
  878. begin
  879. storesymtable:=aktrecordsymtable;
  880. aktrecordsymtable:=self;
  881. inherited load_references(ppufile,locals);
  882. aktrecordsymtable:=storesymtable;
  883. end;
  884. procedure tabstractrecordsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  885. var
  886. storesymtable : tsymtable;
  887. begin
  888. storesymtable:=aktrecordsymtable;
  889. aktrecordsymtable:=self;
  890. inherited write_references(ppufile,locals);
  891. aktrecordsymtable:=storesymtable;
  892. end;
  893. procedure tabstractrecordsymtable.insertvardata(sym : tsymentry);
  894. var
  895. l,varalign : longint;
  896. vardef : tdef;
  897. begin
  898. if sym.typ<>varsym then
  899. internalerror(200208251);
  900. l:=tvarsym(sym).getvaluesize;
  901. vardef:=tvarsym(sym).vartype.def;
  902. { this symbol can't be loaded to a register }
  903. exclude(tvarsym(sym).varoptions,vo_regable);
  904. exclude(tvarsym(sym).varoptions,vo_fpuregable);
  905. { get the alignment size }
  906. if (aktalignment.recordalignmax=-1) then
  907. begin
  908. varalign:=vardef.alignment;
  909. if (varalign>4) and
  910. ((varalign mod 4)<>0) and
  911. (vardef.deftype=arraydef) then
  912. Message1(sym_w_wrong_C_pack,vardef.typename);
  913. if varalign=0 then
  914. varalign:=l;
  915. if (dataalignment<aktalignment.maxCrecordalign) then
  916. begin
  917. if (varalign>16) and (dataalignment<32) then
  918. dataalignment:=32
  919. else if (varalign>12) and (dataalignment<16) then
  920. dataalignment:=16
  921. { 12 is needed for long double }
  922. else if (varalign>8) and (dataalignment<12) then
  923. dataalignment:=12
  924. else if (varalign>4) and (dataalignment<8) then
  925. dataalignment:=8
  926. else if (varalign>2) and (dataalignment<4) then
  927. dataalignment:=4
  928. else if (varalign>1) and (dataalignment<2) then
  929. dataalignment:=2;
  930. end;
  931. dataalignment:=min(dataalignment,aktalignment.maxCrecordalign);
  932. end
  933. else
  934. varalign:=vardef.alignment;
  935. if varalign=0 then
  936. varalign:=size_2_align(l);
  937. varalign:=used_align(varalign,aktalignment.recordalignmin,dataalignment);
  938. tvarsym(sym).address:=align(datasize,varalign);
  939. datasize:=tvarsym(sym).address+l;
  940. end;
  941. {****************************************************************************
  942. TRecordSymtable
  943. ****************************************************************************}
  944. constructor trecordsymtable.create;
  945. begin
  946. inherited create('');
  947. symtabletype:=recordsymtable;
  948. end;
  949. { this procedure is reserved for inserting case variant into
  950. a record symtable }
  951. { the offset is the location of the start of the variant
  952. and datasize and dataalignment corresponds to
  953. the complete size (see code in pdecl unit) PM }
  954. procedure trecordsymtable.insert_in(tsymt : tsymtable;offset : longint);
  955. var
  956. ps,nps : tvarsym;
  957. pd,npd : tdef;
  958. storesize,storealign : longint;
  959. begin
  960. storesize:=tsymt.datasize;
  961. storealign:=tsymt.dataalignment;
  962. tsymt.datasize:=offset;
  963. ps:=tvarsym(symindex.first);
  964. while assigned(ps) do
  965. begin
  966. nps:=tvarsym(ps.indexnext);
  967. { remove from current symtable }
  968. symindex.deleteindex(ps);
  969. ps.left:=nil;
  970. ps.right:=nil;
  971. { add to symt }
  972. ps.owner:=tsymt;
  973. tsymt.datasize:=ps.address+offset;
  974. tsymt.symindex.insert(ps);
  975. tsymt.symsearch.insert(ps);
  976. { update address }
  977. ps.address:=tsymt.datasize;
  978. { next }
  979. ps:=nps;
  980. end;
  981. pd:=tdef(defindex.first);
  982. while assigned(pd) do
  983. begin
  984. npd:=tdef(pd.indexnext);
  985. defindex.deleteindex(pd);
  986. pd.left:=nil;
  987. pd.right:=nil;
  988. tsymt.registerdef(pd);
  989. pd:=npd;
  990. end;
  991. tsymt.datasize:=storesize;
  992. tsymt.dataalignment:=storealign;
  993. end;
  994. {****************************************************************************
  995. TObjectSymtable
  996. ****************************************************************************}
  997. constructor tobjectsymtable.create(const n:string);
  998. begin
  999. inherited create(n);
  1000. symtabletype:=objectsymtable;
  1001. end;
  1002. procedure tobjectsymtable.insert(sym:tsymentry);
  1003. var
  1004. hsym : tsym;
  1005. begin
  1006. { check for duplicate field id in inherited classes }
  1007. if (sym.typ=varsym) and
  1008. assigned(defowner) and
  1009. (
  1010. not(m_delphi in aktmodeswitches) or
  1011. is_object(tdef(defowner))
  1012. ) then
  1013. begin
  1014. { but private ids can be reused }
  1015. hsym:=search_class_member(tobjectdef(defowner),sym.name);
  1016. if assigned(hsym) and
  1017. tstoredsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
  1018. begin
  1019. DuplicateSym(hsym);
  1020. exit;
  1021. end;
  1022. end;
  1023. inherited insert(sym);
  1024. end;
  1025. {****************************************************************************
  1026. TAbstractLocalSymtable
  1027. ****************************************************************************}
  1028. procedure tabstractlocalsymtable.ppuload(ppufile:tcompilerppufile);
  1029. var
  1030. storesymtable : tsymtable;
  1031. begin
  1032. storesymtable:=aktlocalsymtable;
  1033. aktlocalsymtable:=self;
  1034. inherited ppuload(ppufile);
  1035. aktlocalsymtable:=storesymtable;
  1036. end;
  1037. procedure tabstractlocalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1038. var
  1039. oldtyp : byte;
  1040. storesymtable : tsymtable;
  1041. begin
  1042. storesymtable:=aktlocalsymtable;
  1043. aktlocalsymtable:=self;
  1044. oldtyp:=ppufile.entrytyp;
  1045. ppufile.entrytyp:=subentryid;
  1046. { write definitions }
  1047. writedefs(ppufile);
  1048. { write symbols }
  1049. writesyms(ppufile);
  1050. ppufile.entrytyp:=oldtyp;
  1051. aktlocalsymtable:=storesymtable;
  1052. end;
  1053. procedure tabstractlocalsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  1054. var
  1055. storesymtable : tsymtable;
  1056. begin
  1057. storesymtable:=aktlocalsymtable;
  1058. aktlocalsymtable:=self;
  1059. inherited load_references(ppufile,locals);
  1060. aktlocalsymtable:=storesymtable;
  1061. end;
  1062. procedure tabstractlocalsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  1063. var
  1064. storesymtable : tsymtable;
  1065. begin
  1066. storesymtable:=aktlocalsymtable;
  1067. aktlocalsymtable:=self;
  1068. inherited write_references(ppufile,locals);
  1069. aktlocalsymtable:=storesymtable;
  1070. end;
  1071. {****************************************************************************
  1072. TLocalSymtable
  1073. ****************************************************************************}
  1074. constructor tlocalsymtable.create;
  1075. begin
  1076. inherited create('');
  1077. symtabletype:=localsymtable;
  1078. end;
  1079. procedure tlocalsymtable.insert(sym:tsymentry);
  1080. var
  1081. hsym : tsym;
  1082. begin
  1083. if assigned(next) then
  1084. begin
  1085. if (next.symtabletype=parasymtable) then
  1086. begin
  1087. hsym:=tsym(next.search(sym.name));
  1088. if assigned(hsym) then
  1089. begin
  1090. { a parameter and the function can have the same
  1091. name in TP and Delphi, but RESULT not }
  1092. if (m_duplicate_names in aktmodeswitches) and
  1093. (sym.typ=funcretsym) and
  1094. not((m_result in aktmodeswitches) and
  1095. (sym.name='RESULT')) then
  1096. sym.name:='hidden'+sym.name
  1097. else
  1098. begin
  1099. DuplicateSym(hsym);
  1100. exit;
  1101. end;
  1102. end;
  1103. end;
  1104. { check for duplicate id in local symtable of methods }
  1105. if assigned(next.next) and
  1106. { funcretsym is allowed !! }
  1107. (sym.typ <> funcretsym) and
  1108. (next.next.symtabletype=objectsymtable) then
  1109. begin
  1110. hsym:=search_class_member(tobjectdef(next.next.defowner),sym.name);
  1111. if assigned(hsym) and
  1112. { private ids can be reused }
  1113. (not(sp_private in hsym.symoptions) or
  1114. (hsym.owner.defowner.owner.symtabletype<>globalsymtable)) then
  1115. begin
  1116. { delphi allows to reuse the names in a class, but not
  1117. in object (tp7 compatible) }
  1118. if not((m_delphi in aktmodeswitches) and
  1119. is_class(tdef(next.next.defowner))) then
  1120. begin
  1121. DuplicateSym(hsym);
  1122. exit;
  1123. end;
  1124. end;
  1125. end;
  1126. end;
  1127. inherited insert(sym);
  1128. end;
  1129. procedure tlocalsymtable.insertvardata(sym : tsymentry);
  1130. var
  1131. l,varalign : longint;
  1132. begin
  1133. if not(sym.typ in [varsym,funcretsym]) then
  1134. internalerror(200208255);
  1135. case sym.typ of
  1136. varsym :
  1137. begin
  1138. tvarsym(sym).varstate:=vs_declared;
  1139. l:=tvarsym(sym).getvaluesize;
  1140. varalign:=size_2_align(l);
  1141. varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
  1142. {$ifdef powerpc}
  1143. { on the powerpc, the local variables are accessed with a positiv offset }
  1144. tvarsym(sym).address:=align(datasize,varalign);
  1145. datasize:=tvarsym(sym).address+l;
  1146. {$else powerpc}
  1147. tvarsym(sym).address:=align(datasize+l,varalign);
  1148. datasize:=tvarsym(sym).address;
  1149. {$endif powerpc}
  1150. end;
  1151. funcretsym :
  1152. begin
  1153. { if retoffset is already set then reuse it, this is needed
  1154. when inserting the result variable }
  1155. if procinfo.return_offset<>0 then
  1156. tfuncretsym(sym).address:=procinfo.return_offset
  1157. else
  1158. begin
  1159. { allocate space in local if ret in register }
  1160. if paramanager.ret_in_reg(tfuncretsym(sym).returntype.def) 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. 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. is_cdecl : boolean;
  1259. begin
  1260. if sym.typ<>varsym then
  1261. internalerror(200208253);
  1262. { retrieve cdecl status }
  1263. if defowner.deftype<>procdef then
  1264. internalerror(200208256);
  1265. is_cdecl:=(tprocdef(defowner).proccalloption in [pocall_cdecl,pocall_cppdecl]);
  1266. { here we need the size of a push instead of the
  1267. size of the data }
  1268. l:=tvarsym(sym).getpushsize(is_cdecl);
  1269. varalign:=size_2_align(l);
  1270. tvarsym(sym).varstate:=vs_assigned;
  1271. { we need the new datasize already aligned so we can't
  1272. use the align_address here }
  1273. tvarsym(sym).address:=datasize;
  1274. varalign:=used_align(varalign,dataalignment,dataalignment);
  1275. datasize:=align(tvarsym(sym).address+l,varalign);
  1276. end;
  1277. {****************************************************************************
  1278. TAbstractUnitSymtable
  1279. ****************************************************************************}
  1280. constructor tabstractunitsymtable.create(const n : string);
  1281. begin
  1282. inherited create(n);
  1283. symsearch.usehash;
  1284. {$ifdef GDB}
  1285. { reset GDB things }
  1286. prev_dbx_counter := dbx_counter;
  1287. dbx_counter := nil;
  1288. is_stab_written:=false;
  1289. dbx_count := -1;
  1290. {$endif GDB}
  1291. end;
  1292. procedure tabstractunitsymtable.insertvardata(sym : tsymentry);
  1293. var
  1294. l,varalign : longint;
  1295. storefilepos : tfileposinfo;
  1296. begin
  1297. if sym.typ<>varsym then
  1298. internalerror(200208252);
  1299. storefilepos:=aktfilepos;
  1300. aktfilepos:=tsym(sym).fileinfo;
  1301. l:=tvarsym(sym).getvaluesize;
  1302. if (vo_is_thread_var in tvarsym(sym).varoptions) then
  1303. inc(l,pointer_size);
  1304. varalign:=var_align(l);
  1305. tvarsym(sym).address:=align(datasize,varalign);
  1306. { insert cut for smartlinking or alignment }
  1307. if (cs_create_smart in aktmoduleswitches) then
  1308. bssSegment.concat(Tai_cut.Create);
  1309. bssSegment.concat(Tai_align.create(varalign));
  1310. datasize:=tvarsym(sym).address+l;
  1311. {$ifdef GDB}
  1312. if cs_debuginfo in aktmoduleswitches then
  1313. concatstabto(bsssegment);
  1314. {$endif GDB}
  1315. if (symtabletype=globalsymtable) or
  1316. (cs_create_smart in aktmoduleswitches) or
  1317. DLLSource or
  1318. (vo_is_exported in tvarsym(sym).varoptions) or
  1319. (vo_is_C_var in tvarsym(sym).varoptions) then
  1320. bssSegment.concat(Tai_datablock.Create_global(tvarsym(sym).mangledname,l))
  1321. else
  1322. bssSegment.concat(Tai_datablock.Create(tvarsym(sym).mangledname,l));
  1323. aktfilepos:=storefilepos;
  1324. end;
  1325. procedure tabstractunitsymtable.insertconstdata(sym : tsymentry);
  1326. var
  1327. storefilepos : tfileposinfo;
  1328. curconstsegment : taasmoutput;
  1329. l : longint;
  1330. begin
  1331. if sym.typ<>typedconstsym then
  1332. internalerror(200208254);
  1333. storefilepos:=aktfilepos;
  1334. aktfilepos:=tsym(sym).fileinfo;
  1335. if ttypedconstsym(sym).is_writable then
  1336. curconstsegment:=datasegment
  1337. else
  1338. curconstsegment:=consts;
  1339. l:=ttypedconstsym(sym).getsize;
  1340. { insert cut for smartlinking or alignment }
  1341. if (cs_create_smart in aktmoduleswitches) then
  1342. curconstSegment.concat(Tai_cut.Create);
  1343. curconstSegment.concat(Tai_align.create(const_align(l)));
  1344. {$ifdef GDB}
  1345. if cs_debuginfo in aktmoduleswitches then
  1346. concatstabto(curconstsegment);
  1347. {$endif GDB}
  1348. if (symtabletype=globalsymtable) or
  1349. (cs_create_smart in aktmoduleswitches) or
  1350. DLLSource then
  1351. begin
  1352. curconstSegment.concat(Tai_symbol.Createdataname_global(
  1353. ttypedconstsym(sym).mangledname,l));
  1354. end
  1355. else
  1356. begin
  1357. curconstSegment.concat(Tai_symbol.Createdataname(
  1358. ttypedconstsym(sym).mangledname,l));
  1359. end;
  1360. aktfilepos:=storefilepos;
  1361. end;
  1362. {$ifdef GDB}
  1363. procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
  1364. var prev_dbx_count : plongint;
  1365. begin
  1366. if is_stab_written then
  1367. exit;
  1368. if not assigned(name) then
  1369. name := stringdup('Main_program');
  1370. if (symtabletype = globalsymtable) and
  1371. (current_module.globalsymtable<>self) then
  1372. begin
  1373. unitid:=current_module.unitcount;
  1374. inc(current_module.unitcount);
  1375. end;
  1376. asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
  1377. if cs_gdb_dbx in aktglobalswitches then
  1378. begin
  1379. if dbx_count_ok then
  1380. begin
  1381. asmList.concat(tai_comment.Create(strpnew('"repeated" unit '+name^
  1382. +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
  1383. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1384. +tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
  1385. exit;
  1386. end
  1387. else if (current_module.globalsymtable<>self) then
  1388. begin
  1389. prev_dbx_count := dbx_counter;
  1390. dbx_counter := nil;
  1391. do_count_dbx:=false;
  1392. if (symtabletype = globalsymtable) and (unitid<>0) then
  1393. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1394. dbx_counter := @dbx_count;
  1395. dbx_count:=0;
  1396. do_count_dbx:=assigned(dbx_counter);
  1397. end;
  1398. end;
  1399. foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab,asmlist);
  1400. if cs_gdb_dbx in aktglobalswitches then
  1401. begin
  1402. if (current_module.globalsymtable<>self) then
  1403. begin
  1404. dbx_counter := prev_dbx_count;
  1405. do_count_dbx:=false;
  1406. asmList.concat(tai_comment.Create(strpnew('End unit '+name^
  1407. +' has index '+tostr(unitid))));
  1408. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1409. +tostr(N_EINCL)+',0,0,0')));
  1410. do_count_dbx:=assigned(dbx_counter);
  1411. dbx_count_ok := {true}false;
  1412. end;
  1413. end;
  1414. is_stab_written:=true;
  1415. end;
  1416. {$endif GDB}
  1417. {****************************************************************************
  1418. TStaticSymtable
  1419. ****************************************************************************}
  1420. constructor tstaticsymtable.create(const n : string);
  1421. begin
  1422. inherited create(n);
  1423. symtabletype:=staticsymtable;
  1424. end;
  1425. procedure tstaticsymtable.ppuload(ppufile:tcompilerppufile);
  1426. begin
  1427. aktstaticsymtable:=self;
  1428. next:=symtablestack;
  1429. symtablestack:=self;
  1430. inherited ppuload(ppufile);
  1431. { now we can deref the syms and defs }
  1432. deref;
  1433. { restore symtablestack }
  1434. symtablestack:=next;
  1435. end;
  1436. procedure tstaticsymtable.ppuwrite(ppufile:tcompilerppufile);
  1437. begin
  1438. aktstaticsymtable:=self;
  1439. inherited ppuwrite(ppufile);
  1440. end;
  1441. procedure tstaticsymtable.load_references(ppufile:tcompilerppufile;locals:boolean);
  1442. begin
  1443. aktstaticsymtable:=self;
  1444. inherited load_references(ppufile,locals);
  1445. end;
  1446. procedure tstaticsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
  1447. begin
  1448. aktstaticsymtable:=self;
  1449. inherited write_references(ppufile,locals);
  1450. end;
  1451. procedure tstaticsymtable.insert(sym:tsymentry);
  1452. var
  1453. hsym : tsym;
  1454. begin
  1455. { also check the global symtable }
  1456. if assigned(next) and
  1457. (next.unitid=0) then
  1458. begin
  1459. hsym:=tsym(next.search(sym.name));
  1460. if assigned(hsym) then
  1461. begin
  1462. DuplicateSym(hsym);
  1463. exit;
  1464. end;
  1465. end;
  1466. inherited insert(sym);
  1467. end;
  1468. procedure tstaticsymtable.insertvardata(sym : tsymentry);
  1469. begin
  1470. inherited insertvardata(sym);
  1471. { enable unitialized warning for local symbols }
  1472. if sym.typ=varsym then
  1473. tvarsym(sym).varstate:=vs_declared;
  1474. end;
  1475. {****************************************************************************
  1476. TGlobalSymtable
  1477. ****************************************************************************}
  1478. constructor tglobalsymtable.create(const n : string);
  1479. begin
  1480. inherited create(n);
  1481. symtabletype:=globalsymtable;
  1482. unitid:=0;
  1483. unitsym:=nil;
  1484. {$ifdef GDB}
  1485. if cs_gdb_dbx in aktglobalswitches then
  1486. begin
  1487. dbx_count := 0;
  1488. unittypecount:=1;
  1489. pglobaltypecount := @unittypecount;
  1490. {unitid:=current_module.unitcount;}
  1491. debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
  1492. debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1493. {inc(current_module.unitcount);}
  1494. { we can't use dbx_vcount, because we don't know
  1495. if the object file will be loaded before or afeter PM }
  1496. dbx_count_ok:=false;
  1497. dbx_counter:=@dbx_count;
  1498. do_count_dbx:=true;
  1499. end;
  1500. {$endif GDB}
  1501. end;
  1502. destructor tglobalsymtable.destroy;
  1503. var
  1504. pus : tunitsym;
  1505. begin
  1506. pus:=unitsym;
  1507. while assigned(pus) do
  1508. begin
  1509. unitsym:=pus.prevsym;
  1510. pus.prevsym:=nil;
  1511. pus.unitsymtable:=nil;
  1512. pus:=unitsym;
  1513. end;
  1514. inherited destroy;
  1515. end;
  1516. procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile);
  1517. {$ifdef GDB}
  1518. var
  1519. b : byte;
  1520. {$endif GDB}
  1521. begin
  1522. {$ifdef GDB}
  1523. if cs_gdb_dbx in aktglobalswitches then
  1524. begin
  1525. UnitTypeCount:=1;
  1526. PglobalTypeCount:=@UnitTypeCount;
  1527. end;
  1528. {$endif GDB}
  1529. symtablelevel:=0;
  1530. {$ifndef NEWMAP}
  1531. current_module.map^[0]:=self;
  1532. {$else NEWMAP}
  1533. current_module.globalsymtable:=self;
  1534. {$endif NEWMAP}
  1535. next:=symtablestack;
  1536. symtablestack:=self;
  1537. inherited ppuload(ppufile);
  1538. { now we can deref the syms and defs }
  1539. deref;
  1540. { restore symtablestack }
  1541. symtablestack:=next;
  1542. {$ifdef NEWMAP}
  1543. { necessary for dependencies }
  1544. current_module.globalsymtable:=nil;
  1545. {$endif NEWMAP}
  1546. { read dbx count }
  1547. {$ifdef GDB}
  1548. if (current_module.flags and uf_has_dbx)<>0 then
  1549. begin
  1550. b:=ppufile.readentry;
  1551. if b<>ibdbxcount then
  1552. Message(unit_f_ppu_dbx_count_problem)
  1553. else
  1554. dbx_count:=ppufile.getlongint;
  1555. {$IfDef EXTDEBUG}
  1556. writeln('Read dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1557. {$ENDIF EXTDEBUG}
  1558. { we can't use dbx_vcount, because we don't know
  1559. if the object file will be loaded before or afeter PM }
  1560. dbx_count_ok := {true}false;
  1561. end
  1562. else
  1563. begin
  1564. dbx_count:=-1;
  1565. dbx_count_ok:=false;
  1566. end;
  1567. {$endif GDB}
  1568. end;
  1569. procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile);
  1570. begin
  1571. { write the symtable entries }
  1572. inherited ppuwrite(ppufile);
  1573. { write dbx count }
  1574. {$ifdef GDB}
  1575. if cs_gdb_dbx in aktglobalswitches then
  1576. begin
  1577. {$IfDef EXTDEBUG}
  1578. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1579. {$ENDIF EXTDEBUG}
  1580. ppufile.do_crc:=false;
  1581. ppufile.putlongint(dbx_count);
  1582. ppufile.writeentry(ibdbxcount);
  1583. ppufile.do_crc:=true;
  1584. end;
  1585. {$endif GDB}
  1586. end;
  1587. procedure tglobalsymtable.insert(sym:tsymentry);
  1588. var
  1589. hsym : tsym;
  1590. begin
  1591. { also check the global symtable }
  1592. if assigned(next) and
  1593. (next.unitid=0) then
  1594. begin
  1595. hsym:=tsym(next.search(sym.name));
  1596. if assigned(hsym) then
  1597. begin
  1598. DuplicateSym(hsym);
  1599. exit;
  1600. end;
  1601. end;
  1602. hsym:=tsym(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. inherited insert(sym);
  1618. end;
  1619. procedure tglobalsymtable.insertvardata(sym : tsymentry);
  1620. begin
  1621. inherited insertvardata(sym);
  1622. { this symbol can't be loaded to a register }
  1623. if sym.typ=varsym then
  1624. begin
  1625. exclude(tvarsym(sym).varoptions,vo_regable);
  1626. exclude(tvarsym(sym).varoptions,vo_fpuregable);
  1627. end;
  1628. end;
  1629. {$ifdef GDB}
  1630. function tglobalsymtable.getnewtypecount : word;
  1631. begin
  1632. if not (cs_gdb_dbx in aktglobalswitches) then
  1633. getnewtypecount:=inherited getnewtypecount
  1634. else
  1635. begin
  1636. getnewtypecount:=unittypecount;
  1637. inc(unittypecount);
  1638. end;
  1639. end;
  1640. {$endif}
  1641. {****************************************************************************
  1642. TWITHSYMTABLE
  1643. ****************************************************************************}
  1644. constructor twithsymtable.create(aowner:tdef;asymsearch:TDictionary);
  1645. begin
  1646. inherited create('');
  1647. symtabletype:=withsymtable;
  1648. direct_with:=false;
  1649. withnode:=nil;
  1650. withrefnode:=nil;
  1651. use_count:=1;
  1652. { we don't need the symsearch }
  1653. symsearch.free;
  1654. { set the defaults }
  1655. symsearch:=asymsearch;
  1656. defowner:=aowner;
  1657. end;
  1658. destructor twithsymtable.destroy;
  1659. begin
  1660. symsearch:=nil;
  1661. inherited destroy;
  1662. end;
  1663. procedure twithsymtable.clear;
  1664. begin
  1665. { remove no entry from a withsymtable as it is only a pointer to the
  1666. recorddef or objectdef symtable }
  1667. end;
  1668. {****************************************************************************
  1669. TSTT_ExceptionSymtable
  1670. ****************************************************************************}
  1671. constructor tstt_exceptsymtable.create;
  1672. begin
  1673. inherited create('');
  1674. symtabletype:=stt_exceptsymtable;
  1675. end;
  1676. {*****************************************************************************
  1677. Helper Routines
  1678. *****************************************************************************}
  1679. function findunitsymtable(st:tsymtable):tsymtable;
  1680. begin
  1681. findunitsymtable:=nil;
  1682. repeat
  1683. if not assigned(st) then
  1684. internalerror(5566561);
  1685. case st.symtabletype of
  1686. localsymtable,
  1687. parasymtable,
  1688. staticsymtable :
  1689. exit;
  1690. globalsymtable :
  1691. begin
  1692. findunitsymtable:=st;
  1693. exit;
  1694. end;
  1695. objectsymtable :
  1696. st:=st.defowner.owner;
  1697. recordsymtable :
  1698. begin
  1699. { don't continue when the current
  1700. symtable is used for variant records }
  1701. if trecorddef(st.defowner).isunion then
  1702. begin
  1703. findunitsymtable:=nil;
  1704. exit;
  1705. end
  1706. else
  1707. st:=st.defowner.owner;
  1708. end;
  1709. else
  1710. internalerror(5566562);
  1711. end;
  1712. until false;
  1713. end;
  1714. procedure duplicatesym(sym:tsym);
  1715. var
  1716. st : tsymtable;
  1717. begin
  1718. Message1(sym_e_duplicate_id,sym.realname);
  1719. st:=findunitsymtable(sym.owner);
  1720. with sym.fileinfo do
  1721. begin
  1722. if assigned(st) and (st.unitid<>0) then
  1723. Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
  1724. else
  1725. Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
  1726. end;
  1727. end;
  1728. {*****************************************************************************
  1729. Search
  1730. *****************************************************************************}
  1731. function searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
  1732. var
  1733. speedvalue : cardinal;
  1734. begin
  1735. speedvalue:=getspeedvalue(s);
  1736. srsymtable:=symtablestack;
  1737. while assigned(srsymtable) do
  1738. begin
  1739. srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
  1740. if assigned(srsym) and
  1741. tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
  1742. begin
  1743. searchsym:=true;
  1744. exit;
  1745. end
  1746. else
  1747. srsymtable:=srsymtable.next;
  1748. end;
  1749. searchsym:=false;
  1750. end;
  1751. function searchsymonlyin(p : tsymtable;const s : stringid):tsym;
  1752. var
  1753. srsym : tsym;
  1754. begin
  1755. { the caller have to take care if srsym=nil }
  1756. if assigned(p) then
  1757. begin
  1758. srsym:=tsym(p.search(s));
  1759. if assigned(srsym) then
  1760. begin
  1761. searchsymonlyin:=srsym;
  1762. exit;
  1763. end;
  1764. { also check in the local symtbale if it exists }
  1765. if (p=tsymtable(current_module.globalsymtable)) then
  1766. begin
  1767. srsym:=tsym(current_module.localsymtable.search(s));
  1768. if assigned(srsym) then
  1769. begin
  1770. searchsymonlyin:=srsym;
  1771. exit;
  1772. end;
  1773. end
  1774. end;
  1775. searchsymonlyin:=nil;
  1776. end;
  1777. function searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
  1778. var
  1779. speedvalue : cardinal;
  1780. topclassh : tobjectdef;
  1781. sym : tsym;
  1782. begin
  1783. speedvalue:=getspeedvalue(s);
  1784. { when the class passed is defined in this unit we
  1785. need to use the scope of that class. This is a trick
  1786. that can be used to access protected members in other
  1787. units. At least kylix supports it this way (PFV) }
  1788. if (classh.owner.symtabletype in [globalsymtable,staticsymtable]) and
  1789. (classh.owner.unitid=0) then
  1790. topclassh:=classh
  1791. else
  1792. topclassh:=nil;
  1793. sym:=nil;
  1794. while assigned(classh) do
  1795. begin
  1796. sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
  1797. if assigned(sym) then
  1798. begin
  1799. if assigned(topclassh) then
  1800. begin
  1801. if tstoredsym(sym).is_visible_for_object(topclassh) then
  1802. break;
  1803. end
  1804. else
  1805. begin
  1806. if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
  1807. break;
  1808. end;
  1809. end;
  1810. classh:=classh.childof;
  1811. end;
  1812. searchsym_in_class:=sym;
  1813. end;
  1814. function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
  1815. var
  1816. symowner: tsymtable;
  1817. begin
  1818. if not(cs_compilesystem in aktmoduleswitches) then
  1819. srsym := ttypesym(searchsymonlyin(systemunit,s))
  1820. else
  1821. searchsym(s,tsym(srsym),symowner);
  1822. searchsystype :=
  1823. assigned(srsym) and
  1824. (srsym.typ = typesym);
  1825. end;
  1826. function searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
  1827. begin
  1828. if not(cs_compilesystem in aktmoduleswitches) then
  1829. begin
  1830. srsym := tvarsym(searchsymonlyin(systemunit,s));
  1831. symowner := systemunit;
  1832. end
  1833. else
  1834. searchsym(s,tsym(srsym),symowner);
  1835. searchsysvar :=
  1836. assigned(srsym) and
  1837. (srsym.typ = varsym);
  1838. end;
  1839. function search_class_member(pd : tobjectdef;const s : string):tsym;
  1840. { searches n in symtable of pd and all anchestors }
  1841. var
  1842. speedvalue : cardinal;
  1843. srsym : tsym;
  1844. begin
  1845. speedvalue:=getspeedvalue(s);
  1846. while assigned(pd) do
  1847. begin
  1848. srsym:=tsym(pd.symtable.speedsearch(s,speedvalue));
  1849. if assigned(srsym) then
  1850. begin
  1851. search_class_member:=srsym;
  1852. exit;
  1853. end;
  1854. pd:=pd.childof;
  1855. end;
  1856. search_class_member:=nil;
  1857. end;
  1858. {*****************************************************************************
  1859. Definition Helpers
  1860. *****************************************************************************}
  1861. procedure globaldef(const s : string;var t:ttype);
  1862. var st : string;
  1863. symt : tsymtable;
  1864. srsym : tsym;
  1865. srsymtable : tsymtable;
  1866. begin
  1867. srsym := nil;
  1868. if pos('.',s) > 0 then
  1869. begin
  1870. st := copy(s,1,pos('.',s)-1);
  1871. searchsym(st,srsym,srsymtable);
  1872. st := copy(s,pos('.',s)+1,255);
  1873. if assigned(srsym) then
  1874. begin
  1875. if srsym.typ = unitsym then
  1876. begin
  1877. symt := tunitsym(srsym).unitsymtable;
  1878. srsym := tsym(symt.search(st));
  1879. end else srsym := nil;
  1880. end;
  1881. end else st := s;
  1882. if srsym = nil then
  1883. searchsym(st,srsym,srsymtable);
  1884. if srsym = nil then
  1885. srsym:=searchsymonlyin(systemunit,st);
  1886. if (not assigned(srsym)) or
  1887. (srsym.typ<>typesym) then
  1888. begin
  1889. Message(type_e_type_id_expected);
  1890. t:=generrortype;
  1891. exit;
  1892. end;
  1893. t := ttypesym(srsym).restype;
  1894. end;
  1895. {****************************************************************************
  1896. Object Helpers
  1897. ****************************************************************************}
  1898. var
  1899. _defaultprop : tpropertysym;
  1900. procedure tstoredsymtable.testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
  1901. begin
  1902. if (tsym(p).typ=propertysym) and
  1903. (ppo_defaultproperty in tpropertysym(p).propoptions) then
  1904. _defaultprop:=tpropertysym(p);
  1905. end;
  1906. function search_default_property(pd : tobjectdef) : tpropertysym;
  1907. { returns the default property of a class, searches also anchestors }
  1908. begin
  1909. _defaultprop:=nil;
  1910. while assigned(pd) do
  1911. begin
  1912. pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,nil);
  1913. if assigned(_defaultprop) then
  1914. break;
  1915. pd:=pd.childof;
  1916. end;
  1917. search_default_property:=_defaultprop;
  1918. end;
  1919. {$ifdef UNITALIASES}
  1920. {****************************************************************************
  1921. TUNIT_ALIAS
  1922. ****************************************************************************}
  1923. constructor tunit_alias.create(const n:string);
  1924. var
  1925. i : longint;
  1926. begin
  1927. i:=pos('=',n);
  1928. if i=0 then
  1929. fail;
  1930. inherited createname(Copy(n,1,i-1));
  1931. newname:=stringdup(Copy(n,i+1,255));
  1932. end;
  1933. destructor tunit_alias.destroy;
  1934. begin
  1935. stringdispose(newname);
  1936. inherited destroy;
  1937. end;
  1938. procedure addunitalias(const n:string);
  1939. begin
  1940. unitaliases^.insert(tunit_alias,init(Upper(n))));
  1941. end;
  1942. function getunitalias(const n:string):string;
  1943. var
  1944. p : punit_alias;
  1945. begin
  1946. p:=punit_alias(unitaliases^.search(Upper(n)));
  1947. if assigned(p) then
  1948. getunitalias:=punit_alias(p).newname^
  1949. else
  1950. getunitalias:=n;
  1951. end;
  1952. {$endif UNITALIASES}
  1953. {****************************************************************************
  1954. Symtable Stack
  1955. ****************************************************************************}
  1956. procedure dellexlevel;
  1957. var
  1958. p : tsymtable;
  1959. begin
  1960. p:=symtablestack;
  1961. symtablestack:=p.next;
  1962. { symbol tables of unit interfaces are never disposed }
  1963. { this is handle by the unit unitm }
  1964. if not(p.symtabletype in [globalsymtable,stt_exceptsymtable]) then
  1965. p.free;
  1966. end;
  1967. procedure RestoreUnitSyms;
  1968. var
  1969. p : tsymtable;
  1970. begin
  1971. p:=symtablestack;
  1972. while assigned(p) do
  1973. begin
  1974. if (p.symtabletype=globalsymtable) and
  1975. assigned(tglobalsymtable(p).unitsym) and
  1976. ((tglobalsymtable(p).unitsym.owner=current_module.globalsymtable) or
  1977. (tglobalsymtable(p).unitsym.owner=current_module.localsymtable)) then
  1978. tglobalsymtable(p).unitsym.restoreunitsym;
  1979. p:=p.next;
  1980. end;
  1981. end;
  1982. {$ifdef DEBUG}
  1983. procedure test_symtablestack;
  1984. var
  1985. p : tsymtable;
  1986. i : longint;
  1987. begin
  1988. p:=symtablestack;
  1989. i:=0;
  1990. while assigned(p) do
  1991. begin
  1992. inc(i);
  1993. p:=p.next;
  1994. if i>500 then
  1995. Message(sym_f_internal_error_in_symtablestack);
  1996. end;
  1997. end;
  1998. procedure list_symtablestack;
  1999. var
  2000. p : tsymtable;
  2001. i : longint;
  2002. begin
  2003. p:=symtablestack;
  2004. i:=0;
  2005. while assigned(p) do
  2006. begin
  2007. inc(i);
  2008. writeln(i,' ',p.name^);
  2009. p:=p.next;
  2010. if i>500 then
  2011. Message(sym_f_internal_error_in_symtablestack);
  2012. end;
  2013. end;
  2014. {$endif DEBUG}
  2015. {****************************************************************************
  2016. Init/Done Symtable
  2017. ****************************************************************************}
  2018. procedure InitSymtable;
  2019. var
  2020. token : ttoken;
  2021. begin
  2022. { Reset symbolstack }
  2023. registerdef:=false;
  2024. read_member:=false;
  2025. symtablestack:=nil;
  2026. systemunit:=nil;
  2027. {$ifdef GDB}
  2028. firstglobaldef:=nil;
  2029. lastglobaldef:=nil;
  2030. globaltypecount:=1;
  2031. pglobaltypecount:=@globaltypecount;
  2032. {$endif GDB}
  2033. { create error syms and def }
  2034. generrorsym:=terrorsym.create;
  2035. generrortype.setdef(terrordef.create);
  2036. {$ifdef UNITALIASES}
  2037. { unit aliases }
  2038. unitaliases:=tdictionary.create;
  2039. {$endif}
  2040. for token:=first_overloaded to last_overloaded do
  2041. overloaded_operators[token]:=nil;
  2042. end;
  2043. procedure DoneSymtable;
  2044. begin
  2045. generrorsym.free;
  2046. generrortype.def.free;
  2047. {$ifdef UNITALIASES}
  2048. unitaliases.free;
  2049. {$endif}
  2050. end;
  2051. end.
  2052. {
  2053. $Log$
  2054. Revision 1.77 2002-11-15 01:58:54 peter
  2055. * merged changes from 1.0.7 up to 04-11
  2056. - -V option for generating bug report tracing
  2057. - more tracing for option parsing
  2058. - errors for cdecl and high()
  2059. - win32 import stabs
  2060. - win32 records<=8 are returned in eax:edx (turned off by default)
  2061. - heaptrc update
  2062. - more info for temp management in .s file with EXTDEBUG
  2063. Revision 1.76 2002/11/09 15:29:28 carl
  2064. + bss / constant alignment fixes
  2065. * avoid incrementing address/datasize in local symtable for const's
  2066. Revision 1.75 2002/10/14 19:44:43 peter
  2067. * threadvars need 4 bytes extra for storing the threadvar index
  2068. Revision 1.74 2002/10/06 19:41:31 peter
  2069. * Add finalization of typed consts
  2070. * Finalization of globals in the main program
  2071. Revision 1.73 2002/10/05 12:43:29 carl
  2072. * fixes for Delphi 6 compilation
  2073. (warning : Some features do not work under Delphi)
  2074. Revision 1.72 2002/09/09 19:41:46 peter
  2075. * real fix internalerror for dup ids in union sym
  2076. Revision 1.71 2002/09/09 17:34:16 peter
  2077. * tdicationary.replace added to replace and item in a dictionary. This
  2078. is only allowed for the same name
  2079. * varsyms are inserted in symtable before the types are parsed. This
  2080. fixes the long standing "var longint : longint" bug
  2081. - consume_idlist and idstringlist removed. The loops are inserted
  2082. at the callers place and uses the symtable for duplicate id checking
  2083. Revision 1.70 2002/09/05 19:29:45 peter
  2084. * memdebug enhancements
  2085. Revision 1.69 2002/08/25 19:25:21 peter
  2086. * sym.insert_in_data removed
  2087. * symtable.insertvardata/insertconstdata added
  2088. * removed insert_in_data call from symtable.insert, it needs to be
  2089. called separatly. This allows to deref the address calculation
  2090. * procedures now calculate the parast addresses after the procedure
  2091. directives are parsed. This fixes the cdecl parast problem
  2092. * push_addr_param has an extra argument that specifies if cdecl is used
  2093. or not
  2094. Revision 1.68 2002/08/18 20:06:27 peter
  2095. * inlining is now also allowed in interface
  2096. * renamed write/load to ppuwrite/ppuload
  2097. * tnode storing in ppu
  2098. * nld,ncon,nbas are already updated for storing in ppu
  2099. Revision 1.67 2002/08/17 09:23:43 florian
  2100. * first part of procinfo rewrite
  2101. Revision 1.66 2002/08/11 13:24:15 peter
  2102. * saving of asmsymbols in ppu supported
  2103. * asmsymbollist global is removed and moved into a new class
  2104. tasmlibrarydata that will hold the info of a .a file which
  2105. corresponds with a single module. Added librarydata to tmodule
  2106. to keep the library info stored for the module. In the future the
  2107. objectfiles will also be stored to the tasmlibrarydata class
  2108. * all getlabel/newasmsymbol and friends are moved to the new class
  2109. Revision 1.65 2002/07/23 09:51:27 daniel
  2110. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2111. are worth comitting.
  2112. Revision 1.64 2002/07/16 15:34:21 florian
  2113. * exit is now a syssym instead of a keyword
  2114. Revision 1.63 2002/07/15 19:44:53 florian
  2115. * fixed crash with default parameters and stdcall calling convention
  2116. Revision 1.62 2002/07/01 18:46:28 peter
  2117. * internal linker
  2118. * reorganized aasm layer
  2119. Revision 1.61 2002/05/18 13:34:19 peter
  2120. * readded missing revisions
  2121. Revision 1.60 2002/05/16 19:46:45 carl
  2122. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2123. + try to fix temp allocation (still in ifdef)
  2124. + generic constructor calls
  2125. + start of tassembler / tmodulebase class cleanup
  2126. Revision 1.58 2002/05/12 16:53:15 peter
  2127. * moved entry and exitcode to ncgutil and cgobj
  2128. * foreach gets extra argument for passing local data to the
  2129. iterator function
  2130. * -CR checks also class typecasts at runtime by changing them
  2131. into as
  2132. * fixed compiler to cycle with the -CR option
  2133. * fixed stabs with elf writer, finally the global variables can
  2134. be watched
  2135. * removed a lot of routines from cga unit and replaced them by
  2136. calls to cgobj
  2137. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2138. u32bit then the other is typecasted also to u32bit without giving
  2139. a rangecheck warning/error.
  2140. * fixed pascal calling method with reversing also the high tree in
  2141. the parast, detected by tcalcst3 test
  2142. Revision 1.57 2002/04/04 19:06:05 peter
  2143. * removed unused units
  2144. * use tlocation.size in cg.a_*loc*() routines
  2145. Revision 1.56 2002/03/04 19:10:11 peter
  2146. * removed compiler warnings
  2147. Revision 1.55 2002/02/03 09:30:07 peter
  2148. * more fixes for protected handling
  2149. Revision 1.54 2002/01/29 21:30:25 peter
  2150. * allow also dup id in delphi mode in interfaces
  2151. Revision 1.53 2002/01/29 19:46:00 peter
  2152. * fixed recordsymtable.insert_in() for inserting variant record fields
  2153. to not used symtable.insert() because that also updates alignmentinfo
  2154. which was already set
  2155. Revision 1.52 2002/01/24 18:25:50 peter
  2156. * implicit result variable generation for assembler routines
  2157. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  2158. }