symtable.pas 81 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,cobjects,
  24. { global }
  25. globtype,tokens,
  26. { symtable }
  27. symconst,symbase,symtype,symdef,symsym,
  28. { assembler }
  29. aasm
  30. ;
  31. {****************************************************************************
  32. Symtable types
  33. ****************************************************************************}
  34. type
  35. pstoredsymtable = ^tstoredsymtable;
  36. tstoredsymtable = object(tsymtable)
  37. constructor init(t : tsymtabletype);
  38. { load/write }
  39. constructor loadas(typ : tsymtabletype);
  40. procedure writeas;
  41. procedure loaddefs;
  42. procedure loadsyms;
  43. procedure writedefs;
  44. procedure writesyms;
  45. procedure prederef;
  46. procedure deref;
  47. procedure insert(sym : psymentry);virtual;
  48. procedure insert_in(psymt : psymtable;offset : longint);
  49. function speedsearch(const s : stringid;speedvalue : longint) : psymentry;virtual;
  50. procedure allsymbolsused;
  51. procedure allprivatesused;
  52. procedure allunitsused;
  53. procedure check_forwards;
  54. procedure checklabels;
  55. { change alignment for args only parasymtable }
  56. procedure set_alignment(_alignment : longint);
  57. {$ifdef CHAINPROCSYMS}
  58. procedure chainprocsyms;
  59. {$endif CHAINPROCSYMS}
  60. {$ifndef DONOTCHAINOPERATORS}
  61. procedure chainoperators;
  62. {$endif DONOTCHAINOPERATORS}
  63. procedure load_browser;
  64. procedure write_browser;
  65. {$ifdef GDB}
  66. procedure concatstabto(asmlist : taasmoutput);virtual;
  67. function getnewtypecount : word; virtual;
  68. {$endif GDB}
  69. end;
  70. punitsymtable = ^tunitsymtable;
  71. tunitsymtable = object(tstoredsymtable)
  72. unittypecount : word;
  73. unitsym : punitsym;
  74. {$ifdef GDB}
  75. dbx_count : longint;
  76. prev_dbx_counter : plongint;
  77. dbx_count_ok : boolean;
  78. is_stab_written : boolean;
  79. {$endif GDB}
  80. constructor init(t : tsymtabletype;const n : string);
  81. constructor loadasunit;
  82. destructor done;virtual;
  83. procedure writeasunit;
  84. {$ifdef GDB}
  85. procedure concattypestabto(asmlist : taasmoutput);
  86. function getnewtypecount : word; virtual;
  87. {$endif GDB}
  88. procedure load_symtable_refs;
  89. end;
  90. pwithsymtable = ^twithsymtable;
  91. twithsymtable = object(tsymtable)
  92. { used for withsymtable for allowing constructors }
  93. direct_with : boolean;
  94. { in fact it is a ptree }
  95. withnode : pointer;
  96. { ptree to load of direct with var }
  97. { already usable before firstwith
  98. needed for firstpass of function parameters PM }
  99. withrefnode : pointer;
  100. constructor init;
  101. destructor done;virtual;
  102. procedure clear;virtual;
  103. end;
  104. var
  105. srsym : psym; { result of the last search }
  106. srsymtable : psymtable;
  107. lastsrsym : psym; { last sym found in statement }
  108. lastsrsymtable : psymtable;
  109. lastsymknown : boolean;
  110. constsymtable : psymtable; { symtable were the constants can be inserted }
  111. systemunit : punitsymtable; { pointer to the system unit }
  112. read_member : boolean; { reading members of an symtable }
  113. lexlevel : longint; { level of code }
  114. { 1 for main procedure }
  115. { 2 for normal function or proc }
  116. { higher for locals }
  117. {****************************************************************************
  118. Functions
  119. ****************************************************************************}
  120. {*** Misc ***}
  121. function globaldef(const s : string) : pdef;
  122. function findunitsymtable(st:psymtable):psymtable;
  123. procedure duplicatesym(sym:psym);
  124. {*** Search ***}
  125. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  126. procedure getsym(const s : stringid;notfounderror : boolean);
  127. procedure getsymonlyin(p : psymtable;const s : stringid);
  128. {*** PPU Write/Loading ***}
  129. procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
  130. procedure numberunits;
  131. procedure load_interface;
  132. {*** Object Helpers ***}
  133. function search_class_member(pd : pobjectdef;const n : string) : psym;
  134. function search_default_property(pd : pobjectdef) : ppropertysym;
  135. {*** symtable stack ***}
  136. procedure dellexlevel;
  137. procedure RestoreUnitSyms;
  138. {$ifdef DEBUG}
  139. procedure test_symtablestack;
  140. procedure list_symtablestack;
  141. {$endif DEBUG}
  142. {$ifdef UNITALIASES}
  143. type
  144. punit_alias = ^tunit_alias;
  145. tunit_alias = object(tnamedindexobject)
  146. newname : pstring;
  147. constructor init(const n:string);
  148. destructor done;virtual;
  149. end;
  150. var
  151. unitaliases : pdictionary;
  152. procedure addunitalias(const n:string);
  153. function getunitalias(const n:string):string;
  154. {$endif UNITALIASES}
  155. {*** Init / Done ***}
  156. procedure InitSymtable;
  157. procedure DoneSymtable;
  158. const
  159. { last operator which can be overloaded, the first_overloaded should
  160. be in tokens.pas after NOTOKEN }
  161. first_overloaded = _PLUS;
  162. last_overloaded = _ASSIGNMENT;
  163. type
  164. toverloaded_operators = array[NOTOKEN..last_overloaded] of pprocsym;
  165. var
  166. overloaded_operators : toverloaded_operators;
  167. { unequal is not equal}
  168. const
  169. overloaded_names : array [NOTOKEN..last_overloaded] of string[16] =
  170. ('error',
  171. 'plus','minus','star','slash','equal',
  172. 'greater','lower','greater_or_equal',
  173. 'lower_or_equal',
  174. 'sym_diff','starstar',
  175. 'as','is','in','or',
  176. 'and','div','mod','not','shl','shr','xor',
  177. 'assign');
  178. implementation
  179. uses
  180. { global }
  181. version,verbose,globals,
  182. { target }
  183. systems,
  184. { ppu }
  185. symppu,ppu,
  186. { module }
  187. finput,fmodule,
  188. {$ifdef GDB}
  189. gdb,
  190. {$endif GDB}
  191. { scanner }
  192. scanner,
  193. { codegen }
  194. hcodegen
  195. ;
  196. var
  197. in_loading : boolean; { remove !!! }
  198. {*****************************************************************************
  199. Symbol Call Back Functions
  200. *****************************************************************************}
  201. procedure write_refs(sym : pnamedindexobject);
  202. begin
  203. pstoredsym(sym)^.write_references;
  204. end;
  205. procedure check_forward(sym : pnamedindexobject);
  206. begin
  207. if psym(sym)^.typ=procsym then
  208. pprocsym(sym)^.check_forward
  209. { check also object method table }
  210. { we needn't to test the def list }
  211. { because each object has to have a type sym }
  212. else
  213. if (psym(sym)^.typ=typesym) and
  214. assigned(ptypesym(sym)^.restype.def) and
  215. (ptypesym(sym)^.restype.def^.deftype=objectdef) then
  216. pobjectdef(ptypesym(sym)^.restype.def)^.check_forwards;
  217. end;
  218. procedure labeldefined(p : pnamedindexobject);
  219. begin
  220. if (psym(p)^.typ=labelsym) and
  221. not(plabelsym(p)^.defined) then
  222. begin
  223. if plabelsym(p)^.used then
  224. Message1(sym_e_label_used_and_not_defined,plabelsym(p)^.realname)
  225. else
  226. Message1(sym_w_label_not_defined,plabelsym(p)^.realname);
  227. end;
  228. end;
  229. procedure unitsymbolused(p : pnamedindexobject);
  230. begin
  231. if (psym(p)^.typ=unitsym) and
  232. (punitsym(p)^.refs=0) and
  233. { do not claim for unit name itself !! }
  234. (punitsym(p)^.unitsymtable^.symtabletype=unitsymtable) then
  235. MessagePos2(psym(p)^.fileinfo,sym_n_unit_not_used,
  236. p^.name,current_module.modulename^);
  237. end;
  238. procedure varsymbolused(p : pnamedindexobject);
  239. begin
  240. if (psym(p)^.typ=varsym) and
  241. ((psym(p)^.owner^.symtabletype in
  242. [parasymtable,localsymtable,objectsymtable,staticsymtable])) then
  243. begin
  244. { unused symbol should be reported only if no }
  245. { error is reported }
  246. { if the symbol is in a register it is used }
  247. { also don't count the value parameters which have local copies }
  248. { also don't claim for high param of open parameters (PM) }
  249. if (Errorcount<>0) or
  250. (copy(p^.name,1,3)='val') or
  251. (copy(p^.name,1,4)='high') then
  252. exit;
  253. if (pvarsym(p)^.refs=0) then
  254. begin
  255. if (psym(p)^.owner^.symtabletype=parasymtable) or (vo_is_local_copy in pvarsym(p)^.varoptions) then
  256. begin
  257. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_not_used,psym(p)^.realname);
  258. end
  259. else if (psym(p)^.owner^.symtabletype=objectsymtable) then
  260. MessagePos2(psym(p)^.fileinfo,sym_n_private_identifier_not_used,psym(p)^.owner^.name^,psym(p)^.realname)
  261. else
  262. MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_not_used,psym(p)^.realname);
  263. end
  264. else if pvarsym(p)^.varstate=vs_assigned then
  265. begin
  266. if (psym(p)^.owner^.symtabletype=parasymtable) then
  267. begin
  268. if not(pvarsym(p)^.varspez in [vs_var,vs_out]) then
  269. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,psym(p)^.realname)
  270. end
  271. else if (vo_is_local_copy in pvarsym(p)^.varoptions) then
  272. begin
  273. if not(pvarsym(p)^.varspez in [vs_var,vs_out]) then
  274. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,psym(p)^.realname);
  275. end
  276. else if (psym(p)^.owner^.symtabletype=objectsymtable) then
  277. MessagePos2(psym(p)^.fileinfo,sym_n_private_identifier_only_set,psym(p)^.owner^.name^,psym(p)^.realname)
  278. else if (psym(p)^.owner^.symtabletype<>parasymtable) then
  279. if not (vo_is_exported in pvarsym(p)^.varoptions) then
  280. MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_only_set,psym(p)^.realname);
  281. end;
  282. end
  283. else if ((psym(p)^.owner^.symtabletype in
  284. [objectsymtable,parasymtable,localsymtable,staticsymtable])) then
  285. begin
  286. if (Errorcount<>0) then
  287. exit;
  288. { do not claim for inherited private fields !! }
  289. if (pstoredsym(p)^.refs=0) and (psym(p)^.owner^.symtabletype=objectsymtable) then
  290. MessagePos2(psym(p)^.fileinfo,sym_n_private_method_not_used,psym(p)^.owner^.name^,psym(p)^.realname)
  291. { units references are problematic }
  292. else if (pstoredsym(p)^.refs=0) and not(psym(p)^.typ in [funcretsym,enumsym,unitsym]) then
  293. if (psym(p)^.typ<>procsym) or not (pprocsym(p)^.is_global) or
  294. { all program functions are declared global
  295. but unused should still be signaled PM }
  296. ((psym(p)^.owner^.symtabletype=staticsymtable) and
  297. not current_module.is_unit) then
  298. MessagePos2(psym(p)^.fileinfo,sym_h_local_symbol_not_used,SymTypeName[psym(p)^.typ],psym(p)^.realname);
  299. end;
  300. end;
  301. procedure TestPrivate(p : pnamedindexobject);
  302. begin
  303. if sp_private in psym(p)^.symoptions then
  304. varsymbolused(p);
  305. end;
  306. procedure objectprivatesymbolused(p : pnamedindexobject);
  307. begin
  308. {
  309. Don't test simple object aliases PM
  310. }
  311. if (psym(p)^.typ=typesym) and
  312. (ptypesym(p)^.restype.def^.deftype=objectdef) and
  313. (ptypesym(p)^.restype.def^.typesym=psym(p)) then
  314. pobjectdef(ptypesym(p)^.restype.def)^.symtable^.foreach(
  315. {$ifdef FPCPROCVAR}@{$endif}TestPrivate);
  316. end;
  317. {$ifdef GDB}
  318. var
  319. asmoutput : taasmoutput;
  320. procedure concatstab(p : pnamedindexobject);
  321. begin
  322. if psym(p)^.typ <> procsym then
  323. pstoredsym(p)^.concatstabto(asmoutput);
  324. end;
  325. procedure resetstab(p : pnamedindexobject);
  326. begin
  327. if psym(p)^.typ <> procsym then
  328. pstoredsym(p)^.isstabwritten:=false;
  329. end;
  330. procedure concattypestab(p : pnamedindexobject);
  331. begin
  332. if psym(p)^.typ = typesym then
  333. begin
  334. pstoredsym(p)^.isstabwritten:=false;
  335. pstoredsym(p)^.concatstabto(asmoutput);
  336. end;
  337. end;
  338. {$endif GDB}
  339. {$ifdef CHAINPROCSYMS}
  340. procedure chainprocsym(p : psym);
  341. var
  342. storesymtablestack : psymtable;
  343. begin
  344. if p^.typ=procsym then
  345. begin
  346. storesymtablestack:=symtablestack;
  347. symtablestack:=p^.owner^.next;
  348. while assigned(symtablestack) do
  349. begin
  350. { search for same procsym in other units }
  351. getsym(p^.name,false);
  352. if assigned(srsym) and (srsym^.typ=procsym) then
  353. begin
  354. pprocsym(p)^.nextprocsym:=pprocsym(srsym);
  355. symtablestack:=storesymtablestack;
  356. exit;
  357. end
  358. else if srsym=nil then
  359. symtablestack:=nil
  360. else
  361. symtablestack:=srsymtable^.next;
  362. end;
  363. symtablestack:=storesymtablestack;
  364. end;
  365. end;
  366. {$endif}
  367. {****************************************************************************
  368. STORED SYMTABLE
  369. ****************************************************************************}
  370. constructor tstoredsymtable.init(t : tsymtabletype);
  371. begin
  372. symtabletype:=t;
  373. symtablelevel:=0;
  374. defowner:=nil;
  375. unitid:=0;
  376. next:=nil;
  377. name:=nil;
  378. address_fixup:=0;
  379. datasize:=0;
  380. if t=parasymtable then
  381. dataalignment:=4
  382. else
  383. dataalignment:=1;
  384. new(symindex,init(indexgrowsize));
  385. new(defindex,init(indexgrowsize));
  386. if symtabletype<>withsymtable then
  387. begin
  388. new(symsearch,init);
  389. symsearch^.noclear:=true;
  390. end
  391. else
  392. symsearch:=nil;
  393. end;
  394. {$ifndef DONOTCHAINOPERATORS}
  395. procedure tstoredsymtable.chainoperators;
  396. var
  397. p : pprocsym;
  398. t : ttoken;
  399. def : pprocdef;
  400. storesymtablestack : psymtable;
  401. begin
  402. storesymtablestack:=symtablestack;
  403. symtablestack:=@self;
  404. make_ref:=false;
  405. for t:=first_overloaded to last_overloaded do
  406. begin
  407. p:=nil;
  408. def:=nil;
  409. overloaded_operators[t]:=nil;
  410. { each operator has a unique lowercased internal name PM }
  411. while assigned(symtablestack) do
  412. begin
  413. getsym(overloaded_names[t],false);
  414. if (t=_STARSTAR) and (srsym=nil) then
  415. begin
  416. symtablestack:=systemunit;
  417. getsym('POWER',false);
  418. end;
  419. if assigned(srsym) then
  420. begin
  421. if (srsym^.typ<>procsym) then
  422. internalerror(12344321);
  423. if assigned(p) then
  424. begin
  425. {$ifdef CHAINPROCSYMS}
  426. p^.nextprocsym:=pprocsym(srsym);
  427. {$endif CHAINPROCSYMS}
  428. def^.nextoverloaded:=pprocsym(srsym)^.definition;
  429. end
  430. else
  431. overloaded_operators[t]:=pprocsym(srsym);
  432. p:=pprocsym(srsym);
  433. def:=p^.definition;
  434. while assigned(def^.nextoverloaded) and
  435. (def^.nextoverloaded^.owner=p^.owner) do
  436. def:=def^.nextoverloaded;
  437. def^.nextoverloaded:=nil;
  438. symtablestack:=srsymtable^.next;
  439. end
  440. else
  441. begin
  442. symtablestack:=nil;
  443. {$ifdef CHAINPROCSYMS}
  444. if assigned(p) then
  445. p^.nextprocsym:=nil;
  446. {$endif CHAINPROCSYMS}
  447. end;
  448. { search for same procsym in other units }
  449. end;
  450. symtablestack:=@self;
  451. end;
  452. make_ref:=true;
  453. symtablestack:=storesymtablestack;
  454. end;
  455. {$endif DONOTCHAINOPERATORS}
  456. procedure tstoredsymtable.loaddefs;
  457. var
  458. hp : pdef;
  459. b : byte;
  460. begin
  461. { load start of definition section, which holds the amount of defs }
  462. if current_ppu^.readentry<>ibstartdefs then
  463. Message(unit_f_ppu_read_error);
  464. current_ppu^.getlongint;
  465. { read definitions }
  466. repeat
  467. b:=current_ppu^.readentry;
  468. case b of
  469. ibpointerdef : hp:=new(ppointerdef,load);
  470. ibarraydef : hp:=new(parraydef,load);
  471. iborddef : hp:=new(porddef,load);
  472. ibfloatdef : hp:=new(pfloatdef,load);
  473. ibprocdef : hp:=new(pprocdef,load);
  474. ibshortstringdef : hp:=new(pstringdef,shortload);
  475. iblongstringdef : hp:=new(pstringdef,longload);
  476. ibansistringdef : hp:=new(pstringdef,ansiload);
  477. ibwidestringdef : hp:=new(pstringdef,wideload);
  478. ibrecorddef : hp:=new(precorddef,load);
  479. ibobjectdef : hp:=new(pobjectdef,load);
  480. ibenumdef : hp:=new(penumdef,load);
  481. ibsetdef : hp:=new(psetdef,load);
  482. ibprocvardef : hp:=new(pprocvardef,load);
  483. ibfiledef : hp:=new(pfiledef,load);
  484. ibclassrefdef : hp:=new(pclassrefdef,load);
  485. ibformaldef : hp:=new(pformaldef,load);
  486. ibenddefs : break;
  487. ibend : Message(unit_f_ppu_read_error);
  488. else
  489. Message1(unit_f_ppu_invalid_entry,tostr(b));
  490. end;
  491. hp^.owner:=@self;
  492. defindex^.insert(hp);
  493. until false;
  494. end;
  495. procedure tstoredsymtable.loadsyms;
  496. var
  497. b : byte;
  498. sym : psym;
  499. begin
  500. { load start of definition section, which holds the amount of defs }
  501. if current_ppu^.readentry<>ibstartsyms then
  502. Message(unit_f_ppu_read_error);
  503. { skip amount of symbols, not used currently }
  504. current_ppu^.getlongint;
  505. { load datasize,dataalignment of this symboltable }
  506. datasize:=current_ppu^.getlongint;
  507. dataalignment:=current_ppu^.getlongint;
  508. { now read the symbols }
  509. repeat
  510. b:=current_ppu^.readentry;
  511. case b of
  512. ibtypesym : sym:=new(ptypesym,load);
  513. ibprocsym : sym:=new(pprocsym,load);
  514. ibconstsym : sym:=new(pconstsym,load);
  515. ibvarsym : sym:=new(pvarsym,load);
  516. ibfuncretsym : sym:=new(pfuncretsym,load);
  517. ibabsolutesym : sym:=new(pabsolutesym,load);
  518. ibenumsym : sym:=new(penumsym,load);
  519. ibtypedconstsym : sym:=new(ptypedconstsym,load);
  520. ibpropertysym : sym:=new(ppropertysym,load);
  521. ibunitsym : sym:=new(punitsym,load);
  522. iblabelsym : sym:=new(plabelsym,load);
  523. ibsyssym : sym:=new(psyssym,load);
  524. ibendsyms : break;
  525. ibend : Message(unit_f_ppu_read_error);
  526. else
  527. Message1(unit_f_ppu_invalid_entry,tostr(b));
  528. end;
  529. sym^.owner:=@self;
  530. symindex^.insert(sym);
  531. symsearch^.insert(sym);
  532. until false;
  533. end;
  534. procedure tstoredsymtable.writedefs;
  535. var
  536. pd : pstoreddef;
  537. begin
  538. { each definition get a number, write then the amount of defs to the
  539. ibstartdef entry }
  540. current_ppu^.putlongint(defindex^.count);
  541. current_ppu^.writeentry(ibstartdefs);
  542. { now write the definition }
  543. pd:=pstoreddef(defindex^.first);
  544. while assigned(pd) do
  545. begin
  546. pd^.write;
  547. pd:=pstoreddef(pd^.indexnext);
  548. end;
  549. { write end of definitions }
  550. current_ppu^.writeentry(ibenddefs);
  551. end;
  552. procedure tstoredsymtable.writesyms;
  553. var
  554. pd : pstoredsym;
  555. begin
  556. { each definition get a number, write then the amount of syms and the
  557. datasize to the ibsymdef entry }
  558. current_ppu^.putlongint(symindex^.count);
  559. current_ppu^.putlongint(datasize);
  560. current_ppu^.putlongint(dataalignment);
  561. current_ppu^.writeentry(ibstartsyms);
  562. { foreach is used to write all symbols }
  563. pd:=pstoredsym(symindex^.first);
  564. while assigned(pd) do
  565. begin
  566. pd^.write;
  567. pd:=pstoredsym(pd^.indexnext);
  568. end;
  569. { end of symbols }
  570. current_ppu^.writeentry(ibendsyms);
  571. end;
  572. {***********************************************
  573. Browser
  574. ***********************************************}
  575. procedure tstoredsymtable.load_browser;
  576. var
  577. b : byte;
  578. sym : pstoredsym;
  579. prdef : pstoreddef;
  580. oldrecsyms : psymtable;
  581. begin
  582. if symtabletype in [recordsymtable,objectsymtable] then
  583. begin
  584. oldrecsyms:=aktrecordsymtable;
  585. aktrecordsymtable:=@self;
  586. end;
  587. if symtabletype in [parasymtable,localsymtable] then
  588. begin
  589. oldrecsyms:=aktlocalsymtable;
  590. aktlocalsymtable:=@self;
  591. end;
  592. if symtabletype=staticppusymtable then
  593. aktstaticsymtable:=@self;
  594. b:=current_ppu^.readentry;
  595. if b <> ibbeginsymtablebrowser then
  596. Message1(unit_f_ppu_invalid_entry,tostr(b));
  597. repeat
  598. b:=current_ppu^.readentry;
  599. case b of
  600. ibsymref : begin
  601. sym:=pstoredsym(readderef);
  602. resolvesym(sym);
  603. if assigned(sym) then
  604. sym^.load_references;
  605. end;
  606. ibdefref : begin
  607. prdef:=pstoreddef(readderef);
  608. resolvedef(prdef);
  609. if assigned(prdef) then
  610. begin
  611. if prdef^.deftype<>procdef then
  612. Message(unit_f_ppu_read_error);
  613. pprocdef(prdef)^.load_references;
  614. end;
  615. end;
  616. ibendsymtablebrowser : break;
  617. else
  618. Message1(unit_f_ppu_invalid_entry,tostr(b));
  619. end;
  620. until false;
  621. if symtabletype in [recordsymtable,objectsymtable] then
  622. aktrecordsymtable:=oldrecsyms;
  623. if symtabletype in [parasymtable,localsymtable] then
  624. aktlocalsymtable:=oldrecsyms;
  625. end;
  626. procedure tstoredsymtable.write_browser;
  627. var
  628. oldrecsyms : psymtable;
  629. begin
  630. { symbol numbering for references
  631. should have been done in write PM
  632. number_symbols;
  633. number_defs; }
  634. if symtabletype in [recordsymtable,objectsymtable] then
  635. begin
  636. oldrecsyms:=aktrecordsymtable;
  637. aktrecordsymtable:=@self;
  638. end;
  639. if symtabletype in [parasymtable,localsymtable] then
  640. begin
  641. oldrecsyms:=aktlocalsymtable;
  642. aktlocalsymtable:=@self;
  643. end;
  644. current_ppu^.writeentry(ibbeginsymtablebrowser);
  645. foreach({$ifdef FPCPROCVAR}@{$endif}write_refs);
  646. current_ppu^.writeentry(ibendsymtablebrowser);
  647. if symtabletype in [recordsymtable,objectsymtable] then
  648. aktrecordsymtable:=oldrecsyms;
  649. if symtabletype in [parasymtable,localsymtable] then
  650. aktlocalsymtable:=oldrecsyms;
  651. end;
  652. {$ifdef GDB}
  653. function tstoredsymtable.getnewtypecount : word;
  654. begin
  655. getnewtypecount:=pglobaltypecount^;
  656. inc(pglobaltypecount^);
  657. end;
  658. {$endif GDB}
  659. procedure order_overloads(p : Pnamedindexobject);
  660. begin
  661. if psym(p)^.typ=procsym then
  662. pprocsym(p)^.order_overloaded;
  663. end;
  664. procedure tstoredsymtable.prederef;
  665. var
  666. hp : pdef;
  667. hs : psym;
  668. begin
  669. { first deref the ttypesyms }
  670. hs:=psym(symindex^.first);
  671. while assigned(hs) do
  672. begin
  673. hs^.prederef;
  674. hs:=psym(hs^.indexnext);
  675. end;
  676. end;
  677. procedure tstoredsymtable.deref;
  678. var
  679. hp : pdef;
  680. hs : psym;
  681. begin
  682. { deref the definitions }
  683. hp:=pdef(defindex^.first);
  684. while assigned(hp) do
  685. begin
  686. hp^.deref;
  687. hp:=pdef(hp^.indexnext);
  688. end;
  689. { deref the symbols }
  690. hs:=psym(symindex^.first);
  691. while assigned(hs) do
  692. begin
  693. hs^.deref;
  694. hs:=psym(hs^.indexnext);
  695. end;
  696. end;
  697. { this procedure is reserved for inserting case variant into
  698. a record symtable }
  699. { the offset is the location of the start of the variant
  700. and datasize and dataalignment corresponds to
  701. the complete size (see code in pdecl unit) PM }
  702. procedure tstoredsymtable.insert_in(psymt : psymtable;offset : longint);
  703. var
  704. ps,nps : pvarsym;
  705. pd,npd : pdef;
  706. storesize,storealign : longint;
  707. begin
  708. storesize:=psymt^.datasize;
  709. storealign:=psymt^.dataalignment;
  710. psymt^.datasize:=offset;
  711. ps:=pvarsym(symindex^.first);
  712. while assigned(ps) do
  713. begin
  714. { this is used to insert case variant into the main
  715. record }
  716. psymt^.datasize:=ps^.address+offset;
  717. nps:=pvarsym(ps^.indexnext);
  718. symindex^.deleteindex(ps);
  719. ps^.indexnext:=nil;
  720. ps^.left:=nil;
  721. ps^.right:=nil;
  722. psymt^.insert(ps);
  723. ps:=nps;
  724. end;
  725. pd:=pdef(defindex^.first);
  726. while assigned(pd) do
  727. begin
  728. npd:=pdef(pd^.indexnext);
  729. defindex^.deleteindex(pd);
  730. pd^.indexnext:=nil;
  731. pd^.left:=nil;
  732. pd^.right:=nil;
  733. psymt^.registerdef(pd);
  734. pd:=npd;
  735. end;
  736. psymt^.datasize:=storesize;
  737. psymt^.dataalignment:=storealign;
  738. end;
  739. constructor tstoredsymtable.loadas(typ : tsymtabletype);
  740. var
  741. storesymtable : psymtable;
  742. st_loading : boolean;
  743. begin
  744. st_loading:=in_loading;
  745. in_loading:=true;
  746. symtabletype:=typ;
  747. new(symindex,init(indexgrowsize));
  748. new(defindex,init(indexgrowsize));
  749. new(symsearch,init);
  750. symsearch^.noclear:=true;
  751. { reset }
  752. defowner:=nil;
  753. name:=nil;
  754. if typ=parasymtable then
  755. dataalignment:=4
  756. else
  757. dataalignment:=1;
  758. datasize:=0;
  759. address_fixup:= 0;
  760. unitid:=0;
  761. { setup symtabletype specific things }
  762. case typ of
  763. unitsymtable :
  764. begin
  765. symtablelevel:=0;
  766. {$ifndef NEWMAP}
  767. current_module.map^[0]:=@self;
  768. {$else NEWMAP}
  769. current_module.globalsymtable:=@self;
  770. {$endif NEWMAP}
  771. end;
  772. recordsymtable,
  773. objectsymtable :
  774. begin
  775. storesymtable:=aktrecordsymtable;
  776. aktrecordsymtable:=@self;
  777. end;
  778. parasymtable,
  779. localsymtable :
  780. begin
  781. storesymtable:=aktlocalsymtable;
  782. aktlocalsymtable:=@self;
  783. end;
  784. { used for local browser }
  785. staticppusymtable :
  786. begin
  787. aktstaticsymtable:=@self;
  788. symsearch^.usehash;
  789. end;
  790. end;
  791. { we need the correct symtable for registering }
  792. if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
  793. begin
  794. next:=symtablestack;
  795. symtablestack:=@self;
  796. end;
  797. { load definitions }
  798. loaddefs;
  799. { load symbols }
  800. loadsyms;
  801. if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
  802. begin
  803. { now we can deref the syms and defs }
  804. prederef;
  805. { restore symtablestack }
  806. symtablestack:=next;
  807. end;
  808. case typ of
  809. unitsymtable :
  810. begin
  811. {$ifdef NEWMAP}
  812. { necessary for dependencies }
  813. current_module.globalsymtable:=nil;
  814. {$endif NEWMAP}
  815. end;
  816. recordsymtable,
  817. objectsymtable :
  818. aktrecordsymtable:=storesymtable;
  819. localsymtable,
  820. parasymtable :
  821. aktlocalsymtable:=storesymtable;
  822. end;
  823. in_loading:=st_loading;
  824. end;
  825. procedure tstoredsymtable.writeas;
  826. var
  827. oldtyp : byte;
  828. storesymtable : psymtable;
  829. begin
  830. storesymtable:=aktrecordsymtable;
  831. case symtabletype of
  832. recordsymtable,
  833. objectsymtable :
  834. begin
  835. storesymtable:=aktrecordsymtable;
  836. aktrecordsymtable:=@self;
  837. oldtyp:=current_ppu^.entrytyp;
  838. current_ppu^.entrytyp:=subentryid;
  839. end;
  840. parasymtable,
  841. localsymtable :
  842. begin
  843. storesymtable:=aktlocalsymtable;
  844. aktlocalsymtable:=@self;
  845. end;
  846. end;
  847. { order procsym overloads }
  848. foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
  849. { write definitions }
  850. writedefs;
  851. { write symbols }
  852. writesyms;
  853. case symtabletype of
  854. recordsymtable,
  855. objectsymtable :
  856. begin
  857. current_ppu^.entrytyp:=oldtyp;
  858. aktrecordsymtable:=storesymtable;
  859. end;
  860. localsymtable,
  861. parasymtable :
  862. aktlocalsymtable:=storesymtable;
  863. end;
  864. end;
  865. procedure tstoredsymtable.insert(sym:psymentry);
  866. var
  867. hp : psymtable;
  868. hsym : psym;
  869. begin
  870. { set owner and sym indexnb }
  871. sym^.owner:=@self;
  872. {$ifdef CHAINPROCSYMS}
  873. { set the nextprocsym field }
  874. if sym^.typ=procsym then
  875. chainprocsym(sym);
  876. {$endif CHAINPROCSYMS}
  877. { writes the symbol in data segment if required }
  878. { also sets the datasize of owner }
  879. if not in_loading then
  880. pstoredsym(sym)^.insert_in_data;
  881. if (symtabletype in [staticsymtable,globalsymtable]) then
  882. begin
  883. hp:=symtablestack;
  884. while assigned(hp) do
  885. begin
  886. if hp^.symtabletype in [staticsymtable,globalsymtable] then
  887. begin
  888. hsym:=psym(hp^.search(sym^.name));
  889. if assigned(hsym) then
  890. DuplicateSym(hsym);
  891. end;
  892. hp:=hp^.next;
  893. end;
  894. end;
  895. { check the current symtable }
  896. hsym:=psym(search(sym^.name));
  897. if assigned(hsym) then
  898. begin
  899. { in TP and Delphi you can have a local with the
  900. same name as the function, the function is then hidden for
  901. the user. (Under delphi it can still be accessed using result),
  902. but don't allow hiding of RESULT }
  903. if (m_tp in aktmodeswitches) and
  904. (hsym^.typ=funcretsym) and
  905. not((m_result in aktmodeswitches) and
  906. (hsym^.name='RESULT')) then
  907. hsym^.owner^.rename(hsym^.name,'hidden'+hsym^.name)
  908. else
  909. begin
  910. DuplicateSym(hsym);
  911. exit;
  912. end;
  913. end;
  914. { check for duplicate id in local and parasymtable symtable }
  915. if (symtabletype=localsymtable) then
  916. { to be on the save side: }
  917. begin
  918. if assigned(next) and
  919. (next^.symtabletype=parasymtable) then
  920. begin
  921. hsym:=psym(next^.search(sym^.name));
  922. if assigned(hsym) then
  923. begin
  924. { a parameter and the function can have the same
  925. name in TP and Delphi, but RESULT not }
  926. if (m_tp in aktmodeswitches) and
  927. (sym^.typ=funcretsym) and
  928. not((m_result in aktmodeswitches) and
  929. (sym^.name='RESULT')) then
  930. sym^.setname('hidden'+sym^.name)
  931. else
  932. begin
  933. DuplicateSym(hsym);
  934. exit;
  935. end;
  936. end;
  937. end
  938. else if (current_module.flags and uf_local_browser)=0 then
  939. internalerror(43789);
  940. end;
  941. { check for duplicate id in local symtable of methods }
  942. if (symtabletype=localsymtable) and
  943. assigned(next) and
  944. assigned(next^.next) and
  945. { funcretsym is allowed !! }
  946. (sym^.typ <> funcretsym) and
  947. (next^.next^.symtabletype=objectsymtable) then
  948. begin
  949. hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
  950. if assigned(hsym) and
  951. { private ids can be reused }
  952. (not(sp_private in hsym^.symoptions) or
  953. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  954. begin
  955. { delphi allows to reuse the names in a class, but not
  956. in object (tp7 compatible) }
  957. if not((m_delphi in aktmodeswitches) and
  958. is_class(pdef(next^.next^.defowner))) then
  959. begin
  960. DuplicateSym(hsym);
  961. exit;
  962. end;
  963. end;
  964. end;
  965. { check for duplicate id in para symtable of methods }
  966. if (symtabletype=parasymtable) and
  967. assigned(procinfo^._class) and
  968. { but not in nested procedures !}
  969. (not(assigned(procinfo^.parent)) or
  970. (assigned(procinfo^.parent) and
  971. not(assigned(procinfo^.parent^._class)))
  972. ) and
  973. { funcretsym is allowed !! }
  974. (sym^.typ <> funcretsym) then
  975. begin
  976. hsym:=search_class_member(procinfo^._class,sym^.name);
  977. if assigned(hsym) and
  978. { private ids can be reused }
  979. (not(sp_private in hsym^.symoptions) or
  980. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  981. begin
  982. { delphi allows to reuse the names in a class, but not
  983. in object (tp7 compatible) }
  984. if not((m_delphi in aktmodeswitches) and
  985. is_class(procinfo^._class)) then
  986. begin
  987. DuplicateSym(hsym);
  988. exit;
  989. end;
  990. end;
  991. end;
  992. { check for duplicate field id in inherited classes }
  993. if (sym^.typ=varsym) and
  994. (symtabletype=objectsymtable) and
  995. assigned(defowner) and
  996. (
  997. not(m_delphi in aktmodeswitches) or
  998. is_object(pdef(defowner))
  999. ) then
  1000. begin
  1001. hsym:=search_class_member(pobjectdef(defowner),sym^.name);
  1002. { but private ids can be reused }
  1003. if assigned(hsym) and
  1004. (not(sp_private in hsym^.symoptions) or
  1005. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1006. begin
  1007. DuplicateSym(hsym);
  1008. exit;
  1009. end;
  1010. end;
  1011. { register definition of typesym }
  1012. if (sym^.typ = typesym) and
  1013. assigned(ptypesym(sym)^.restype.def) then
  1014. begin
  1015. if not(assigned(ptypesym(sym)^.restype.def^.owner)) and
  1016. (ptypesym(sym)^.restype.def^.deftype<>errordef) then
  1017. registerdef(ptypesym(sym)^.restype.def);
  1018. {$ifdef GDB}
  1019. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  1020. (symtabletype in [globalsymtable,staticsymtable]) then
  1021. begin
  1022. ptypesym(sym)^.isusedinstab := true;
  1023. {sym^.concatstabto(debuglist);}
  1024. end;
  1025. {$endif GDB}
  1026. end;
  1027. { insert in index and search hash }
  1028. symindex^.insert(sym);
  1029. symsearch^.insert(sym);
  1030. end;
  1031. function tstoredsymtable.speedsearch(const s : stringid;speedvalue : longint) : psymentry;
  1032. var
  1033. hp : pstoredsym;
  1034. newref : pref;
  1035. begin
  1036. hp:=pstoredsym(inherited speedsearch(s,speedvalue));
  1037. if assigned(hp) then
  1038. begin
  1039. { reject non static members in static procedures,
  1040. be carefull aktprocsym^.definition is not allways
  1041. loaded already (PFV) }
  1042. if (symtabletype=objectsymtable) and
  1043. not(sp_static in hp^.symoptions) and
  1044. allow_only_static
  1045. {assigned(aktprocsym) and
  1046. assigned(aktprocsym^.definition) and
  1047. ((aktprocsym^.definition^.options and postaticmethod)<>0)} then
  1048. Message(sym_e_only_static_in_static);
  1049. if (symtabletype=unitsymtable) and
  1050. assigned(punitsymtable(@self)^.unitsym) then
  1051. inc(punitsymtable(@self)^.unitsym^.refs);
  1052. {$ifdef GDB}
  1053. { if it is a type, we need the stabs of this type
  1054. this might be the cause of the class debug problems
  1055. as TCHILDCLASS.Create did not generate appropriate
  1056. stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
  1057. if (hp^.typ=typesym) and make_ref then
  1058. begin
  1059. if assigned(ptypesym(hp)^.restype.def) then
  1060. pstoreddef(ptypesym(hp)^.restype.def)^.numberstring
  1061. else
  1062. ptypesym(hp)^.isusedinstab:=true;
  1063. end;
  1064. {$endif GDB}
  1065. { unitsym are only loaded for browsing PM }
  1066. { this was buggy anyway because we could use }
  1067. { unitsyms from other units in _USES !! }
  1068. {if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
  1069. assigned(current_module) and (current_module.globalsymtable<>@self) then
  1070. hp:=nil;}
  1071. if assigned(hp) and
  1072. (cs_browser in aktmoduleswitches) and make_ref then
  1073. begin
  1074. new(newref,init(hp^.lastref,@akttokenpos));
  1075. { for symbols that are in tables without
  1076. browser info or syssyms (PM) }
  1077. if hp^.refcount=0 then
  1078. begin
  1079. hp^.defref:=newref;
  1080. hp^.lastref:=newref;
  1081. end
  1082. else
  1083. if resolving_forward and assigned(hp^.defref) then
  1084. { put it as second reference }
  1085. begin
  1086. newref^.nextref:=hp^.defref^.nextref;
  1087. hp^.defref^.nextref:=newref;
  1088. hp^.lastref^.nextref:=nil;
  1089. end
  1090. else
  1091. hp^.lastref:=newref;
  1092. inc(hp^.refcount);
  1093. end;
  1094. if assigned(hp) and make_ref then
  1095. begin
  1096. inc(hp^.refs);
  1097. end;
  1098. end;
  1099. speedsearch:=hp;
  1100. end;
  1101. {***********************************************
  1102. Process all entries
  1103. ***********************************************}
  1104. { checks, if all procsyms and methods are defined }
  1105. procedure tstoredsymtable.check_forwards;
  1106. begin
  1107. foreach({$ifdef FPCPROCVAR}@{$endif}check_forward);
  1108. end;
  1109. procedure tstoredsymtable.checklabels;
  1110. begin
  1111. foreach({$ifdef FPCPROCVAR}@{$endif}labeldefined);
  1112. end;
  1113. procedure tstoredsymtable.set_alignment(_alignment : longint);
  1114. var
  1115. sym : pvarsym;
  1116. l : longint;
  1117. begin
  1118. dataalignment:=_alignment;
  1119. if (symtabletype<>parasymtable) then
  1120. internalerror(1111);
  1121. sym:=pvarsym(symindex^.first);
  1122. datasize:=0;
  1123. { there can be only varsyms }
  1124. while assigned(sym) do
  1125. begin
  1126. l:=sym^.getpushsize;
  1127. sym^.address:=datasize;
  1128. datasize:=align(datasize+l,dataalignment);
  1129. sym:=pvarsym(sym^.indexnext);
  1130. end;
  1131. end;
  1132. procedure tstoredsymtable.allunitsused;
  1133. begin
  1134. foreach({$ifdef FPCPROCVAR}@{$endif}unitsymbolused);
  1135. end;
  1136. procedure tstoredsymtable.allsymbolsused;
  1137. begin
  1138. foreach({$ifdef FPCPROCVAR}@{$endif}varsymbolused);
  1139. end;
  1140. procedure tstoredsymtable.allprivatesused;
  1141. begin
  1142. foreach({$ifdef FPCPROCVAR}@{$endif}objectprivatesymbolused);
  1143. end;
  1144. {$ifdef CHAINPROCSYMS}
  1145. procedure tstoredsymtable.chainprocsyms;
  1146. begin
  1147. foreach({$ifdef FPCPROCVAR}@{$endif}chainprocsym);
  1148. end;
  1149. {$endif CHAINPROCSYMS}
  1150. {$ifdef GDB}
  1151. procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
  1152. begin
  1153. asmoutput:=asmlist;
  1154. if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
  1155. foreach({$ifdef FPCPROCVAR}@{$endif}resetstab);
  1156. foreach({$ifdef FPCPROCVAR}@{$endif}concatstab);
  1157. end;
  1158. {$endif}
  1159. {****************************************************************************
  1160. TWITHSYMTABLE
  1161. ****************************************************************************}
  1162. constructor twithsymtable.init;
  1163. begin
  1164. inherited init(withsymtable);
  1165. direct_with:=false;
  1166. withnode:=nil;
  1167. withrefnode:=nil;
  1168. { we don't need the symsearch }
  1169. dispose(symsearch,done);
  1170. symsearch:=nil;
  1171. end;
  1172. destructor twithsymtable.done;
  1173. begin
  1174. symsearch:=nil;
  1175. inherited done;
  1176. end;
  1177. procedure twithsymtable.clear;
  1178. begin
  1179. { remove no entry from a withsymtable as it is only a pointer to the
  1180. recorddef or objectdef symtable }
  1181. end;
  1182. {****************************************************************************
  1183. PPU Writing Helpers
  1184. ****************************************************************************}
  1185. procedure writesourcefiles;
  1186. var
  1187. hp : tinputfile;
  1188. i,j : longint;
  1189. begin
  1190. { second write the used source files }
  1191. current_ppu^.do_crc:=false;
  1192. hp:=current_module.sourcefiles.files;
  1193. { write source files directly in good order }
  1194. j:=0;
  1195. while assigned(hp) do
  1196. begin
  1197. inc(j);
  1198. hp:=hp.ref_next;
  1199. end;
  1200. while j>0 do
  1201. begin
  1202. hp:=current_module.sourcefiles.files;
  1203. for i:=1 to j-1 do
  1204. hp:=hp.ref_next;
  1205. current_ppu^.putstring(hp.name^);
  1206. dec(j);
  1207. end;
  1208. current_ppu^.writeentry(ibsourcefiles);
  1209. current_ppu^.do_crc:=true;
  1210. end;
  1211. procedure writeusedmacro(p:pnamedindexobject);
  1212. begin
  1213. if pmacro(p)^.is_used or pmacro(p)^.defined_at_startup then
  1214. begin
  1215. current_ppu^.putstring(p^.name);
  1216. current_ppu^.putbyte(byte(pmacro(p)^.defined_at_startup));
  1217. current_ppu^.putbyte(byte(pmacro(p)^.is_used));
  1218. end;
  1219. end;
  1220. procedure writeusedmacros;
  1221. begin
  1222. current_ppu^.do_crc:=false;
  1223. current_scanner^.macros^.foreach({$ifdef FPCPROCVAR}@{$endif}writeusedmacro);
  1224. current_ppu^.writeentry(ibusedmacros);
  1225. current_ppu^.do_crc:=true;
  1226. end;
  1227. procedure writeusedunit;
  1228. var
  1229. hp : tused_unit;
  1230. begin
  1231. numberunits;
  1232. hp:=tused_unit(current_module.used_units.first);
  1233. while assigned(hp) do
  1234. begin
  1235. { implementation units should not change
  1236. the CRC PM }
  1237. current_ppu^.do_crc:=hp.in_interface;
  1238. current_ppu^.putstring(hp.name^);
  1239. { the checksum should not affect the crc of this unit ! (PFV) }
  1240. current_ppu^.do_crc:=false;
  1241. current_ppu^.putlongint(hp.checksum);
  1242. current_ppu^.putlongint(hp.interface_checksum);
  1243. current_ppu^.putbyte(byte(hp.in_interface));
  1244. current_ppu^.do_crc:=true;
  1245. hp:=tused_unit(hp.next);
  1246. end;
  1247. current_ppu^.do_interface_crc:=true;
  1248. current_ppu^.writeentry(ibloadunit);
  1249. end;
  1250. procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  1251. var
  1252. hcontainer : tlinkcontainer;
  1253. s : string;
  1254. mask : longint;
  1255. begin
  1256. hcontainer:=TLinkContainer.Create;
  1257. while not p.empty do
  1258. begin
  1259. s:=p.get(mask);
  1260. if strippath then
  1261. current_ppu^.putstring(SplitFileName(s))
  1262. else
  1263. current_ppu^.putstring(s);
  1264. current_ppu^.putlongint(mask);
  1265. hcontainer.add(s,mask);
  1266. end;
  1267. current_ppu^.writeentry(id);
  1268. p:=hcontainer;
  1269. end;
  1270. procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
  1271. begin
  1272. Message1(unit_u_ppu_write,s);
  1273. { create unit flags }
  1274. with Current_Module do
  1275. begin
  1276. {$ifdef GDB}
  1277. if cs_gdb_dbx in aktglobalswitches then
  1278. flags:=flags or uf_has_dbx;
  1279. {$endif GDB}
  1280. if target_os.endian=endian_big then
  1281. flags:=flags or uf_big_endian;
  1282. if cs_browser in aktmoduleswitches then
  1283. flags:=flags or uf_has_browser;
  1284. if cs_local_browser in aktmoduleswitches then
  1285. flags:=flags or uf_local_browser;
  1286. end;
  1287. {$ifdef Test_Double_checksum_write}
  1288. If only_crc then
  1289. Assign(CRCFile,s+'.INT')
  1290. else
  1291. Assign(CRCFile,s+'.IMP');
  1292. Rewrite(CRCFile);
  1293. {$endif def Test_Double_checksum_write}
  1294. { open ppufile }
  1295. current_ppu:=new(pppufile,init(s));
  1296. current_ppu^.crc_only:=only_crc;
  1297. if not current_ppu^.create then
  1298. Message(unit_f_ppu_cannot_write);
  1299. {$ifdef Test_Double_checksum}
  1300. if only_crc then
  1301. begin
  1302. new(current_ppu^.crc_test);
  1303. new(current_ppu^.crc_test2);
  1304. end
  1305. else
  1306. begin
  1307. current_ppu^.crc_test:=current_module.crc_array;
  1308. current_ppu^.crc_index:=current_module.crc_size;
  1309. current_ppu^.crc_test2:=current_module.crc_array2;
  1310. current_ppu^.crc_index2:=current_module.crc_size2;
  1311. end;
  1312. {$endif def Test_Double_checksum}
  1313. current_ppu^.change_endian:=source_os.endian<>target_os.endian;
  1314. { write symbols and definitions }
  1315. unittable^.writeasunit;
  1316. { flush to be sure }
  1317. current_ppu^.flush;
  1318. { create and write header }
  1319. current_ppu^.header.size:=current_ppu^.size;
  1320. current_ppu^.header.checksum:=current_ppu^.crc;
  1321. current_ppu^.header.interface_checksum:=current_ppu^.interface_crc;
  1322. current_ppu^.header.compiler:=wordversion;
  1323. current_ppu^.header.cpu:=word(target_cpu);
  1324. current_ppu^.header.target:=word(target_info.target);
  1325. current_ppu^.header.flags:=current_module.flags;
  1326. If not only_crc then
  1327. current_ppu^.writeheader;
  1328. { save crc in current_module also }
  1329. current_module.crc:=current_ppu^.crc;
  1330. current_module.interface_crc:=current_ppu^.interface_crc;
  1331. if only_crc then
  1332. begin
  1333. {$ifdef Test_Double_checksum}
  1334. current_module.crc_array:=current_ppu^.crc_test;
  1335. current_ppu^.crc_test:=nil;
  1336. current_module.crc_size:=current_ppu^.crc_index2;
  1337. current_module.crc_array2:=current_ppu^.crc_test2;
  1338. current_ppu^.crc_test2:=nil;
  1339. current_module.crc_size2:=current_ppu^.crc_index2;
  1340. {$endif def Test_Double_checksum}
  1341. closecurrentppu;
  1342. end;
  1343. {$ifdef Test_Double_checksum_write}
  1344. close(CRCFile);
  1345. {$endif Test_Double_checksum_write}
  1346. end;
  1347. procedure readusedmacros;
  1348. var
  1349. hs : string;
  1350. mac : pmacro;
  1351. was_defined_at_startup,
  1352. was_used : boolean;
  1353. begin
  1354. while not current_ppu^.endofentry do
  1355. begin
  1356. hs:=current_ppu^.getstring;
  1357. was_defined_at_startup:=boolean(current_ppu^.getbyte);
  1358. was_used:=boolean(current_ppu^.getbyte);
  1359. mac:=pmacro(current_scanner^.macros^.search(hs));
  1360. if assigned(mac) then
  1361. begin
  1362. {$ifndef EXTDEBUG}
  1363. { if we don't have the sources why tell }
  1364. if current_module.sources_avail then
  1365. {$endif ndef EXTDEBUG}
  1366. if (not was_defined_at_startup) and
  1367. was_used and
  1368. mac^.defined_at_startup then
  1369. Message2(unit_h_cond_not_set_in_last_compile,hs,current_module.mainsource^);
  1370. end
  1371. else { not assigned }
  1372. if was_defined_at_startup and
  1373. was_used then
  1374. Message2(unit_h_cond_not_set_in_last_compile,hs,current_module.mainsource^);
  1375. end;
  1376. end;
  1377. procedure readsourcefiles;
  1378. var
  1379. temp,hs : string;
  1380. temp_dir : string;
  1381. main_dir : string;
  1382. incfile_found,
  1383. main_found,
  1384. is_main : boolean;
  1385. ppufiletime,
  1386. source_time : longint;
  1387. hp : tinputfile;
  1388. begin
  1389. ppufiletime:=getnamedfiletime(current_module.ppufilename^);
  1390. current_module.sources_avail:=true;
  1391. is_main:=true;
  1392. main_dir:='';
  1393. while not current_ppu^.endofentry do
  1394. begin
  1395. hs:=current_ppu^.getstring;
  1396. temp_dir:='';
  1397. if (current_module.flags and uf_in_library)<>0 then
  1398. begin
  1399. current_module.sources_avail:=false;
  1400. temp:=' library';
  1401. end
  1402. else if pos('Macro ',hs)=1 then
  1403. begin
  1404. { we don't want to find this file }
  1405. { but there is a problem with file indexing !! }
  1406. temp:='';
  1407. end
  1408. else
  1409. begin
  1410. { check the date of the source files }
  1411. Source_Time:=GetNamedFileTime(current_module.path^+hs);
  1412. incfile_found:=false;
  1413. main_found:=false;
  1414. if Source_Time<>-1 then
  1415. hs:=current_module.path^+hs
  1416. else
  1417. if not(is_main) then
  1418. begin
  1419. Source_Time:=GetNamedFileTime(main_dir+hs);
  1420. if Source_Time<>-1 then
  1421. hs:=main_dir+hs;
  1422. end;
  1423. if (Source_Time=-1) then
  1424. begin
  1425. if is_main then
  1426. main_found:=unitsearchpath.FindFile(hs,temp_dir)
  1427. else
  1428. incfile_found:=includesearchpath.FindFile(hs,temp_dir);
  1429. if incfile_found or main_found then
  1430. Source_Time:=GetNamedFileTime(temp_dir);
  1431. end;
  1432. if Source_Time=-1 then
  1433. begin
  1434. current_module.sources_avail:=false;
  1435. temp:=' not found';
  1436. end
  1437. else
  1438. begin
  1439. if main_found then
  1440. main_dir:=temp_dir;
  1441. { time newer? But only allow if the file is not searched
  1442. in the include path (PFV), else you've problems with
  1443. units which use the same includefile names }
  1444. if incfile_found then
  1445. temp:=' found'
  1446. else
  1447. begin
  1448. temp:=' time '+filetimestring(source_time);
  1449. if (source_time>ppufiletime) then
  1450. begin
  1451. current_module.do_compile:=true;
  1452. current_module.recompile_reason:=rr_sourcenewer;
  1453. temp:=temp+' *'
  1454. end;
  1455. end;
  1456. end;
  1457. hp:=tinputfile.create(hs);
  1458. { the indexing is wrong here PM }
  1459. current_module.sourcefiles.register_file(hp);
  1460. end;
  1461. if is_main then
  1462. begin
  1463. stringdispose(current_module.mainsource);
  1464. current_module.mainsource:=stringdup(hs);
  1465. end;
  1466. Message1(unit_u_ppu_source,hs+temp);
  1467. is_main:=false;
  1468. end;
  1469. { check if we want to rebuild every unit, only if the sources are
  1470. available }
  1471. if do_build and current_module.sources_avail then
  1472. begin
  1473. current_module.do_compile:=true;
  1474. current_module.recompile_reason:=rr_build;
  1475. end;
  1476. end;
  1477. procedure readloadunit;
  1478. var
  1479. hs : string;
  1480. intfchecksum,
  1481. checksum : longint;
  1482. in_interface : boolean;
  1483. begin
  1484. while not current_ppu^.endofentry do
  1485. begin
  1486. hs:=current_ppu^.getstring;
  1487. checksum:=current_ppu^.getlongint;
  1488. intfchecksum:=current_ppu^.getlongint;
  1489. in_interface:=(current_ppu^.getbyte<>0);
  1490. current_module.used_units.concat(tused_unit.create_to_load(hs,checksum,intfchecksum,in_interface));
  1491. end;
  1492. end;
  1493. procedure readlinkcontainer(var p:tlinkcontainer);
  1494. var
  1495. s : string;
  1496. m : longint;
  1497. begin
  1498. while not current_ppu^.endofentry do
  1499. begin
  1500. s:=current_ppu^.getstring;
  1501. m:=current_ppu^.getlongint;
  1502. p.add(s,m);
  1503. end;
  1504. end;
  1505. procedure load_interface;
  1506. var
  1507. b : byte;
  1508. newmodulename : string;
  1509. begin
  1510. { read interface part }
  1511. repeat
  1512. b:=current_ppu^.readentry;
  1513. case b of
  1514. ibmodulename :
  1515. begin
  1516. newmodulename:=current_ppu^.getstring;
  1517. if upper(newmodulename)<>current_module.modulename^ then
  1518. Message2(unit_f_unit_name_error,current_module.realmodulename^,newmodulename);
  1519. stringdispose(current_module.modulename);
  1520. stringdispose(current_module.realmodulename);
  1521. current_module.modulename:=stringdup(upper(newmodulename));
  1522. current_module.realmodulename:=stringdup(newmodulename);
  1523. end;
  1524. ibsourcefiles :
  1525. readsourcefiles;
  1526. ibusedmacros :
  1527. readusedmacros;
  1528. ibloadunit :
  1529. readloadunit;
  1530. iblinkunitofiles :
  1531. readlinkcontainer(current_module.LinkUnitOFiles);
  1532. iblinkunitstaticlibs :
  1533. readlinkcontainer(current_module.LinkUnitStaticLibs);
  1534. iblinkunitsharedlibs :
  1535. readlinkcontainer(current_module.LinkUnitSharedLibs);
  1536. iblinkotherofiles :
  1537. readlinkcontainer(current_module.LinkotherOFiles);
  1538. iblinkotherstaticlibs :
  1539. readlinkcontainer(current_module.LinkotherStaticLibs);
  1540. iblinkothersharedlibs :
  1541. readlinkcontainer(current_module.LinkotherSharedLibs);
  1542. ibendinterface :
  1543. break;
  1544. else
  1545. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1546. end;
  1547. until false;
  1548. end;
  1549. {****************************************************************************
  1550. TUNITSYMTABLE
  1551. ****************************************************************************}
  1552. constructor tunitsymtable.init(t : tsymtabletype; const n : string);
  1553. begin
  1554. inherited init(t);
  1555. name:=stringdup(upper(n));
  1556. unitid:=0;
  1557. unitsym:=nil;
  1558. symsearch^.usehash;
  1559. { reset GDB things }
  1560. {$ifdef GDB}
  1561. if (t = globalsymtable) then
  1562. begin
  1563. prev_dbx_counter := dbx_counter;
  1564. dbx_counter := nil;
  1565. end;
  1566. is_stab_written:=false;
  1567. dbx_count := -1;
  1568. if cs_gdb_dbx in aktglobalswitches then
  1569. begin
  1570. dbx_count := 0;
  1571. unittypecount:=1;
  1572. if (symtabletype=globalsymtable) then
  1573. pglobaltypecount := @unittypecount;
  1574. unitid:=current_module.unitcount;
  1575. debugList.concat(Tai_asm_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
  1576. debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1577. inc(current_module.unitcount);
  1578. dbx_count_ok:=false;
  1579. dbx_counter:=@dbx_count;
  1580. do_count_dbx:=true;
  1581. end;
  1582. {$endif GDB}
  1583. end;
  1584. constructor tunitsymtable.loadasunit;
  1585. var
  1586. {$ifdef GDB}
  1587. storeGlobalTypeCount : pword;
  1588. {$endif GDB}
  1589. b : byte;
  1590. begin
  1591. unitsym:=nil;
  1592. unitid:=0;
  1593. {$ifdef GDB}
  1594. if cs_gdb_dbx in aktglobalswitches then
  1595. begin
  1596. UnitTypeCount:=1;
  1597. storeGlobalTypeCount:=PGlobalTypeCount;
  1598. PglobalTypeCount:=@UnitTypeCount;
  1599. end;
  1600. {$endif GDB}
  1601. { load symtables }
  1602. inherited loadas(unitsymtable);
  1603. { set the name after because it is set to nil in tstoredsymtable.load !! }
  1604. name:=stringdup(current_module.modulename^);
  1605. { dbx count }
  1606. {$ifdef GDB}
  1607. if (current_module.flags and uf_has_dbx)<>0 then
  1608. begin
  1609. b := current_ppu^.readentry;
  1610. if b <> ibdbxcount then
  1611. Message(unit_f_ppu_dbx_count_problem)
  1612. else
  1613. dbx_count := readlong;
  1614. dbx_count_ok := {true}false;
  1615. end
  1616. else
  1617. begin
  1618. dbx_count := -1;
  1619. dbx_count_ok:=false;
  1620. end;
  1621. if cs_gdb_dbx in aktglobalswitches then
  1622. PGlobalTypeCount:=storeGlobalTypeCount;
  1623. is_stab_written:=false;
  1624. {$endif GDB}
  1625. b:=current_ppu^.readentry;
  1626. if b<>ibendimplementation then
  1627. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1628. end;
  1629. destructor tunitsymtable.done;
  1630. var
  1631. pus : punitsym;
  1632. begin
  1633. pus:=unitsym;
  1634. while assigned(pus) do
  1635. begin
  1636. unitsym:=pus^.prevsym;
  1637. pus^.prevsym:=nil;
  1638. pus^.unitsymtable:=nil;
  1639. pus:=unitsym;
  1640. end;
  1641. inherited done;
  1642. end;
  1643. procedure tunitsymtable.load_symtable_refs;
  1644. var
  1645. b : byte;
  1646. unitindex : word;
  1647. begin
  1648. if ((current_module.flags and uf_local_browser)<>0) then
  1649. begin
  1650. current_module.localsymtable:=new(punitsymtable,loadas(staticppusymtable));
  1651. psymtable(current_module.localsymtable)^.name:=
  1652. stringdup('implementation of '+psymtable(current_module.globalsymtable)^.name^);
  1653. end;
  1654. { load browser }
  1655. if (current_module.flags and uf_has_browser)<>0 then
  1656. begin
  1657. {if not (cs_browser in aktmoduleswitches) then
  1658. current_ppu^.skipuntilentry(ibendbrowser)
  1659. else }
  1660. begin
  1661. load_browser;
  1662. unitindex:=1;
  1663. while assigned(current_module.map^[unitindex]) do
  1664. begin
  1665. {each unit wrote one browser entry }
  1666. load_browser;
  1667. inc(unitindex);
  1668. end;
  1669. b:=current_ppu^.readentry;
  1670. if b<>ibendbrowser then
  1671. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1672. end;
  1673. end;
  1674. if ((current_module.flags and uf_local_browser)<>0) then
  1675. pstoredsymtable(current_module.localsymtable)^.load_browser;
  1676. end;
  1677. procedure tunitsymtable.writeasunit;
  1678. var
  1679. pu : tused_unit;
  1680. begin
  1681. { first the unitname }
  1682. current_ppu^.putstring(current_module.realmodulename^);
  1683. current_ppu^.writeentry(ibmodulename);
  1684. writesourcefiles;
  1685. writeusedmacros;
  1686. writeusedunit;
  1687. { write the objectfiles and libraries that come for this unit,
  1688. preserve the containers becuase they are still needed to load
  1689. the link.res. All doesn't depend on the crc! It doesn't matter
  1690. if a unit is in a .o or .a file }
  1691. current_ppu^.do_crc:=false;
  1692. writelinkcontainer(current_module.linkunitofiles,iblinkunitofiles,true);
  1693. writelinkcontainer(current_module.linkunitstaticlibs,iblinkunitstaticlibs,true);
  1694. writelinkcontainer(current_module.linkunitsharedlibs,iblinkunitsharedlibs,true);
  1695. writelinkcontainer(current_module.linkotherofiles,iblinkotherofiles,false);
  1696. writelinkcontainer(current_module.linkotherstaticlibs,iblinkotherstaticlibs,true);
  1697. writelinkcontainer(current_module.linkothersharedlibs,iblinkothersharedlibs,true);
  1698. current_ppu^.do_crc:=true;
  1699. current_ppu^.writeentry(ibendinterface);
  1700. { write the symtable entries }
  1701. inherited writeas;
  1702. { all after doesn't affect crc }
  1703. current_ppu^.do_crc:=false;
  1704. { write dbx count }
  1705. {$ifdef GDB}
  1706. if cs_gdb_dbx in aktglobalswitches then
  1707. begin
  1708. {$IfDef EXTDEBUG}
  1709. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1710. {$ENDIF EXTDEBUG}
  1711. current_ppu^.putlongint(dbx_count);
  1712. current_ppu^.writeentry(ibdbxcount);
  1713. end;
  1714. {$endif GDB}
  1715. current_ppu^.writeentry(ibendimplementation);
  1716. { write static symtable
  1717. needed for local debugging of unit functions }
  1718. if ((current_module.flags and uf_local_browser)<>0) and
  1719. assigned(current_module.localsymtable) then
  1720. pstoredsymtable(current_module.localsymtable)^.writeas;
  1721. { write all browser section }
  1722. if (current_module.flags and uf_has_browser)<>0 then
  1723. begin
  1724. write_browser;
  1725. pu:=tused_unit(current_module.used_units.first);
  1726. while assigned(pu) do
  1727. begin
  1728. pstoredsymtable(pu.u.globalsymtable)^.write_browser;
  1729. pu:=tused_unit(pu.next);
  1730. end;
  1731. current_ppu^.writeentry(ibendbrowser);
  1732. end;
  1733. if ((current_module.flags and uf_local_browser)<>0) and
  1734. assigned(current_module.localsymtable) then
  1735. pstoredsymtable(current_module.localsymtable)^.write_browser;
  1736. { the last entry ibend is written automaticly }
  1737. end;
  1738. {$ifdef GDB}
  1739. function tunitsymtable.getnewtypecount : word;
  1740. begin
  1741. if not (cs_gdb_dbx in aktglobalswitches) then
  1742. getnewtypecount:=tsymtable.getnewtypecount
  1743. else
  1744. if symtabletype = staticsymtable then
  1745. getnewtypecount:=tsymtable.getnewtypecount
  1746. else
  1747. begin
  1748. getnewtypecount:=unittypecount;
  1749. inc(unittypecount);
  1750. end;
  1751. end;
  1752. procedure tunitsymtable.concattypestabto(asmlist : taasmoutput);
  1753. var prev_dbx_count : plongint;
  1754. begin
  1755. if is_stab_written then exit;
  1756. if not assigned(name) then name := stringdup('Main_program');
  1757. if (symtabletype = unitsymtable) and
  1758. (current_module.globalsymtable<>@Self) then
  1759. begin
  1760. unitid:=current_module.unitcount;
  1761. inc(current_module.unitcount);
  1762. end;
  1763. asmList.concat(Tai_asm_comment.Create(strpnew('Begin unit '+name^
  1764. +' has index '+tostr(unitid))));
  1765. if cs_gdb_dbx in aktglobalswitches then
  1766. begin
  1767. if dbx_count_ok then
  1768. begin
  1769. asmList.concat(Tai_asm_comment.Create(strpnew('"repeated" unit '+name^
  1770. +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count))));
  1771. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1772. +tostr(N_EXCL)+',0,0,'+tostr(dbx_count))));
  1773. exit;
  1774. end
  1775. else if (current_module.globalsymtable<>@Self) then
  1776. begin
  1777. prev_dbx_count := dbx_counter;
  1778. dbx_counter := nil;
  1779. do_count_dbx:=false;
  1780. if symtabletype = unitsymtable then
  1781. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
  1782. dbx_counter := @dbx_count;
  1783. dbx_count:=0;
  1784. do_count_dbx:=assigned(dbx_counter);
  1785. end;
  1786. end;
  1787. asmoutput:=asmlist;
  1788. foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab);
  1789. if cs_gdb_dbx in aktglobalswitches then
  1790. begin
  1791. if (current_module.globalsymtable<>@Self) then
  1792. begin
  1793. dbx_counter := prev_dbx_count;
  1794. do_count_dbx:=false;
  1795. asmList.concat(Tai_asm_comment.Create(strpnew('End unit '+name^
  1796. +' has index '+tostr(unitid))));
  1797. asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
  1798. +tostr(N_EINCL)+',0,0,0')));
  1799. do_count_dbx:=assigned(dbx_counter);
  1800. dbx_count_ok := {true}false;
  1801. end;
  1802. end;
  1803. is_stab_written:=true;
  1804. end;
  1805. {$endif}
  1806. {*****************************************************************************
  1807. Helper Routines
  1808. *****************************************************************************}
  1809. procedure numberunits;
  1810. var
  1811. counter : longint;
  1812. hp : tused_unit;
  1813. hp1 : tmodule;
  1814. begin
  1815. { Reset all numbers to -1 }
  1816. hp1:=tmodule(loaded_units.first);
  1817. while assigned(hp1) do
  1818. begin
  1819. if assigned(hp1.globalsymtable) then
  1820. psymtable(hp1.globalsymtable)^.unitid:=$ffff;
  1821. hp1:=tmodule(hp1.next);
  1822. end;
  1823. { Our own symtable gets unitid 0, for a program there is
  1824. no globalsymtable }
  1825. if assigned(current_module.globalsymtable) then
  1826. psymtable(current_module.globalsymtable)^.unitid:=0;
  1827. { number units }
  1828. counter:=1;
  1829. hp:=tused_unit(current_module.used_units.first);
  1830. while assigned(hp) do
  1831. begin
  1832. psymtable(hp.u.globalsymtable)^.unitid:=counter;
  1833. inc(counter);
  1834. hp:=tused_unit(hp.next);
  1835. end;
  1836. end;
  1837. function findunitsymtable(st:psymtable):psymtable;
  1838. begin
  1839. findunitsymtable:=nil;
  1840. repeat
  1841. if not assigned(st) then
  1842. internalerror(5566561);
  1843. case st^.symtabletype of
  1844. localsymtable,
  1845. parasymtable,
  1846. staticsymtable :
  1847. break;
  1848. globalsymtable,
  1849. unitsymtable :
  1850. begin
  1851. findunitsymtable:=st;
  1852. break;
  1853. end;
  1854. objectsymtable,
  1855. recordsymtable :
  1856. st:=st^.defowner^.owner;
  1857. else
  1858. internalerror(5566562);
  1859. end;
  1860. until false;
  1861. end;
  1862. procedure duplicatesym(sym:psym);
  1863. var
  1864. st : psymtable;
  1865. begin
  1866. Message1(sym_e_duplicate_id,sym^.realname);
  1867. st:=findunitsymtable(sym^.owner);
  1868. with sym^.fileinfo do
  1869. begin
  1870. if assigned(st) and (st^.unitid<>0) then
  1871. Message2(sym_h_duplicate_id_where,'unit '+st^.name^,tostr(line))
  1872. else
  1873. Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
  1874. end;
  1875. end;
  1876. procedure identifier_not_found(const s:string);
  1877. begin
  1878. Message1(sym_e_id_not_found,s);
  1879. { show a fatal that you need -S2 or -Sd, but only
  1880. if we just parsed the a token that has m_class }
  1881. if not(m_class in aktmodeswitches) and
  1882. (s=pattern) and
  1883. (tokeninfo^[idtoken].keyword=m_class) then
  1884. Message(parser_f_need_objfpc_or_delphi_mode);
  1885. end;
  1886. {*****************************************************************************
  1887. Search
  1888. *****************************************************************************}
  1889. procedure getsym(const s : stringid;notfounderror : boolean);
  1890. var
  1891. speedvalue : longint;
  1892. begin
  1893. speedvalue:=getspeedvalue(s);
  1894. lastsrsym:=nil;
  1895. srsymtable:=symtablestack;
  1896. while assigned(srsymtable) do
  1897. begin
  1898. srsym:=psym(srsymtable^.speedsearch(s,speedvalue));
  1899. if assigned(srsym) then
  1900. exit
  1901. else
  1902. srsymtable:=srsymtable^.next;
  1903. end;
  1904. if notfounderror then
  1905. begin
  1906. identifier_not_found(s);
  1907. srsym:=generrorsym;
  1908. end
  1909. else
  1910. srsym:=nil;
  1911. end;
  1912. procedure getsymonlyin(p : psymtable;const s : stringid);
  1913. begin
  1914. { the caller have to take care if srsym=nil (FK) }
  1915. srsym:=nil;
  1916. if assigned(p) then
  1917. begin
  1918. srsymtable:=p;
  1919. srsym:=psym(srsymtable^.search(s));
  1920. if assigned(srsym) then
  1921. exit
  1922. else
  1923. begin
  1924. if (punitsymtable(srsymtable)=punitsymtable(current_module.globalsymtable)) then
  1925. begin
  1926. getsymonlyin(psymtable(current_module.localsymtable),s);
  1927. if assigned(srsym) then
  1928. srsymtable:=psymtable(current_module.localsymtable)
  1929. else
  1930. identifier_not_found(s);
  1931. end
  1932. else
  1933. identifier_not_found(s);
  1934. end;
  1935. end;
  1936. end;
  1937. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  1938. {Search for a symbol in a specified symbol table. Returns nil if
  1939. the symtable is not found, and also if the symbol cannot be found
  1940. in the desired symtable }
  1941. var hsymtab:Psymtable;
  1942. res:Psym;
  1943. begin
  1944. res:=nil;
  1945. hsymtab:=symtablestack;
  1946. while (hsymtab<>nil) and (hsymtab^.symtabletype<>symtabletype) do
  1947. hsymtab:=hsymtab^.next;
  1948. if hsymtab<>nil then
  1949. {We found the desired symtable. Now check if the symbol we
  1950. search for is defined in it }
  1951. res:=psym(hsymtab^.search(symbol));
  1952. search_a_symtable:=res;
  1953. end;
  1954. {*****************************************************************************
  1955. Definition Helpers
  1956. *****************************************************************************}
  1957. function globaldef(const s : string) : pdef;
  1958. var st : string;
  1959. symt : psymtable;
  1960. begin
  1961. srsym := nil;
  1962. if pos('.',s) > 0 then
  1963. begin
  1964. st := copy(s,1,pos('.',s)-1);
  1965. getsym(st,false);
  1966. st := copy(s,pos('.',s)+1,255);
  1967. if assigned(srsym) then
  1968. begin
  1969. if srsym^.typ = unitsym then
  1970. begin
  1971. symt := punitsym(srsym)^.unitsymtable;
  1972. srsym := psym(symt^.search(st));
  1973. end else srsym := nil;
  1974. end;
  1975. end else st := s;
  1976. if srsym = nil then getsym(st,false);
  1977. if srsym = nil then
  1978. getsymonlyin(systemunit,st);
  1979. if srsym^.typ<>typesym then
  1980. begin
  1981. Message(type_e_type_id_expected);
  1982. exit;
  1983. end;
  1984. globaldef := pdef(ptypesym(srsym)^.restype.def);
  1985. end;
  1986. {****************************************************************************
  1987. Object Helpers
  1988. ****************************************************************************}
  1989. function search_class_member(pd : pobjectdef;const n : string) : psym;
  1990. { searches n in symtable of pd and all anchestors }
  1991. var
  1992. sym : psym;
  1993. begin
  1994. sym:=nil;
  1995. while assigned(pd) do
  1996. begin
  1997. sym:=psym(pd^.symtable^.search(n));
  1998. if assigned(sym) then
  1999. break;
  2000. pd:=pd^.childof;
  2001. end;
  2002. { this is needed for static methods in do_member_read pexpr unit PM
  2003. caused bug0214 }
  2004. if assigned(sym) then
  2005. begin
  2006. srsymtable:=pd^.symtable;
  2007. end;
  2008. search_class_member:=sym;
  2009. end;
  2010. var
  2011. _defaultprop : ppropertysym;
  2012. procedure testfordefaultproperty(p : pnamedindexobject);
  2013. begin
  2014. if (psym(p)^.typ=propertysym) and
  2015. (ppo_defaultproperty in ppropertysym(p)^.propoptions) then
  2016. _defaultprop:=ppropertysym(p);
  2017. end;
  2018. function search_default_property(pd : pobjectdef) : ppropertysym;
  2019. { returns the default property of a class, searches also anchestors }
  2020. begin
  2021. _defaultprop:=nil;
  2022. while assigned(pd) do
  2023. begin
  2024. pd^.symtable^.foreach({$ifdef FPCPROCVAR}@{$endif}testfordefaultproperty);
  2025. if assigned(_defaultprop) then
  2026. break;
  2027. pd:=pd^.childof;
  2028. end;
  2029. search_default_property:=_defaultprop;
  2030. end;
  2031. {$ifdef UNITALIASES}
  2032. {****************************************************************************
  2033. TUNIT_ALIAS
  2034. ****************************************************************************}
  2035. constructor tunit_alias.init(const n:string);
  2036. var
  2037. i : longint;
  2038. begin
  2039. i:=pos('=',n);
  2040. if i=0 then
  2041. fail;
  2042. inherited initname(Copy(n,1,i-1));
  2043. newname:=stringdup(Copy(n,i+1,255));
  2044. end;
  2045. destructor tunit_alias.done;
  2046. begin
  2047. stringdispose(newname);
  2048. inherited done;
  2049. end;
  2050. procedure addunitalias(const n:string);
  2051. begin
  2052. unitaliases^.insert(new(punit_alias,init(Upper(n))));
  2053. end;
  2054. function getunitalias(const n:string):string;
  2055. var
  2056. p : punit_alias;
  2057. begin
  2058. p:=punit_alias(unitaliases^.search(Upper(n)));
  2059. if assigned(p) then
  2060. getunitalias:=punit_alias(p)^.newname^
  2061. else
  2062. getunitalias:=n;
  2063. end;
  2064. {$endif UNITALIASES}
  2065. {****************************************************************************
  2066. Symtable Stack
  2067. ****************************************************************************}
  2068. procedure dellexlevel;
  2069. var
  2070. p : psymtable;
  2071. begin
  2072. p:=symtablestack;
  2073. symtablestack:=p^.next;
  2074. { symbol tables of unit interfaces are never disposed }
  2075. { this is handle by the unit unitm }
  2076. if not(p^.symtabletype in [unitsymtable,globalsymtable,stt_exceptsymtable]) then
  2077. dispose(p,done);
  2078. end;
  2079. procedure RestoreUnitSyms;
  2080. var
  2081. p : psymtable;
  2082. begin
  2083. p:=symtablestack;
  2084. while assigned(p) do
  2085. begin
  2086. if (p^.symtabletype=unitsymtable) and
  2087. assigned(punitsymtable(p)^.unitsym) and
  2088. ((punitsymtable(p)^.unitsym^.owner=psymtable(current_module.globalsymtable)) or
  2089. (punitsymtable(p)^.unitsym^.owner=psymtable(current_module.localsymtable))) then
  2090. punitsymtable(p)^.unitsym^.restoreunitsym;
  2091. p:=p^.next;
  2092. end;
  2093. end;
  2094. {$ifdef DEBUG}
  2095. procedure test_symtablestack;
  2096. var
  2097. p : psymtable;
  2098. i : longint;
  2099. begin
  2100. p:=symtablestack;
  2101. i:=0;
  2102. while assigned(p) do
  2103. begin
  2104. inc(i);
  2105. p:=p^.next;
  2106. if i>500 then
  2107. Message(sym_f_internal_error_in_symtablestack);
  2108. end;
  2109. end;
  2110. procedure list_symtablestack;
  2111. var
  2112. p : psymtable;
  2113. i : longint;
  2114. begin
  2115. p:=symtablestack;
  2116. i:=0;
  2117. while assigned(p) do
  2118. begin
  2119. inc(i);
  2120. writeln(i,' ',p^.name^);
  2121. p:=p^.next;
  2122. if i>500 then
  2123. Message(sym_f_internal_error_in_symtablestack);
  2124. end;
  2125. end;
  2126. {$endif DEBUG}
  2127. {****************************************************************************
  2128. Init/Done Symtable
  2129. ****************************************************************************}
  2130. procedure InitSymtable;
  2131. var
  2132. token : ttoken;
  2133. begin
  2134. { Reset symbolstack }
  2135. registerdef:=false;
  2136. read_member:=false;
  2137. symtablestack:=nil;
  2138. systemunit:=nil;
  2139. {$ifdef GDB}
  2140. firstglobaldef:=nil;
  2141. lastglobaldef:=nil;
  2142. globaltypecount:=1;
  2143. pglobaltypecount:=@globaltypecount;
  2144. {$endif GDB}
  2145. { create error syms and def }
  2146. generrorsym:=new(perrorsym,init);
  2147. generrordef:=new(perrordef,init);
  2148. {$ifdef UNITALIASES}
  2149. { unit aliases }
  2150. unitaliases:=new(pdictionary,init);
  2151. {$endif}
  2152. for token:=first_overloaded to last_overloaded do
  2153. overloaded_operators[token]:=nil;
  2154. end;
  2155. procedure DoneSymtable;
  2156. begin
  2157. dispose(generrorsym,done);
  2158. dispose(generrordef,done);
  2159. {$ifdef UNITALIASES}
  2160. dispose(unitaliases,done);
  2161. {$endif}
  2162. {$ifdef MEMDEBUG}
  2163. writeln('Manglednames: ',manglenamesize,' bytes');
  2164. {$endif}
  2165. end;
  2166. end.
  2167. {
  2168. $Log$
  2169. Revision 1.26 2001-02-21 19:37:19 peter
  2170. * moved deref to be done after loading of implementation units. prederef
  2171. is still done directly after loading of symbols and definitions.
  2172. Revision 1.25 2001/02/20 21:41:16 peter
  2173. * new fixfilename, findfile for unix. Look first for lowercase, then
  2174. NormalCase and last for UPPERCASE names.
  2175. Revision 1.24 2001/01/08 21:40:27 peter
  2176. * fixed crash with unsupported token overloading
  2177. Revision 1.23 2000/12/25 00:07:30 peter
  2178. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  2179. tlinkedlist objects)
  2180. Revision 1.22 2000/12/23 19:50:09 peter
  2181. * fixed mem leak with withsymtable
  2182. Revision 1.21 2000/12/10 20:25:32 peter
  2183. * fixed missing typecast
  2184. Revision 1.20 2000/12/10 14:14:51 florian
  2185. * fixed web bug 1203: class fields can be now redefined
  2186. in Delphi mode though I don't like this :/
  2187. Revision 1.19 2000/11/30 22:16:49 florian
  2188. * moved to i386
  2189. Revision 1.18 2000/11/29 00:30:42 florian
  2190. * unused units removed from uses clause
  2191. * some changes for widestrings
  2192. Revision 1.17 2000/11/28 00:28:07 pierre
  2193. * stabs fixing
  2194. Revision 1.1.2.8 2000/11/17 11:14:37 pierre
  2195. * one more class stabs fix
  2196. Revision 1.16 2000/11/12 22:17:47 peter
  2197. * some realname updates for messages
  2198. Revision 1.15 2000/11/06 15:54:15 florian
  2199. * fixed two bugs to get make cycle work, but it's not enough
  2200. Revision 1.14 2000/11/04 14:25:22 florian
  2201. + merged Attila's changes for interfaces, not tested yet
  2202. Revision 1.13 2000/11/01 23:04:38 peter
  2203. * tprocdef.fullprocname added for better casesensitve writing of
  2204. procedures
  2205. Revision 1.12 2000/10/31 22:02:52 peter
  2206. * symtable splitted, no real code changes
  2207. Revision 1.1.2.7 2000/10/16 19:43:04 pierre
  2208. * trying to correct class stabss once more
  2209. Revision 1.11 2000/10/15 07:47:53 peter
  2210. * unit names and procedure names are stored mixed case
  2211. Revision 1.10 2000/10/14 10:14:53 peter
  2212. * moehrendorf oct 2000 rewrite
  2213. Revision 1.9 2000/10/01 19:48:25 peter
  2214. * lot of compile updates for cg11
  2215. Revision 1.8 2000/09/24 15:06:29 peter
  2216. * use defines.inc
  2217. Revision 1.7 2000/08/27 16:11:54 peter
  2218. * moved some util functions from globals,cobjects to cutils
  2219. * splitted files into finput,fmodule
  2220. Revision 1.6 2000/08/21 11:27:45 pierre
  2221. * fix the stabs problems
  2222. Revision 1.5 2000/08/20 14:58:41 peter
  2223. * give fatal if objfpc/delphi mode things are found (merged)
  2224. Revision 1.1.2.6 2000/08/20 14:56:46 peter
  2225. * give fatal if objfpc/delphi mode things are found
  2226. Revision 1.4 2000/08/16 18:33:54 peter
  2227. * splitted namedobjectitem.next into indexnext and listnext so it
  2228. can be used in both lists
  2229. * don't allow "word = word" type definitions (merged)
  2230. Revision 1.3 2000/08/08 19:28:57 peter
  2231. * memdebug/memory patches (merged)
  2232. * only once illegal directive (merged)
  2233. }