symtable.pas 90 KB

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