symtable.pas 83 KB

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