symtable.pas 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 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. {$ifdef TP}
  19. {$N+,E+,F+}
  20. {$endif}
  21. unit symtable;
  22. interface
  23. uses
  24. {$ifdef TP}
  25. {$ifndef Delphi}
  26. objects,
  27. {$endif Delphi}
  28. {$endif}
  29. strings,cobjects,
  30. globtype,globals,tokens,systems,verbose,
  31. symconst,
  32. aasm
  33. ,cpubase
  34. ,cpuinfo
  35. {$ifdef GDB}
  36. ,gdb
  37. {$endif}
  38. ;
  39. {************************************************
  40. Some internal constants
  41. ************************************************}
  42. const
  43. hasharraysize = 256;
  44. {$ifdef TP}
  45. indexgrowsize = 16;
  46. {$else}
  47. indexgrowsize = 64;
  48. {$endif}
  49. {************************************************
  50. Needed forward pointers
  51. ************************************************}
  52. type
  53. { needed for owner (table) of symbol }
  54. psymtable = ^tsymtable;
  55. punitsymtable = ^tunitsymtable;
  56. { needed for names by the definitions }
  57. ptypesym = ^ttypesym;
  58. penumsym = ^tenumsym;
  59. pprocsym = ^tprocsym;
  60. pref = ^tref;
  61. tref = object
  62. nextref : pref;
  63. posinfo : tfileposinfo;
  64. moduleindex : word;
  65. is_written : boolean;
  66. constructor init(ref:pref;pos:pfileposinfo);
  67. destructor done; virtual;
  68. end;
  69. { Deref entry options }
  70. tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,
  71. derefunit,derefrecord,derefindex,
  72. dereflocal,derefpara,derefaktlocal);
  73. pderef = ^tderef;
  74. tderef = object
  75. dereftype : tdereftype;
  76. index : word;
  77. next : pderef;
  78. constructor init(typ:tdereftype;i:word);
  79. destructor done;
  80. end;
  81. psymtableentry = ^tsymtableentry;
  82. tsymtableentry = object(tnamedindexobject)
  83. owner : psymtable;
  84. end;
  85. {************************************************
  86. TDef
  87. ************************************************}
  88. {$i symdefh.inc}
  89. {************************************************
  90. TSym
  91. ************************************************}
  92. {$i symsymh.inc}
  93. {************************************************
  94. TSymtable
  95. ************************************************}
  96. tsymtabletype = (invalidsymtable,withsymtable,staticsymtable,
  97. globalsymtable,unitsymtable,
  98. objectsymtable,recordsymtable,
  99. macrosymtable,localsymtable,
  100. parasymtable,inlineparasymtable,
  101. inlinelocalsymtable,stt_exceptsymtable,
  102. { only used for PPU reading of static part
  103. of a unit }
  104. staticppusymtable);
  105. tcallback = procedure(p : psym);
  106. tsearchhasharray = array[0..hasharraysize-1] of psym;
  107. psearchhasharray = ^tsearchhasharray;
  108. tsymtable = object
  109. symtabletype : tsymtabletype;
  110. { each symtable gets a number }
  111. unitid : word{integer give range check errors PM};
  112. name : pstring;
  113. datasize : longint;
  114. dataalignment : longint;
  115. symindex,
  116. defindex : pindexarray;
  117. symsearch : pdictionary;
  118. next : psymtable;
  119. defowner : pdef; { for records and objects }
  120. { alignment used in this symtable }
  121. alignment : longint;
  122. { only used for parameter symtable to determine the offset relative }
  123. { to the frame pointer and for local inline }
  124. address_fixup : longint;
  125. { this saves all definition to allow a proper clean up }
  126. { separate lexlevel from symtable type }
  127. symtablelevel : byte;
  128. constructor init(t : tsymtabletype);
  129. destructor done;virtual;
  130. { access }
  131. function getdefnr(l : longint) : pdef;
  132. function getsymnr(l : longint) : psym;
  133. { load/write }
  134. constructor load;
  135. procedure write;
  136. constructor loadas(typ : tsymtabletype);
  137. procedure writeas;
  138. procedure loaddefs;
  139. procedure loadsyms;
  140. procedure writedefs;
  141. procedure writesyms;
  142. procedure deref;
  143. procedure clear;
  144. function rename(const olds,news : stringid):psym;
  145. procedure foreach(proc2call : tnamedindexcallback);
  146. function insert(sym : psym):psym;
  147. function search(const s : stringid) : psym;
  148. function speedsearch(const s : stringid;speedvalue : longint) : psym;
  149. procedure registerdef(p : pdef);
  150. procedure allsymbolsused;
  151. procedure allunitsused;
  152. procedure check_forwards;
  153. procedure checklabels;
  154. { change alignment for args only parasymtable }
  155. procedure set_alignment(_alignment : byte);
  156. { find arg having offset only parasymtable }
  157. function find_at_offset(l : longint) : pvarsym;
  158. {$ifdef CHAINPROCSYMS}
  159. procedure chainprocsyms;
  160. {$endif CHAINPROCSYMS}
  161. procedure load_browser;
  162. procedure write_browser;
  163. {$ifdef BrowserLog}
  164. procedure writebrowserlog;
  165. {$endif BrowserLog}
  166. {$ifdef GDB}
  167. procedure concatstabto(asmlist : paasmoutput);virtual;
  168. {$endif GDB}
  169. function getnewtypecount : word; virtual;
  170. end;
  171. tunitsymtable = object(tsymtable)
  172. unittypecount : word;
  173. unitsym : punitsym;
  174. {$ifdef GDB}
  175. dbx_count : longint;
  176. prev_dbx_counter : plongint;
  177. dbx_count_ok : boolean;
  178. is_stab_written : boolean;
  179. {$endif GDB}
  180. constructor init(t : tsymtabletype;const n : string);
  181. constructor loadasunit;
  182. destructor done;virtual;
  183. procedure writeasunit;
  184. {$ifdef GDB}
  185. procedure concattypestabto(asmlist : paasmoutput);
  186. {$endif GDB}
  187. procedure load_symtable_refs;
  188. function getnewtypecount : word; virtual;
  189. end;
  190. pwithsymtable = ^twithsymtable;
  191. twithsymtable = object(tsymtable)
  192. { used for withsymtable for allowing constructors }
  193. direct_with : boolean;
  194. { in fact it is a ptree }
  195. withnode : pointer;
  196. { ptree to load of direct with var }
  197. { already usable before firstwith
  198. needed for firstpass of function parameters PM }
  199. withrefnode : pointer;
  200. constructor init;
  201. destructor done;virtual;
  202. end;
  203. {****************************************************************************
  204. Var / Consts
  205. ****************************************************************************}
  206. const
  207. systemunit : punitsymtable = nil; { pointer to the system unit }
  208. current_object_option : tsymoptions = [sp_public];
  209. var
  210. { for STAB debugging }
  211. globaltypecount : word;
  212. pglobaltypecount : pword;
  213. registerdef : boolean; { true, when defs should be registered }
  214. defaultsymtablestack, { symtablestack after default units
  215. have been loaded }
  216. symtablestack : psymtable; { linked list of symtables }
  217. srsym : psym; { result of the last search }
  218. srsymtable : psymtable;
  219. lastsrsym : psym; { last sym found in statement }
  220. lastsrsymtable : psymtable;
  221. lastsymknown : boolean;
  222. constsymtable : psymtable; { symtable were the constants can be
  223. inserted }
  224. voidpointerdef : ppointerdef; { pointer for Void-Pointerdef }
  225. charpointerdef : ppointerdef; { pointer for Char-Pointerdef }
  226. voidfarpointerdef : ppointerdef;
  227. cformaldef : pformaldef; { unique formal definition }
  228. voiddef : porddef; { Pointer to Void (procedure) }
  229. cchardef : porddef; { Pointer to Char }
  230. booldef : porddef; { pointer to boolean type }
  231. u8bitdef : porddef; { Pointer to 8-Bit unsigned }
  232. u16bitdef : porddef; { Pointer to 16-Bit unsigned }
  233. u32bitdef : porddef; { Pointer to 32-Bit unsigned }
  234. s32bitdef : porddef; { Pointer to 32-Bit signed }
  235. cu64bitdef : porddef; { pointer to 64 bit unsigned def }
  236. cs64bitdef : porddef; { pointer to 64 bit signed def, }
  237. { calculated by the int unit on i386 }
  238. s32floatdef : pfloatdef; { pointer for realconstn }
  239. s64floatdef : pfloatdef; { pointer for realconstn }
  240. s80floatdef : pfloatdef; { pointer to type of temp. floats }
  241. s32fixeddef : pfloatdef; { pointer to type of temp. fixed }
  242. cshortstringdef : pstringdef; { pointer to type of short string const }
  243. clongstringdef : pstringdef; { pointer to type of long string const }
  244. cansistringdef : pstringdef; { pointer to type of ansi string const }
  245. cwidestringdef : pstringdef; { pointer to type of wide string const }
  246. openshortstringdef : pstringdef; { pointer to type of an open shortstring,
  247. needed for readln() }
  248. openchararraydef : parraydef; { pointer to type of an open array of char,
  249. needed for readln() }
  250. cfiledef : pfiledef; { get the same definition for all file }
  251. { uses for stabs }
  252. firstglobaldef, { linked list of all globals defs }
  253. lastglobaldef : pdef; { used to reset stabs/ranges }
  254. class_tobject : pobjectdef; { pointer to the anchestor of all }
  255. { clases }
  256. pvmtdef : ppointerdef; { type of classrefs }
  257. aktprocsym : pprocsym; { pointer to the symbol for the
  258. currently be parsed procedure }
  259. aktcallprocsym : pprocsym; { pointer to the symbol for the
  260. currently be called procedure,
  261. only set/unset in firstcall }
  262. aktvarsym : pvarsym; { pointer to the symbol for the
  263. currently read var, only used
  264. for variable directives }
  265. procprefix : string; { eindeutige Namen bei geschachtel- }
  266. { ten Unterprogrammen erzeugen }
  267. lexlevel : longint; { level of code }
  268. { 1 for main procedure }
  269. { 2 for normal function or proc }
  270. { higher for locals }
  271. const
  272. main_program_level = 1;
  273. unit_init_level = 1;
  274. normal_function_level = 2;
  275. in_loading : boolean = false;
  276. {$ifdef i386}
  277. bestrealdef : ^pfloatdef = @s80floatdef;
  278. {$endif}
  279. {$ifdef m68k}
  280. bestrealdef : ^pfloatdef = @s64floatdef;
  281. {$endif}
  282. {$ifdef alpha}
  283. bestrealdef : ^pfloatdef = @s64floatdef;
  284. {$endif}
  285. {$ifdef powerpc}
  286. bestrealdef : ^pfloatdef = @s64floatdef;
  287. {$endif}
  288. var
  289. macros : psymtable; { pointer for die Symboltabelle mit }
  290. { Makros }
  291. read_member : boolean; { true, wenn Members aus einer PPU- }
  292. { Datei gelesen werden, d.h. ein }
  293. { varsym seine Adresse einlesen soll }
  294. generrorsym : psym; { Jokersymbol, wenn das richtige }
  295. { Symbol nicht gefunden wird }
  296. generrordef : pdef; { Jokersymbol for eine fehlerhafte }
  297. { Typdefinition }
  298. aktobjectdef : pobjectdef; { used for private functions check !! }
  299. const
  300. { last operator which can be overloaded }
  301. first_overloaded = _PLUS;
  302. last_overloaded = _ASSIGNMENT;
  303. var
  304. overloaded_operators : array[first_overloaded..last_overloaded] of pprocsym;
  305. { unequal is not equal}
  306. const
  307. overloaded_names : array [first_overloaded..last_overloaded] of string[16] =
  308. ('plus','minus','star','slash','equal',
  309. 'greater','lower','greater_or_equal',
  310. 'lower_or_equal',
  311. 'sym_diff','starstar',
  312. 'as','is','in','or',
  313. 'and','div','mod','shl','shr','xor',
  314. 'assign');
  315. {$ifdef UNITALIASES}
  316. type
  317. punit_alias = ^tunit_alias;
  318. tunit_alias = object(tnamedindexobject)
  319. newname : pstring;
  320. constructor init(const n:string);
  321. destructor done;virtual;
  322. end;
  323. var
  324. unitaliases : pdictionary;
  325. procedure addunitalias(const n:string);
  326. function getunitalias(const n:string):string;
  327. {$endif UNITALIASES}
  328. {****************************************************************************
  329. Functions
  330. ****************************************************************************}
  331. {*** Misc ***}
  332. function globaldef(const s : string) : pdef;
  333. function findunitsymtable(st:psymtable):psymtable;
  334. procedure duplicatesym(sym:psym);
  335. {*** Search ***}
  336. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  337. procedure getsym(const s : stringid;notfounderror : boolean);
  338. procedure getsymonlyin(p : psymtable;const s : stringid);
  339. {*** PPU Write/Loading ***}
  340. procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
  341. procedure closecurrentppu;
  342. procedure numberunits;
  343. procedure load_interface;
  344. {*** GDB ***}
  345. {$ifdef GDB}
  346. function typeglobalnumber(const s : string) : string;
  347. {$endif}
  348. {*** Definition ***}
  349. procedure reset_global_defs;
  350. {*** Object Helpers ***}
  351. function search_class_member(pd : pobjectdef;const n : string) : psym;
  352. function search_default_property(pd : pobjectdef) : ppropertysym;
  353. {*** Macro ***}
  354. procedure def_macro(const s : string);
  355. procedure set_macro(const s : string;value : string);
  356. {*** symtable stack ***}
  357. procedure dellexlevel;
  358. {$ifdef DEBUG}
  359. procedure test_symtablestack;
  360. procedure list_symtablestack;
  361. {$endif DEBUG}
  362. {*** Init / Done ***}
  363. procedure InitSymtable;
  364. procedure DoneSymtable;
  365. implementation
  366. uses
  367. version,
  368. types,ppu,
  369. gendef,files
  370. ,tree
  371. ,cresstr
  372. {$ifdef newcg}
  373. ,cgbase
  374. {$else}
  375. ,hcodegen
  376. {$endif}
  377. {$ifdef BrowserLog}
  378. ,browlog
  379. {$endif BrowserLog}
  380. {$ifdef alignreg}
  381. ,cpuasm
  382. {$endif alignreg}
  383. ;
  384. var
  385. aktrecordsymtable : psymtable; { current record read from ppu symtable }
  386. aktstaticsymtable : psymtable; { current static for local ppu symtable }
  387. aktlocalsymtable : psymtable; { current proc local for local ppu symtable }
  388. {$ifdef GDB}
  389. asmoutput : paasmoutput;
  390. {$endif GDB}
  391. {$ifdef TP}
  392. {$ifndef Delphi}
  393. {$ifndef dpmi}
  394. symbolstream : temsstream; { stream which is used to store some info }
  395. {$else}
  396. symbolstream : tmemorystream;
  397. {$endif}
  398. {$endif Delphi}
  399. {$endif}
  400. {to dispose the global symtable of a unit }
  401. const
  402. dispose_global : boolean = false;
  403. memsizeinc = 2048; { for long stabstrings }
  404. tagtypes : Set of tdeftype =
  405. [recorddef,enumdef,
  406. {$IfNDef GDBKnowsStrings}
  407. stringdef,
  408. {$EndIf not GDBKnowsStrings}
  409. {$IfNDef GDBKnowsFiles}
  410. filedef,
  411. {$EndIf not GDBKnowsFiles}
  412. objectdef];
  413. {*****************************************************************************
  414. Helper Routines
  415. *****************************************************************************}
  416. {$ifdef unused}
  417. function demangledparas(s : string) : string;
  418. var
  419. r : string;
  420. l : longint;
  421. begin
  422. demangledparas:='';
  423. r:=',';
  424. { delete leading $$'s }
  425. l:=pos('$$',s);
  426. while l<>0 do
  427. begin
  428. delete(s,1,l+1);
  429. l:=pos('$$',s);
  430. end;
  431. { delete leading _$'s }
  432. l:=pos('_$',s);
  433. while l<>0 do
  434. begin
  435. delete(s,1,l+1);
  436. l:=pos('_$',s);
  437. end;
  438. l:=pos('$',s);
  439. if l=0 then
  440. exit;
  441. delete(s,1,l);
  442. while s<>'' do
  443. begin
  444. l:=pos('$',s);
  445. if l=0 then
  446. l:=length(s)+1;
  447. r:=r+copy(s,1,l-1)+',';
  448. delete(s,1,l);
  449. end;
  450. delete(r,1,1);
  451. delete(r,length(r),1);
  452. demangledparas:=r;
  453. end;
  454. {$endif}
  455. procedure numberunits;
  456. var
  457. counter : longint;
  458. hp : pused_unit;
  459. hp1 : pmodule;
  460. begin
  461. { Reset all numbers to -1 }
  462. hp1:=pmodule(loaded_units.first);
  463. while assigned(hp1) do
  464. begin
  465. if assigned(hp1^.globalsymtable) then
  466. psymtable(hp1^.globalsymtable)^.unitid:=$ffff;
  467. hp1:=pmodule(hp1^.next);
  468. end;
  469. { Our own symtable gets unitid 0, for a program there is
  470. no globalsymtable }
  471. if assigned(current_module^.globalsymtable) then
  472. psymtable(current_module^.globalsymtable)^.unitid:=0;
  473. { number units }
  474. counter:=1;
  475. hp:=pused_unit(current_module^.used_units.first);
  476. while assigned(hp) do
  477. begin
  478. psymtable(hp^.u^.globalsymtable)^.unitid:=counter;
  479. inc(counter);
  480. hp:=pused_unit(hp^.next);
  481. end;
  482. end;
  483. function findunitsymtable(st:psymtable):psymtable;
  484. begin
  485. findunitsymtable:=nil;
  486. repeat
  487. if not assigned(st) then
  488. internalerror(5566561);
  489. case st^.symtabletype of
  490. localsymtable,
  491. parasymtable,
  492. staticsymtable :
  493. break;
  494. globalsymtable,
  495. unitsymtable :
  496. begin
  497. findunitsymtable:=st;
  498. break;
  499. end;
  500. objectsymtable,
  501. recordsymtable :
  502. st:=st^.defowner^.owner;
  503. else
  504. internalerror(5566562);
  505. end;
  506. until false;
  507. end;
  508. procedure setstring(var p : pchar;const s : string);
  509. begin
  510. {$ifndef Delphi}
  511. {$ifdef TP}
  512. if use_big then
  513. begin
  514. p:=pchar(symbolstream.getsize);
  515. symbolstream.seek(longint(p));
  516. symbolstream.writestr(@s);
  517. end
  518. else
  519. {$endif TP}
  520. {$endif Delphi}
  521. p:=strpnew(s);
  522. end;
  523. procedure duplicatesym(sym:psym);
  524. var
  525. st : psymtable;
  526. begin
  527. Message1(sym_e_duplicate_id,sym^.name);
  528. st:=findunitsymtable(sym^.owner);
  529. if assigned(st) then
  530. begin
  531. with sym^.fileinfo do
  532. begin
  533. if st^.unitid=0 then
  534. Message2(sym_h_duplicate_id_where,current_module^.sourcefiles^.get_file_name(fileindex),tostr(line))
  535. else
  536. Message2(sym_h_duplicate_id_where,'unit '+st^.name^,tostr(line));
  537. end;
  538. end;
  539. end;
  540. {****************************************************************************
  541. TRef
  542. ****************************************************************************}
  543. constructor tref.init(ref :pref;pos : pfileposinfo);
  544. begin
  545. nextref:=nil;
  546. if pos<>nil then
  547. posinfo:=pos^;
  548. if assigned(current_module) then
  549. moduleindex:=current_module^.unit_index;
  550. if assigned(ref) then
  551. ref^.nextref:=@self;
  552. is_written:=false;
  553. end;
  554. destructor tref.done;
  555. var
  556. inputfile : pinputfile;
  557. begin
  558. inputfile:=get_source_file(moduleindex,posinfo.fileindex);
  559. if inputfile<>nil then
  560. dec(inputfile^.ref_count);
  561. if assigned(nextref) then
  562. dispose(nextref,done);
  563. nextref:=nil;
  564. end;
  565. {****************************************************************************
  566. TDeref
  567. ****************************************************************************}
  568. constructor tderef.init(typ:tdereftype;i:word);
  569. begin
  570. dereftype:=typ;
  571. index:=i;
  572. next:=nil;
  573. end;
  574. destructor tderef.done;
  575. begin
  576. end;
  577. {*****************************************************************************
  578. PPU Reading Writing
  579. *****************************************************************************}
  580. {$I symppu.inc}
  581. {*****************************************************************************
  582. Definition Helpers
  583. *****************************************************************************}
  584. function globaldef(const s : string) : pdef;
  585. var st : string;
  586. symt : psymtable;
  587. begin
  588. srsym := nil;
  589. if pos('.',s) > 0 then
  590. begin
  591. st := copy(s,1,pos('.',s)-1);
  592. getsym(st,false);
  593. st := copy(s,pos('.',s)+1,255);
  594. if assigned(srsym) then
  595. begin
  596. if srsym^.typ = unitsym then
  597. begin
  598. symt := punitsym(srsym)^.unitsymtable;
  599. srsym := symt^.search(st);
  600. end else srsym := nil;
  601. end;
  602. end else st := s;
  603. if srsym = nil then getsym(st,false);
  604. if srsym = nil then
  605. getsymonlyin(systemunit,st);
  606. if srsym^.typ<>typesym then
  607. begin
  608. Message(type_e_type_id_expected);
  609. exit;
  610. end;
  611. globaldef := ptypesym(srsym)^.definition;
  612. end;
  613. {*****************************************************************************
  614. Symbol / Definition Resolving
  615. *****************************************************************************}
  616. procedure resolvederef(var p:pderef;var st:psymtable;var idx:word);
  617. var
  618. hp : pderef;
  619. pd : pdef;
  620. begin
  621. st:=nil;
  622. idx:=0;
  623. while assigned(p) do
  624. begin
  625. case p^.dereftype of
  626. derefaktrecordindex :
  627. begin
  628. st:=aktrecordsymtable;
  629. idx:=p^.index;
  630. end;
  631. derefaktstaticindex :
  632. begin
  633. st:=aktstaticsymtable;
  634. idx:=p^.index;
  635. end;
  636. derefaktlocal :
  637. begin
  638. st:=aktlocalsymtable;
  639. idx:=p^.index;
  640. end;
  641. derefunit :
  642. begin
  643. {$ifdef NEWMAP}
  644. st:=psymtable(current_module^.map^[p^.index]^.globalsymtable);
  645. {$else NEWMAP}
  646. st:=psymtable(current_module^.map^[p^.index]);
  647. {$endif NEWMAP}
  648. end;
  649. derefrecord :
  650. begin
  651. pd:=st^.getdefnr(p^.index);
  652. case pd^.deftype of
  653. recorddef :
  654. st:=precorddef(pd)^.symtable;
  655. objectdef :
  656. st:=pobjectdef(pd)^.symtable;
  657. else
  658. internalerror(556658);
  659. end;
  660. end;
  661. dereflocal :
  662. begin
  663. pd:=st^.getdefnr(p^.index);
  664. case pd^.deftype of
  665. procdef :
  666. st:=pprocdef(pd)^.localst;
  667. else
  668. internalerror(556658);
  669. end;
  670. end;
  671. derefpara :
  672. begin
  673. pd:=st^.getdefnr(p^.index);
  674. case pd^.deftype of
  675. procdef :
  676. st:=pprocdef(pd)^.parast;
  677. else
  678. internalerror(556658);
  679. end;
  680. end;
  681. derefindex :
  682. begin
  683. idx:=p^.index;
  684. end;
  685. else
  686. internalerror(556658);
  687. end;
  688. hp:=p;
  689. p:=p^.next;
  690. dispose(hp,done);
  691. end;
  692. end;
  693. procedure resolvedef(var def:pdef);
  694. var
  695. st : psymtable;
  696. idx : word;
  697. begin
  698. resolvederef(pderef(def),st,idx);
  699. if assigned(st) then
  700. def:=st^.getdefnr(idx)
  701. else
  702. def:=nil;
  703. end;
  704. procedure resolvesym(var sym:psym);
  705. var
  706. st : psymtable;
  707. idx : word;
  708. begin
  709. resolvederef(pderef(sym),st,idx);
  710. if assigned(st) then
  711. sym:=st^.getsymnr(idx)
  712. else
  713. sym:=nil;
  714. end;
  715. {*****************************************************************************
  716. Symbol Call Back Functions
  717. *****************************************************************************}
  718. procedure derefsym(p : pnamedindexobject);
  719. begin
  720. psym(p)^.deref;
  721. end;
  722. procedure derefsymsdelayed(p : pnamedindexobject);
  723. begin
  724. if psym(p)^.typ in [absolutesym,propertysym] then
  725. psym(p)^.deref;
  726. end;
  727. procedure check_forward(sym : pnamedindexobject);
  728. begin
  729. if psym(sym)^.typ=procsym then
  730. pprocsym(sym)^.check_forward
  731. { check also object method table }
  732. { we needn't to test the def list }
  733. { because each object has to have a type sym }
  734. else
  735. if (psym(sym)^.typ=typesym) and
  736. assigned(ptypesym(sym)^.definition) and
  737. (ptypesym(sym)^.definition^.deftype=objectdef) then
  738. pobjectdef(ptypesym(sym)^.definition)^.check_forwards;
  739. end;
  740. procedure labeldefined(p : pnamedindexobject);
  741. begin
  742. if (psym(p)^.typ=labelsym) and
  743. not(plabelsym(p)^.defined) then
  744. begin
  745. if plabelsym(p)^.used then
  746. Message1(sym_e_label_used_and_not_defined,p^.name)
  747. else
  748. Message1(sym_w_label_not_defined,p^.name);
  749. end;
  750. end;
  751. procedure unitsymbolused(p : pnamedindexobject);
  752. begin
  753. if (psym(p)^.typ=unitsym) and
  754. (punitsym(p)^.refs=0) then
  755. comment(V_info,'Unit '+p^.name+' is not used');
  756. end;
  757. procedure varsymbolused(p : pnamedindexobject);
  758. begin
  759. if (psym(p)^.typ=varsym) and
  760. ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
  761. begin
  762. { unused symbol should be reported only if no }
  763. { error is reported }
  764. { if the symbol is in a register it is used }
  765. { also don't count the value parameters which have local copies }
  766. { also don't claim for high param of open parameters (PM) }
  767. if (Errorcount<>0) then
  768. exit;
  769. if (pvarsym(p)^.refs=0) and
  770. (copy(p^.name,1,3)<>'val') and
  771. (copy(p^.name,1,4)<>'high') then
  772. begin
  773. if (psym(p)^.owner^.symtabletype=parasymtable) or pvarsym(p)^.islocalcopy then
  774. begin
  775. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_not_used,p^.name);
  776. end
  777. else
  778. MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_not_used,p^.name);
  779. end
  780. else if pvarsym(p)^.varstate=vs_assigned then
  781. begin
  782. if (psym(p)^.owner^.symtabletype=parasymtable) then
  783. begin
  784. if (pvarsym(p)^.varspez<>vs_var) then
  785. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,p^.name)
  786. end
  787. else if pvarsym(p)^.islocalcopy then
  788. begin
  789. if (pvarsym(p)^.varspez<>vs_var) then
  790. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,p^.name);
  791. end
  792. else if (psym(p)^.owner^.symtabletype<>parasymtable) then
  793. MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_only_set,p^.name);
  794. end;
  795. end
  796. else if ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
  797. begin
  798. if (Errorcount<>0) then
  799. exit;
  800. { units references are problematic }
  801. if (psym(p)^.refs=0) and not(psym(p)^.typ in [funcretsym,enumsym,unitsym]) then
  802. MessagePos2(psym(p)^.fileinfo,sym_h_local_symbol_not_used,SymTypeName[psym(p)^.typ],p^.name);
  803. end;
  804. end;
  805. {$ifdef GDB}
  806. procedure concatstab(p : pnamedindexobject);
  807. begin
  808. if psym(p)^.typ <> procsym then
  809. psym(p)^.concatstabto(asmoutput);
  810. end;
  811. procedure concattypestab(p : pnamedindexobject);
  812. begin
  813. if psym(p)^.typ = typesym then
  814. begin
  815. psym(p)^.isstabwritten:=false;
  816. psym(p)^.concatstabto(asmoutput);
  817. end;
  818. end;
  819. procedure forcestabto(asmlist : paasmoutput; pd : pdef);
  820. begin
  821. if not pd^.is_def_stab_written then
  822. begin
  823. if assigned(pd^.sym) then
  824. pd^.sym^.isusedinstab := true;
  825. pd^.concatstabto(asmlist);
  826. end;
  827. end;
  828. {$endif}
  829. {$ifdef CHAINPROCSYMS}
  830. procedure chainprocsym(p : psym);
  831. var
  832. storesymtablestack : psymtable;
  833. begin
  834. if p^.typ=procsym then
  835. begin
  836. storesymtablestack:=symtablestack;
  837. symtablestack:=p^.owner^.next;
  838. while assigned(symtablestack) do
  839. begin
  840. { search for same procsym in other units }
  841. getsym(p^.name,false);
  842. if assigned(srsym) and (srsym^.typ=procsym) then
  843. begin
  844. pprocsym(p)^.nextprocsym:=pprocsym(srsym);
  845. symtablestack:=storesymtablestack;
  846. exit;
  847. end
  848. else if srsym=nil then
  849. symtablestack:=nil
  850. else
  851. symtablestack:=srsymtable^.next;
  852. end;
  853. symtablestack:=storesymtablestack;
  854. end;
  855. end;
  856. {$endif}
  857. procedure write_refs(sym : pnamedindexobject);
  858. begin
  859. psym(sym)^.write_references;
  860. end;
  861. {$ifdef BrowserLog}
  862. procedure add_to_browserlog(sym : pnamedindexobject);
  863. begin
  864. psym(sym)^.add_to_browserlog;
  865. end;
  866. {$endif UseBrowser}
  867. {*****************************************************************************
  868. Search Symtables for Syms
  869. *****************************************************************************}
  870. procedure getsym(const s : stringid;notfounderror : boolean);
  871. var
  872. speedvalue : longint;
  873. begin
  874. speedvalue:=getspeedvalue(s);
  875. lastsrsym:=nil;
  876. srsymtable:=symtablestack;
  877. while assigned(srsymtable) do
  878. begin
  879. srsym:=srsymtable^.speedsearch(s,speedvalue);
  880. if assigned(srsym) then
  881. exit
  882. else
  883. srsymtable:=srsymtable^.next;
  884. end;
  885. if notfounderror then
  886. begin
  887. Message1(sym_e_id_not_found,s);
  888. srsym:=generrorsym;
  889. end
  890. else
  891. srsym:=nil;
  892. end;
  893. procedure getsymonlyin(p : psymtable;const s : stringid);
  894. begin
  895. { the caller have to take care if srsym=nil (FK) }
  896. srsym:=nil;
  897. if assigned(p) then
  898. begin
  899. srsymtable:=p;
  900. srsym:=srsymtable^.search(s);
  901. if assigned(srsym) then
  902. exit
  903. else
  904. begin
  905. if (punitsymtable(srsymtable)=punitsymtable(current_module^.globalsymtable)) then
  906. begin
  907. getsymonlyin(psymtable(current_module^.localsymtable),s);
  908. if assigned(srsym) then
  909. srsymtable:=psymtable(current_module^.localsymtable)
  910. else
  911. Message1(sym_e_id_not_found,s);
  912. end
  913. else
  914. Message1(sym_e_id_not_found,s);
  915. end;
  916. end;
  917. end;
  918. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  919. {Search for a symbol in a specified symbol table. Returns nil if
  920. the symtable is not found, and also if the symbol cannot be found
  921. in the desired symtable }
  922. var hsymtab:Psymtable;
  923. res:Psym;
  924. begin
  925. res:=nil;
  926. hsymtab:=symtablestack;
  927. while (hsymtab<>nil) and (hsymtab^.symtabletype<>symtabletype) do
  928. hsymtab:=hsymtab^.next;
  929. if hsymtab<>nil then
  930. {We found the desired symtable. Now check if the symbol we
  931. search for is defined in it }
  932. res:=hsymtab^.search(symbol);
  933. search_a_symtable:=res;
  934. end;
  935. {****************************************************************************
  936. TSYMTABLE
  937. ****************************************************************************}
  938. constructor tsymtable.init(t : tsymtabletype);
  939. begin
  940. symtabletype:=t;
  941. symtablelevel:=0;
  942. defowner:=nil;
  943. unitid:=0;
  944. next:=nil;
  945. name:=nil;
  946. address_fixup:=0;
  947. datasize:=0;
  948. dataalignment:=1;
  949. new(symindex,init(indexgrowsize));
  950. new(defindex,init(indexgrowsize));
  951. if symtabletype<>withsymtable then
  952. begin
  953. new(symsearch,init);
  954. symsearch^.noclear:=true;
  955. end
  956. else
  957. symsearch:=nil;
  958. alignment:=def_alignment;
  959. end;
  960. destructor tsymtable.done;
  961. begin
  962. stringdispose(name);
  963. dispose(symindex,done);
  964. dispose(defindex,done);
  965. { symsearch can already be disposed or set to nil for withsymtable }
  966. if assigned(symsearch) then
  967. begin
  968. dispose(symsearch,done);
  969. symsearch:=nil;
  970. end;
  971. end;
  972. constructor twithsymtable.init;
  973. begin
  974. inherited init(withsymtable);
  975. direct_with:=false;
  976. withnode:=nil;
  977. withrefnode:=nil;
  978. end;
  979. destructor twithsymtable.done;
  980. begin
  981. symsearch:=nil;
  982. inherited done;
  983. end;
  984. {***********************************************
  985. Helpers
  986. ***********************************************}
  987. function tsymtable.getnewtypecount : word;
  988. begin
  989. getnewtypecount:=pglobaltypecount^;
  990. inc(pglobaltypecount^);
  991. end;
  992. procedure tsymtable.registerdef(p : pdef);
  993. begin
  994. defindex^.insert(p);
  995. { set def owner and indexnb }
  996. p^.owner:=@self;
  997. end;
  998. procedure order_overloads(p : Pnamedindexobject);
  999. begin
  1000. if psym(p)^.typ=procsym then
  1001. pprocsym(p)^.order_overloaded;
  1002. end;
  1003. procedure tsymtable.foreach(proc2call : tnamedindexcallback);
  1004. begin
  1005. symindex^.foreach(proc2call);
  1006. end;
  1007. {***********************************************
  1008. LOAD / WRITE SYMTABLE FROM PPU
  1009. ***********************************************}
  1010. procedure tsymtable.loaddefs;
  1011. var
  1012. hp : pdef;
  1013. b : byte;
  1014. begin
  1015. { load start of definition section, which holds the amount of defs }
  1016. if current_ppu^.readentry<>ibstartdefs then
  1017. Message(unit_f_ppu_read_error);
  1018. current_ppu^.getlongint;
  1019. { read definitions }
  1020. repeat
  1021. b:=current_ppu^.readentry;
  1022. case b of
  1023. ibpointerdef : hp:=new(ppointerdef,load);
  1024. ibarraydef : hp:=new(parraydef,load);
  1025. iborddef : hp:=new(porddef,load);
  1026. ibfloatdef : hp:=new(pfloatdef,load);
  1027. ibprocdef : hp:=new(pprocdef,load);
  1028. ibshortstringdef : hp:=new(pstringdef,shortload);
  1029. iblongstringdef : hp:=new(pstringdef,longload);
  1030. ibansistringdef : hp:=new(pstringdef,ansiload);
  1031. ibwidestringdef : hp:=new(pstringdef,wideload);
  1032. ibrecorddef : hp:=new(precorddef,load);
  1033. ibobjectdef : hp:=new(pobjectdef,load);
  1034. ibenumdef : hp:=new(penumdef,load);
  1035. ibsetdef : hp:=new(psetdef,load);
  1036. ibprocvardef : hp:=new(pprocvardef,load);
  1037. ibfiledef : hp:=new(pfiledef,load);
  1038. ibclassrefdef : hp:=new(pclassrefdef,load);
  1039. ibformaldef : hp:=new(pformaldef,load);
  1040. ibenddefs : break;
  1041. ibend : Message(unit_f_ppu_read_error);
  1042. else
  1043. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1044. end;
  1045. hp^.owner:=@self;
  1046. defindex^.insert(hp);
  1047. until false;
  1048. end;
  1049. procedure tsymtable.loadsyms;
  1050. var
  1051. b : byte;
  1052. sym : psym;
  1053. begin
  1054. { load start of definition section, which holds the amount of defs }
  1055. if current_ppu^.readentry<>ibstartsyms then
  1056. Message(unit_f_ppu_read_error);
  1057. { skip amount of symbols, not used currently }
  1058. current_ppu^.getlongint;
  1059. { load datasize,dataalignment of this symboltable }
  1060. datasize:=current_ppu^.getlongint;
  1061. dataalignment:=current_ppu^.getlongint;
  1062. { now read the symbols }
  1063. repeat
  1064. b:=current_ppu^.readentry;
  1065. case b of
  1066. ibtypesym : sym:=new(ptypesym,load);
  1067. ibprocsym : sym:=new(pprocsym,load);
  1068. ibconstsym : sym:=new(pconstsym,load);
  1069. ibvarsym : sym:=new(pvarsym,load);
  1070. ibfuncretsym : sym:=new(pfuncretsym,load);
  1071. ibabsolutesym : sym:=new(pabsolutesym,load);
  1072. ibenumsym : sym:=new(penumsym,load);
  1073. ibtypedconstsym : sym:=new(ptypedconstsym,load);
  1074. ibpropertysym : sym:=new(ppropertysym,load);
  1075. ibunitsym : sym:=new(punitsym,load);
  1076. iblabelsym : sym:=new(plabelsym,load);
  1077. ibsyssym : sym:=new(psyssym,load);
  1078. ibendsyms : break;
  1079. ibend : Message(unit_f_ppu_read_error);
  1080. else
  1081. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1082. end;
  1083. sym^.owner:=@self;
  1084. symindex^.insert(sym);
  1085. symsearch^.insert(sym);
  1086. until false;
  1087. end;
  1088. procedure tsymtable.writedefs;
  1089. var
  1090. pd : pdef;
  1091. begin
  1092. { each definition get a number, write then the amount of defs to the
  1093. ibstartdef entry }
  1094. current_ppu^.putlongint(defindex^.count);
  1095. current_ppu^.writeentry(ibstartdefs);
  1096. { now write the definition }
  1097. pd:=pdef(defindex^.first);
  1098. while assigned(pd) do
  1099. begin
  1100. pd^.write;
  1101. pd:=pdef(pd^.next);
  1102. end;
  1103. { write end of definitions }
  1104. current_ppu^.writeentry(ibenddefs);
  1105. end;
  1106. procedure tsymtable.writesyms;
  1107. var
  1108. pd : psym;
  1109. begin
  1110. { each definition get a number, write then the amount of syms and the
  1111. datasize to the ibsymdef entry }
  1112. current_ppu^.putlongint(symindex^.count);
  1113. current_ppu^.putlongint(datasize);
  1114. current_ppu^.putlongint(dataalignment);
  1115. current_ppu^.writeentry(ibstartsyms);
  1116. { foreach is used to write all symbols }
  1117. pd:=psym(symindex^.first);
  1118. while assigned(pd) do
  1119. begin
  1120. pd^.write;
  1121. pd:=psym(pd^.next);
  1122. end;
  1123. { end of symbols }
  1124. current_ppu^.writeentry(ibendsyms);
  1125. end;
  1126. procedure tsymtable.deref;
  1127. var
  1128. hp : pdef;
  1129. hs : psym;
  1130. begin
  1131. hp:=pdef(defindex^.first);
  1132. while assigned(hp) do
  1133. begin
  1134. hp^.deref;
  1135. hp^.symderef;
  1136. hp:=pdef(hp^.next);
  1137. end;
  1138. hs:=psym(symindex^.first);
  1139. while assigned(hs) do
  1140. begin
  1141. hs^.deref;
  1142. hs:=psym(hs^.next);
  1143. end;
  1144. end;
  1145. constructor tsymtable.load;
  1146. var
  1147. st_loading : boolean;
  1148. begin
  1149. st_loading:=in_loading;
  1150. in_loading:=true;
  1151. {$ifndef NEWMAP}
  1152. current_module^.map^[0]:=@self;
  1153. {$else NEWMAP}
  1154. current_module^.globalsymtable:=@self;
  1155. {$endif NEWMAP}
  1156. symtabletype:=unitsymtable;
  1157. symtablelevel:=0;
  1158. { unused for units }
  1159. address_fixup:=0;
  1160. datasize:=0;
  1161. defowner:=nil;
  1162. name:=nil;
  1163. unitid:=0;
  1164. defowner:=nil;
  1165. new(symindex,init(indexgrowsize));
  1166. new(defindex,init(indexgrowsize));
  1167. new(symsearch,init);
  1168. symsearch^.usehash;
  1169. symsearch^.noclear:=true;
  1170. alignment:=def_alignment;
  1171. { load definitions }
  1172. loaddefs;
  1173. { load symbols }
  1174. loadsyms;
  1175. { Now we can deref the symbols and definitions }
  1176. if not(symtabletype in [objectsymtable,recordsymtable]) then
  1177. deref;
  1178. {$ifdef NEWMAP}
  1179. { necessary for dependencies }
  1180. current_module^.globalsymtable:=nil;
  1181. {$endif NEWMAP}
  1182. in_loading:=st_loading;
  1183. end;
  1184. procedure tsymtable.write;
  1185. begin
  1186. { write definitions }
  1187. foreach({$ifndef TP}@{$endif}Order_overloads);
  1188. writedefs;
  1189. { write symbols }
  1190. writesyms;
  1191. end;
  1192. constructor tsymtable.loadas(typ : tsymtabletype);
  1193. var
  1194. storesymtable : psymtable;
  1195. st_loading : boolean;
  1196. begin
  1197. st_loading:=in_loading;
  1198. in_loading:=true;
  1199. symtabletype:=typ;
  1200. new(symindex,init(indexgrowsize));
  1201. new(defindex,init(indexgrowsize));
  1202. new(symsearch,init);
  1203. symsearch^.noclear:=true;
  1204. defowner:=nil;
  1205. if typ in [recordsymtable,objectsymtable] then
  1206. begin
  1207. storesymtable:=aktrecordsymtable;
  1208. aktrecordsymtable:=@self;
  1209. end;
  1210. if typ in [parasymtable,localsymtable] then
  1211. begin
  1212. storesymtable:=aktlocalsymtable;
  1213. aktlocalsymtable:=@self;
  1214. end;
  1215. { used for local browser }
  1216. if typ=staticppusymtable then
  1217. begin
  1218. aktstaticsymtable:=@self;
  1219. symsearch^.usehash;
  1220. end;
  1221. name:=nil;
  1222. alignment:=def_alignment;
  1223. { isn't used there }
  1224. datasize:=0;
  1225. address_fixup:= 0;
  1226. { also unused }
  1227. unitid:=0;
  1228. { load definitions }
  1229. { we need the correct symtable for registering }
  1230. if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
  1231. begin
  1232. next:=symtablestack;
  1233. symtablestack:=@self;
  1234. end;
  1235. { load definitions }
  1236. loaddefs;
  1237. { load symbols }
  1238. loadsyms;
  1239. { now we can deref the syms and defs }
  1240. if not (typ in [localsymtable,parasymtable,
  1241. recordsymtable,objectsymtable]) then
  1242. deref;
  1243. if typ in [recordsymtable,objectsymtable] then
  1244. aktrecordsymtable:=storesymtable;
  1245. if typ in [localsymtable,parasymtable] then
  1246. aktlocalsymtable:=storesymtable;
  1247. if not (typ in [localsymtable,parasymtable,recordsymtable,objectsymtable]) then
  1248. begin
  1249. symtablestack:=next;
  1250. end;
  1251. in_loading:=st_loading;
  1252. end;
  1253. procedure tsymtable.writeas;
  1254. var
  1255. oldtyp : byte;
  1256. storesymtable : psymtable;
  1257. begin
  1258. oldtyp:=current_ppu^.entrytyp;
  1259. storesymtable:=aktrecordsymtable;
  1260. if symtabletype in [recordsymtable,objectsymtable] then
  1261. begin
  1262. storesymtable:=aktrecordsymtable;
  1263. aktrecordsymtable:=@self;
  1264. end;
  1265. if symtabletype in [parasymtable,localsymtable] then
  1266. begin
  1267. storesymtable:=aktlocalsymtable;
  1268. aktlocalsymtable:=@self;
  1269. end;
  1270. if (symtabletype in [recordsymtable,objectsymtable]) then
  1271. current_ppu^.entrytyp:=subentryid;
  1272. { order procsym overloads }
  1273. foreach({$ifndef TP}@{$endif}Order_overloads);
  1274. { write definitions }
  1275. writedefs;
  1276. { write symbols }
  1277. writesyms;
  1278. current_ppu^.entrytyp:=oldtyp;
  1279. if symtabletype in [recordsymtable,objectsymtable] then
  1280. aktrecordsymtable:=storesymtable;
  1281. if symtabletype in [localsymtable,parasymtable] then
  1282. aktlocalsymtable:=storesymtable;
  1283. end;
  1284. {***********************************************
  1285. Get Symbol / Def by Number
  1286. ***********************************************}
  1287. function tsymtable.getsymnr(l : longint) : psym;
  1288. var
  1289. hp : psym;
  1290. begin
  1291. hp:=psym(symindex^.search(l));
  1292. if hp=nil then
  1293. internalerror(10999);
  1294. getsymnr:=hp;
  1295. end;
  1296. function tsymtable.getdefnr(l : longint) : pdef;
  1297. var
  1298. hp : pdef;
  1299. begin
  1300. hp:=pdef(defindex^.search(l));
  1301. if hp=nil then
  1302. internalerror(10998);
  1303. getdefnr:=hp;
  1304. end;
  1305. {***********************************************
  1306. Table Access
  1307. ***********************************************}
  1308. procedure tsymtable.clear;
  1309. begin
  1310. { remove no entry from a withsymtable as it is only a pointer to the
  1311. recorddef or objectdef symtable }
  1312. if symtabletype=withsymtable then
  1313. exit;
  1314. symindex^.clear;
  1315. defindex^.clear;
  1316. end;
  1317. function tsymtable.insert(sym:psym):psym;
  1318. var
  1319. hp : psymtable;
  1320. hsym : psym;
  1321. begin
  1322. { set owner and sym indexnb }
  1323. sym^.owner:=@self;
  1324. {$ifdef CHAINPROCSYMS}
  1325. { set the nextprocsym field }
  1326. if sym^.typ=procsym then
  1327. chainprocsym(sym);
  1328. {$endif CHAINPROCSYMS}
  1329. { writes the symbol in data segment if required }
  1330. { also sets the datasize of owner }
  1331. if not in_loading then
  1332. sym^.insert_in_data;
  1333. if (symtabletype in [staticsymtable,globalsymtable]) then
  1334. begin
  1335. hp:=symtablestack;
  1336. while assigned(hp) do
  1337. begin
  1338. if hp^.symtabletype in [staticsymtable,globalsymtable] then
  1339. begin
  1340. hsym:=hp^.search(sym^.name);
  1341. if assigned(hsym) then
  1342. DuplicateSym(hsym);
  1343. end;
  1344. hp:=hp^.next;
  1345. end;
  1346. end;
  1347. { check for duplicate id in local and parsymtable symtable }
  1348. if (symtabletype=localsymtable) then
  1349. { to be on the sure side: }
  1350. begin
  1351. if assigned(next) and
  1352. (next^.symtabletype=parasymtable) then
  1353. begin
  1354. hsym:=next^.search(sym^.name);
  1355. if assigned(hsym) then
  1356. DuplicateSym(hsym);
  1357. end
  1358. else if (current_module^.flags and uf_local_browser)=0 then
  1359. internalerror(43789);
  1360. end;
  1361. { check for duplicate id in local symtable of methods }
  1362. if (symtabletype=localsymtable) and
  1363. assigned(next) and
  1364. assigned(next^.next) and
  1365. { funcretsym is allowed !! }
  1366. (sym^.typ <> funcretsym) and
  1367. (next^.next^.symtabletype=objectsymtable) then
  1368. begin
  1369. hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
  1370. { but private ids can be reused }
  1371. if assigned(hsym) and
  1372. (not(sp_private in hsym^.symoptions) or
  1373. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1374. DuplicateSym(hsym);
  1375. end;
  1376. { check for duplicate id in para symtable of methods }
  1377. if (symtabletype=parasymtable) and
  1378. assigned(procinfo^._class) and
  1379. { but not in nested procedures !}
  1380. (not(assigned(procinfo^.parent)) or
  1381. (assigned(procinfo^.parent) and
  1382. not(assigned(procinfo^.parent^._class)))
  1383. ) and
  1384. { funcretsym is allowed !! }
  1385. (sym^.typ <> funcretsym) then
  1386. begin
  1387. hsym:=search_class_member(procinfo^._class,sym^.name);
  1388. { but private ids can be reused }
  1389. if assigned(hsym) and
  1390. (not(sp_private in hsym^.symoptions) or
  1391. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1392. DuplicateSym(hsym);
  1393. end;
  1394. { check for duplicate field id in inherited classes }
  1395. if (sym^.typ=varsym) and
  1396. (symtabletype=objectsymtable) and
  1397. assigned(defowner) then
  1398. begin
  1399. hsym:=search_class_member(pobjectdef(defowner),sym^.name);
  1400. { but private ids can be reused }
  1401. if assigned(hsym) and
  1402. (not(sp_private in hsym^.symoptions) or
  1403. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1404. DuplicateSym(hsym);
  1405. end;
  1406. { register definition of typesym }
  1407. if (sym^.typ = typesym) and
  1408. assigned(ptypesym(sym)^.definition) then
  1409. begin
  1410. if not(assigned(ptypesym(sym)^.definition^.owner)) and
  1411. (ptypesym(sym)^.definition^.deftype<>errordef) then
  1412. registerdef(ptypesym(sym)^.definition);
  1413. {$ifdef GDB}
  1414. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
  1415. (symtabletype in [globalsymtable,staticsymtable]) then
  1416. begin
  1417. ptypesym(sym)^.isusedinstab := true;
  1418. sym^.concatstabto(debuglist);
  1419. end;
  1420. {$endif GDB}
  1421. end;
  1422. { insert in index and search hash }
  1423. symindex^.insert(sym);
  1424. symsearch^.insert(sym);
  1425. insert:=sym;
  1426. end;
  1427. function tsymtable.search(const s : stringid) : psym;
  1428. begin
  1429. {search:=psym(symsearch^.search(s));
  1430. this bypasses the ref generation (PM) }
  1431. search:=speedsearch(s,getspeedvalue(s));
  1432. end;
  1433. function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psym;
  1434. var
  1435. hp : psym;
  1436. newref : pref;
  1437. begin
  1438. hp:=psym(symsearch^.speedsearch(s,speedvalue));
  1439. if assigned(hp) then
  1440. begin
  1441. { reject non static members in static procedures,
  1442. be carefull aktprocsym^.definition is not allways
  1443. loaded already (PFV) }
  1444. if (symtabletype=objectsymtable) and
  1445. not(sp_static in hp^.symoptions) and
  1446. allow_only_static
  1447. {assigned(aktprocsym) and
  1448. assigned(aktprocsym^.definition) and
  1449. ((aktprocsym^.definition^.options and postaticmethod)<>0)} then
  1450. Message(sym_e_only_static_in_static);
  1451. if (symtabletype=unitsymtable) and
  1452. assigned(punitsymtable(@self)^.unitsym) then
  1453. inc(punitsymtable(@self)^.unitsym^.refs);
  1454. { unitsym are only loaded for browsing PM }
  1455. { this was buggy anyway because we could use }
  1456. { unitsyms from other units in _USES !! }
  1457. if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
  1458. assigned(current_module) and (current_module^.globalsymtable<>@self) then
  1459. hp:=nil;
  1460. if assigned(hp) and
  1461. (cs_browser in aktmoduleswitches) and make_ref then
  1462. begin
  1463. new(newref,init(hp^.lastref,@tokenpos));
  1464. { for symbols that are in tables without
  1465. browser info or syssyms (PM) }
  1466. if hp^.refcount=0 then
  1467. begin
  1468. hp^.defref:=newref;
  1469. hp^.lastref:=newref;
  1470. end
  1471. else
  1472. if resolving_forward and assigned(hp^.defref) then
  1473. { put it as second reference }
  1474. begin
  1475. newref^.nextref:=hp^.defref^.nextref;
  1476. hp^.defref^.nextref:=newref;
  1477. hp^.lastref^.nextref:=nil;
  1478. end
  1479. else
  1480. hp^.lastref:=newref;
  1481. inc(hp^.refcount);
  1482. end;
  1483. if assigned(hp) and make_ref then
  1484. begin
  1485. inc(hp^.refs);
  1486. end;
  1487. end;
  1488. speedsearch:=hp;
  1489. end;
  1490. function tsymtable.rename(const olds,news : stringid):psym;
  1491. begin
  1492. rename:=psym(symsearch^.rename(olds,news));
  1493. end;
  1494. {***********************************************
  1495. Browser
  1496. ***********************************************}
  1497. procedure tsymtable.load_browser;
  1498. var
  1499. b : byte;
  1500. sym : psym;
  1501. prdef : pdef;
  1502. oldrecsyms : psymtable;
  1503. begin
  1504. if symtabletype in [recordsymtable,objectsymtable] then
  1505. begin
  1506. oldrecsyms:=aktrecordsymtable;
  1507. aktrecordsymtable:=@self;
  1508. end;
  1509. if symtabletype in [parasymtable,localsymtable] then
  1510. begin
  1511. oldrecsyms:=aktlocalsymtable;
  1512. aktlocalsymtable:=@self;
  1513. end;
  1514. if symtabletype=staticppusymtable then
  1515. aktstaticsymtable:=@self;
  1516. b:=current_ppu^.readentry;
  1517. if b <> ibbeginsymtablebrowser then
  1518. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1519. repeat
  1520. b:=current_ppu^.readentry;
  1521. case b of
  1522. ibsymref : begin
  1523. sym:=readsymref;
  1524. resolvesym(sym);
  1525. if assigned(sym) then
  1526. sym^.load_references;
  1527. end;
  1528. ibdefref : begin
  1529. prdef:=readdefref;
  1530. resolvedef(prdef);
  1531. if assigned(prdef) then
  1532. begin
  1533. if prdef^.deftype<>procdef then
  1534. Message(unit_f_ppu_read_error);
  1535. pprocdef(prdef)^.load_references;
  1536. end;
  1537. end;
  1538. ibendsymtablebrowser : break;
  1539. else
  1540. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1541. end;
  1542. until false;
  1543. if symtabletype in [recordsymtable,objectsymtable] then
  1544. aktrecordsymtable:=oldrecsyms;
  1545. if symtabletype in [parasymtable,localsymtable] then
  1546. aktlocalsymtable:=oldrecsyms;
  1547. end;
  1548. procedure tsymtable.write_browser;
  1549. var
  1550. oldrecsyms : psymtable;
  1551. begin
  1552. { symbol numbering for references
  1553. should have been done in write PM
  1554. number_symbols;
  1555. number_defs; }
  1556. if symtabletype in [recordsymtable,objectsymtable] then
  1557. begin
  1558. oldrecsyms:=aktrecordsymtable;
  1559. aktrecordsymtable:=@self;
  1560. end;
  1561. if symtabletype in [parasymtable,localsymtable] then
  1562. begin
  1563. oldrecsyms:=aktlocalsymtable;
  1564. aktlocalsymtable:=@self;
  1565. end;
  1566. current_ppu^.writeentry(ibbeginsymtablebrowser);
  1567. foreach({$ifndef TP}@{$endif}write_refs);
  1568. current_ppu^.writeentry(ibendsymtablebrowser);
  1569. if symtabletype in [recordsymtable,objectsymtable] then
  1570. aktrecordsymtable:=oldrecsyms;
  1571. if symtabletype in [parasymtable,localsymtable] then
  1572. aktlocalsymtable:=oldrecsyms;
  1573. end;
  1574. {$ifdef BrowserLog}
  1575. procedure tsymtable.writebrowserlog;
  1576. begin
  1577. if cs_browser in aktmoduleswitches then
  1578. begin
  1579. if assigned(name) then
  1580. Browserlog.AddLog('---Symtable '+name^)
  1581. else
  1582. begin
  1583. if (symtabletype=recordsymtable) and
  1584. assigned(defowner^.sym) then
  1585. Browserlog.AddLog('---Symtable '+defowner^.sym^.name)
  1586. else
  1587. Browserlog.AddLog('---Symtable with no name');
  1588. end;
  1589. Browserlog.Ident;
  1590. foreach({$ifndef TP}@{$endif}add_to_browserlog);
  1591. browserlog.Unident;
  1592. end;
  1593. end;
  1594. {$endif BrowserLog}
  1595. {***********************************************
  1596. Process all entries
  1597. ***********************************************}
  1598. { checks, if all procsyms and methods are defined }
  1599. procedure tsymtable.check_forwards;
  1600. begin
  1601. foreach({$ifndef TP}@{$endif}check_forward);
  1602. end;
  1603. procedure tsymtable.checklabels;
  1604. begin
  1605. foreach({$ifndef TP}@{$endif}labeldefined);
  1606. end;
  1607. procedure tsymtable.set_alignment(_alignment : byte);
  1608. var
  1609. sym : pvarsym;
  1610. l : longint;
  1611. begin
  1612. { this can not be done if there is an
  1613. hasharray ! }
  1614. alignment:=_alignment;
  1615. if (symtabletype<>parasymtable) then
  1616. internalerror(1111);
  1617. sym:=pvarsym(symindex^.first);
  1618. datasize:=0;
  1619. { there can be only varsyms }
  1620. while assigned(sym) do
  1621. begin
  1622. l:=sym^.getpushsize;
  1623. sym^.address:=datasize;
  1624. datasize:=align(datasize+l,alignment);
  1625. sym:=pvarsym(sym^.next);
  1626. end;
  1627. end;
  1628. function tsymtable.find_at_offset(l : longint) : pvarsym;
  1629. var
  1630. sym : pvarsym;
  1631. begin
  1632. find_at_offset:=nil;
  1633. { this can not be done if there is an
  1634. hasharray ! }
  1635. if (symtabletype<>parasymtable) then
  1636. internalerror(1111);
  1637. sym:=pvarsym(symindex^.first);
  1638. while assigned(sym) do
  1639. begin
  1640. if sym^.address+address_fixup=l then
  1641. begin
  1642. find_at_offset:=sym;
  1643. exit;
  1644. end;
  1645. sym:=pvarsym(sym^.next);
  1646. end;
  1647. end;
  1648. procedure tsymtable.allunitsused;
  1649. begin
  1650. foreach({$ifndef TP}@{$endif}unitsymbolused);
  1651. end;
  1652. procedure tsymtable.allsymbolsused;
  1653. begin
  1654. foreach({$ifndef TP}@{$endif}varsymbolused);
  1655. end;
  1656. {$ifdef CHAINPROCSYMS}
  1657. procedure tsymtable.chainprocsyms;
  1658. begin
  1659. foreach({$ifndef TP}@{$endif}chainprocsym);
  1660. end;
  1661. {$endif CHAINPROCSYMS}
  1662. {$ifdef GDB}
  1663. procedure tsymtable.concatstabto(asmlist : paasmoutput);
  1664. begin
  1665. asmoutput:=asmlist;
  1666. foreach({$ifndef TP}@{$endif}concatstab);
  1667. end;
  1668. {$endif}
  1669. {****************************************************************************
  1670. TUNITSYMTABLE
  1671. ****************************************************************************}
  1672. constructor tunitsymtable.init(t : tsymtabletype; const n : string);
  1673. begin
  1674. inherited init(t);
  1675. name:=stringdup(upper(n));
  1676. unitid:=0;
  1677. unitsym:=nil;
  1678. symsearch^.usehash;
  1679. { reset GDB things }
  1680. {$ifdef GDB}
  1681. if (t = globalsymtable) then
  1682. begin
  1683. prev_dbx_counter := dbx_counter;
  1684. dbx_counter := nil;
  1685. end;
  1686. is_stab_written:=false;
  1687. dbx_count := -1;
  1688. if cs_gdb_dbx in aktglobalswitches then
  1689. begin
  1690. dbx_count := 0;
  1691. unittypecount:=1;
  1692. if (symtabletype=globalsymtable) then
  1693. pglobaltypecount := @unittypecount;
  1694. unitid:=current_module^.unitcount;
  1695. debuglist^.concat(new(pai_asm_comment,init(strpnew('Global '+name^+' has index '+tostr(unitid)))));
  1696. debuglist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))));
  1697. inc(current_module^.unitcount);
  1698. dbx_count_ok:=false;
  1699. dbx_counter:=@dbx_count;
  1700. do_count_dbx:=true;
  1701. end;
  1702. {$endif GDB}
  1703. end;
  1704. constructor tunitsymtable.loadasunit;
  1705. var
  1706. storeGlobalTypeCount : pword;
  1707. b : byte;
  1708. begin
  1709. unitsym:=nil;
  1710. unitid:=0;
  1711. {$ifdef GDB}
  1712. if cs_gdb_dbx in aktglobalswitches then
  1713. begin
  1714. UnitTypeCount:=1;
  1715. storeGlobalTypeCount:=PGlobalTypeCount;
  1716. PglobalTypeCount:=@UnitTypeCount;
  1717. end;
  1718. {$endif GDB}
  1719. { load symtables }
  1720. inherited load;
  1721. { set the name after because it is set to nil in tsymtable.load !! }
  1722. name:=stringdup(current_module^.modulename^);
  1723. { dbx count }
  1724. {$ifdef GDB}
  1725. if (current_module^.flags and uf_has_dbx)<>0 then
  1726. begin
  1727. b := current_ppu^.readentry;
  1728. if b <> ibdbxcount then
  1729. Message(unit_f_ppu_dbx_count_problem)
  1730. else
  1731. dbx_count := readlong;
  1732. dbx_count_ok := true;
  1733. end
  1734. else
  1735. begin
  1736. dbx_count := -1;
  1737. dbx_count_ok:=false;
  1738. end;
  1739. if cs_gdb_dbx in aktglobalswitches then
  1740. PGlobalTypeCount:=storeGlobalTypeCount;
  1741. is_stab_written:=false;
  1742. {$endif GDB}
  1743. b:=current_ppu^.readentry;
  1744. if b<>ibendimplementation then
  1745. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1746. end;
  1747. destructor tunitsymtable.done;
  1748. var
  1749. pus : punitsym;
  1750. begin
  1751. pus:=unitsym;
  1752. while assigned(pus) do
  1753. begin
  1754. unitsym:=pus^.prevsym;
  1755. pus^.prevsym:=nil;
  1756. pus^.unitsymtable:=nil;
  1757. pus:=unitsym;
  1758. end;
  1759. inherited done;
  1760. end;
  1761. procedure tunitsymtable.load_symtable_refs;
  1762. var
  1763. b : byte;
  1764. unitindex : word;
  1765. begin
  1766. if ((current_module^.flags and uf_local_browser)<>0) then
  1767. begin
  1768. current_module^.localsymtable:=new(punitsymtable,loadas(staticppusymtable));
  1769. psymtable(current_module^.localsymtable)^.name:=
  1770. stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
  1771. end;
  1772. { load browser }
  1773. if (current_module^.flags and uf_has_browser)<>0 then
  1774. begin
  1775. {if not (cs_browser in aktmoduleswitches) then
  1776. current_ppu^.skipuntilentry(ibendbrowser)
  1777. else }
  1778. begin
  1779. load_browser;
  1780. unitindex:=1;
  1781. while assigned(current_module^.map^[unitindex]) do
  1782. begin
  1783. {each unit wrote one browser entry }
  1784. load_browser;
  1785. inc(unitindex);
  1786. end;
  1787. b:=current_ppu^.readentry;
  1788. if b<>ibendbrowser then
  1789. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1790. end;
  1791. end;
  1792. if ((current_module^.flags and uf_local_browser)<>0) then
  1793. psymtable(current_module^.localsymtable)^.load_browser;
  1794. end;
  1795. procedure tunitsymtable.writeasunit;
  1796. var
  1797. pu : pused_unit;
  1798. begin
  1799. { first the unitname }
  1800. current_ppu^.putstring(name^);
  1801. current_ppu^.writeentry(ibmodulename);
  1802. writesourcefiles;
  1803. writeusedmacros;
  1804. writeusedunit;
  1805. { write the objectfiles and libraries that come for this unit,
  1806. preserve the containers becuase they are still needed to load
  1807. the link.res. All doesn't depend on the crc! It doesn't matter
  1808. if a unit is in a .o or .a file }
  1809. current_ppu^.do_crc:=false;
  1810. writelinkcontainer(current_module^.linkunitofiles,iblinkunitofiles,true);
  1811. writelinkcontainer(current_module^.linkunitstaticlibs,iblinkunitstaticlibs,true);
  1812. writelinkcontainer(current_module^.linkunitsharedlibs,iblinkunitsharedlibs,true);
  1813. writelinkcontainer(current_module^.linkotherofiles,iblinkotherofiles,false);
  1814. writelinkcontainer(current_module^.linkotherstaticlibs,iblinkotherstaticlibs,true);
  1815. writelinkcontainer(current_module^.linkothersharedlibs,iblinkothersharedlibs,true);
  1816. current_ppu^.do_crc:=true;
  1817. current_ppu^.writeentry(ibendinterface);
  1818. { write the symtable entries }
  1819. inherited write;
  1820. { all after doesn't affect crc }
  1821. current_ppu^.do_crc:=false;
  1822. { write dbx count }
  1823. {$ifdef GDB}
  1824. if cs_gdb_dbx in aktglobalswitches then
  1825. begin
  1826. {$IfDef EXTDEBUG}
  1827. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1828. {$ENDIF EXTDEBUG}
  1829. current_ppu^.putlongint(dbx_count);
  1830. current_ppu^.writeentry(ibdbxcount);
  1831. end;
  1832. {$endif GDB}
  1833. current_ppu^.writeentry(ibendimplementation);
  1834. { write static symtable
  1835. needed for local debugging of unit functions }
  1836. if ((current_module^.flags and uf_local_browser)<>0) and
  1837. assigned(current_module^.localsymtable) then
  1838. psymtable(current_module^.localsymtable)^.write;
  1839. { write all browser section }
  1840. if (current_module^.flags and uf_has_browser)<>0 then
  1841. begin
  1842. write_browser;
  1843. pu:=pused_unit(current_module^.used_units.first);
  1844. while assigned(pu) do
  1845. begin
  1846. psymtable(pu^.u^.globalsymtable)^.write_browser;
  1847. pu:=pused_unit(pu^.next);
  1848. end;
  1849. current_ppu^.writeentry(ibendbrowser);
  1850. end;
  1851. if ((current_module^.flags and uf_local_browser)<>0) and
  1852. assigned(current_module^.localsymtable) then
  1853. psymtable(current_module^.localsymtable)^.write_browser;
  1854. { the last entry ibend is written automaticly }
  1855. end;
  1856. function tunitsymtable.getnewtypecount : word;
  1857. begin
  1858. {$ifdef GDB}
  1859. if not (cs_gdb_dbx in aktglobalswitches) then
  1860. getnewtypecount:=tsymtable.getnewtypecount
  1861. else
  1862. {$endif GDB}
  1863. if symtabletype = staticsymtable then
  1864. getnewtypecount:=tsymtable.getnewtypecount
  1865. else
  1866. begin
  1867. getnewtypecount:=unittypecount;
  1868. inc(unittypecount);
  1869. end;
  1870. end;
  1871. {$ifdef GDB}
  1872. procedure tunitsymtable.concattypestabto(asmlist : paasmoutput);
  1873. var prev_dbx_count : plongint;
  1874. begin
  1875. if is_stab_written then exit;
  1876. if not assigned(name) then name := stringdup('Main_program');
  1877. if (symtabletype = unitsymtable) and
  1878. (current_module^.globalsymtable<>@Self) then
  1879. begin
  1880. unitid:=current_module^.unitcount;
  1881. inc(current_module^.unitcount);
  1882. end;
  1883. asmlist^.concat(new(pai_asm_comment,init(strpnew('Begin unit '+name^
  1884. +' has index '+tostr(unitid)))));
  1885. if cs_gdb_dbx in aktglobalswitches then
  1886. begin
  1887. if dbx_count_ok then
  1888. begin
  1889. asmlist^.concat(new(pai_asm_comment,init(strpnew('"repeated" unit '+name^
  1890. +' has index '+tostr(unitid)+' dbx count = '+tostr(dbx_count)))));
  1891. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1892. +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))));
  1893. exit;
  1894. end
  1895. else if (current_module^.globalsymtable<>@Self) then
  1896. begin
  1897. prev_dbx_count := dbx_counter;
  1898. dbx_counter := nil;
  1899. do_count_dbx:=false;
  1900. if symtabletype = unitsymtable then
  1901. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1902. +tostr(N_BINCL)+',0,0,0'))));
  1903. dbx_counter := @dbx_count;
  1904. dbx_count:=0;
  1905. do_count_dbx:=assigned(dbx_counter);
  1906. end;
  1907. end;
  1908. asmoutput:=asmlist;
  1909. foreach({$ifndef TP}@{$endif}concattypestab);
  1910. if cs_gdb_dbx in aktglobalswitches then
  1911. begin
  1912. if (current_module^.globalsymtable<>@Self) then
  1913. begin
  1914. dbx_counter := prev_dbx_count;
  1915. do_count_dbx:=false;
  1916. asmlist^.concat(new(pai_asm_comment,init(strpnew('End unit '+name^
  1917. +' has index '+tostr(unitid)))));
  1918. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1919. +tostr(N_EINCL)+',0,0,0'))));
  1920. do_count_dbx:=assigned(dbx_counter);
  1921. dbx_count_ok := true;
  1922. end;
  1923. end;
  1924. is_stab_written:=true;
  1925. end;
  1926. {$endif}
  1927. {****************************************************************************
  1928. Definitions
  1929. ****************************************************************************}
  1930. {$I symdef.inc}
  1931. {****************************************************************************
  1932. Symbols
  1933. ****************************************************************************}
  1934. {$I symsym.inc}
  1935. {****************************************************************************
  1936. GDB Helpers
  1937. ****************************************************************************}
  1938. {$ifdef GDB}
  1939. function typeglobalnumber(const s : string) : string;
  1940. var st : string;
  1941. symt : psymtable;
  1942. old_make_ref : boolean;
  1943. begin
  1944. old_make_ref:=make_ref;
  1945. make_ref:=false;
  1946. typeglobalnumber := '0';
  1947. srsym := nil;
  1948. if pos('.',s) > 0 then
  1949. begin
  1950. st := copy(s,1,pos('.',s)-1);
  1951. getsym(st,false);
  1952. st := copy(s,pos('.',s)+1,255);
  1953. if assigned(srsym) then
  1954. begin
  1955. if srsym^.typ = unitsym then
  1956. begin
  1957. symt := punitsym(srsym)^.unitsymtable;
  1958. srsym := symt^.search(st);
  1959. end else srsym := nil;
  1960. end;
  1961. end else st := s;
  1962. if srsym = nil then getsym(st,true);
  1963. if srsym^.typ<>typesym then
  1964. begin
  1965. Message(type_e_type_id_expected);
  1966. exit;
  1967. end;
  1968. typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
  1969. make_ref:=old_make_ref;
  1970. end;
  1971. {$endif GDB}
  1972. {****************************************************************************
  1973. Definition Helpers
  1974. ****************************************************************************}
  1975. procedure reset_global_defs;
  1976. var
  1977. def : pdef;
  1978. {$ifdef debug}
  1979. prevdef : pdef;
  1980. {$endif debug}
  1981. begin
  1982. {$ifdef debug}
  1983. prevdef:=nil;
  1984. {$endif debug}
  1985. {$ifdef GDB}
  1986. pglobaltypecount:=@globaltypecount;
  1987. {$endif GDB}
  1988. def:=firstglobaldef;
  1989. while assigned(def) do
  1990. begin
  1991. {$ifdef GDB}
  1992. if assigned(def^.sym) then
  1993. def^.sym^.isusedinstab:=false;
  1994. def^.is_def_stab_written:=false;
  1995. {$endif GDB}
  1996. {if not current_module^.in_implementation then}
  1997. begin
  1998. { reset rangenr's }
  1999. case def^.deftype of
  2000. orddef : porddef(def)^.rangenr:=0;
  2001. enumdef : penumdef(def)^.rangenr:=0;
  2002. arraydef : parraydef(def)^.rangenr:=0;
  2003. end;
  2004. if def^.deftype<>objectdef then
  2005. def^.has_rtti:=false;
  2006. def^.has_inittable:=false;
  2007. end;
  2008. {$ifdef debug}
  2009. prevdef:=def;
  2010. {$endif debug}
  2011. def:=def^.nextglobal;
  2012. end;
  2013. end;
  2014. {****************************************************************************
  2015. Object Helpers
  2016. ****************************************************************************}
  2017. function search_class_member(pd : pobjectdef;const n : string) : psym;
  2018. { searches n in symtable of pd and all anchestors }
  2019. var
  2020. sym : psym;
  2021. begin
  2022. sym:=nil;
  2023. while assigned(pd) do
  2024. begin
  2025. sym:=pd^.symtable^.search(n);
  2026. if assigned(sym) then
  2027. break;
  2028. pd:=pd^.childof;
  2029. end;
  2030. { this is needed for static methods in do_member_read pexpr unit PM
  2031. caused bug0214 }
  2032. if assigned(sym) then
  2033. begin
  2034. srsymtable:=pd^.symtable;
  2035. end;
  2036. search_class_member:=sym;
  2037. end;
  2038. var
  2039. _defaultprop : ppropertysym;
  2040. procedure testfordefaultproperty(p : pnamedindexobject);
  2041. begin
  2042. if (psym(p)^.typ=propertysym) and
  2043. (ppo_defaultproperty in ppropertysym(p)^.propoptions) then
  2044. _defaultprop:=ppropertysym(p);
  2045. end;
  2046. function search_default_property(pd : pobjectdef) : ppropertysym;
  2047. { returns the default property of a class, searches also anchestors }
  2048. begin
  2049. _defaultprop:=nil;
  2050. while assigned(pd) do
  2051. begin
  2052. pd^.symtable^.foreach({$ifndef TP}@{$endif}testfordefaultproperty);
  2053. if assigned(_defaultprop) then
  2054. break;
  2055. pd:=pd^.childof;
  2056. end;
  2057. search_default_property:=_defaultprop;
  2058. end;
  2059. {****************************************************************************
  2060. Macro's
  2061. ****************************************************************************}
  2062. procedure def_macro(const s : string);
  2063. var
  2064. mac : pmacrosym;
  2065. begin
  2066. mac:=pmacrosym(macros^.search(s));
  2067. if mac=nil then
  2068. begin
  2069. mac:=new(pmacrosym,init(s));
  2070. Message1(parser_m_macro_defined,mac^.name);
  2071. macros^.insert(mac);
  2072. end;
  2073. mac^.defined:=true;
  2074. mac^.defined_at_startup:=true;
  2075. end;
  2076. procedure set_macro(const s : string;value : string);
  2077. var
  2078. mac : pmacrosym;
  2079. begin
  2080. mac:=pmacrosym(macros^.search(s));
  2081. if mac=nil then
  2082. begin
  2083. mac:=new(pmacrosym,init(s));
  2084. macros^.insert(mac);
  2085. end
  2086. else
  2087. begin
  2088. if assigned(mac^.buftext) then
  2089. freemem(mac^.buftext,mac^.buflen);
  2090. end;
  2091. Message2(parser_m_macro_set_to,mac^.name,value);
  2092. mac^.buflen:=length(value);
  2093. getmem(mac^.buftext,mac^.buflen);
  2094. move(value[1],mac^.buftext^,mac^.buflen);
  2095. mac^.defined:=true;
  2096. mac^.defined_at_startup:=true;
  2097. end;
  2098. {$ifdef UNITALIASES}
  2099. {****************************************************************************
  2100. TUNIT_ALIAS
  2101. ****************************************************************************}
  2102. constructor tunit_alias.init(const n:string);
  2103. var
  2104. i : longint;
  2105. begin
  2106. i:=pos('=',n);
  2107. if i=0 then
  2108. fail;
  2109. inherited initname(Copy(n,1,i-1));
  2110. newname:=stringdup(Copy(n,i+1,255));
  2111. end;
  2112. destructor tunit_alias.done;
  2113. begin
  2114. stringdispose(newname);
  2115. inherited done;
  2116. end;
  2117. procedure addunitalias(const n:string);
  2118. begin
  2119. unitaliases^.insert(new(punit_alias,init(Upper(n))));
  2120. end;
  2121. function getunitalias(const n:string):string;
  2122. var
  2123. p : punit_alias;
  2124. begin
  2125. p:=punit_alias(unitaliases^.search(Upper(n)));
  2126. if assigned(p) then
  2127. getunitalias:=punit_alias(p)^.newname^
  2128. else
  2129. getunitalias:=n;
  2130. end;
  2131. {$endif UNITALIASES}
  2132. {****************************************************************************
  2133. Symtable Stack
  2134. ****************************************************************************}
  2135. procedure dellexlevel;
  2136. var
  2137. p : psymtable;
  2138. begin
  2139. p:=symtablestack;
  2140. symtablestack:=p^.next;
  2141. { symbol tables of unit interfaces are never disposed }
  2142. { this is handle by the unit unitm }
  2143. if not(p^.symtabletype in [unitsymtable,globalsymtable,stt_exceptsymtable]) or dispose_global then
  2144. dispose(p,done);
  2145. end;
  2146. {$ifdef DEBUG}
  2147. procedure test_symtablestack;
  2148. var
  2149. p : psymtable;
  2150. i : longint;
  2151. begin
  2152. p:=symtablestack;
  2153. i:=0;
  2154. while assigned(p) do
  2155. begin
  2156. inc(i);
  2157. p:=p^.next;
  2158. if i>500 then
  2159. Message(sym_f_internal_error_in_symtablestack);
  2160. end;
  2161. end;
  2162. procedure list_symtablestack;
  2163. var
  2164. p : psymtable;
  2165. i : longint;
  2166. begin
  2167. p:=symtablestack;
  2168. i:=0;
  2169. while assigned(p) do
  2170. begin
  2171. inc(i);
  2172. writeln(i,' ',p^.name^);
  2173. p:=p^.next;
  2174. if i>500 then
  2175. Message(sym_f_internal_error_in_symtablestack);
  2176. end;
  2177. end;
  2178. {$endif DEBUG}
  2179. {****************************************************************************
  2180. Init/Done Symtable
  2181. ****************************************************************************}
  2182. {$ifndef Delphi}
  2183. {$ifdef tp}
  2184. procedure do_streamerror;
  2185. begin
  2186. if symbolstream.status=-2 then
  2187. WriteLn('Error: Not enough EMS memory')
  2188. else
  2189. WriteLn('Error: EMS Error ',symbolstream.status);
  2190. halt(1);
  2191. end;
  2192. {$endif TP}
  2193. {$endif Delphi}
  2194. procedure InitSymtable;
  2195. begin
  2196. {$ifndef Delphi}
  2197. {$ifdef TP}
  2198. { Allocate stream }
  2199. if use_big then
  2200. begin
  2201. streamerror:=@do_streamerror;
  2202. { symbolstream.init('TMPFILE',stcreate,16000); }
  2203. {$ifndef dpmi}
  2204. symbolstream.init(10000,4000000); {using ems streams}
  2205. {$else}
  2206. symbolstream.init(1000000,16000); {using memory streams}
  2207. {$endif}
  2208. if symbolstream.errorinfo=stiniterror then
  2209. do_streamerror;
  2210. { write something, because pos 0 means nil pointer }
  2211. symbolstream.writestr(@inputfile);
  2212. end;
  2213. {$endif tp}
  2214. {$endif Delphi}
  2215. { Reset symbolstack }
  2216. registerdef:=false;
  2217. read_member:=false;
  2218. symtablestack:=nil;
  2219. systemunit:=nil;
  2220. {$ifdef GDB}
  2221. firstglobaldef:=nil;
  2222. lastglobaldef:=nil;
  2223. {$endif GDB}
  2224. globaltypecount:=1;
  2225. pglobaltypecount:=@globaltypecount;
  2226. { create error syms and def }
  2227. generrorsym:=new(perrorsym,init);
  2228. generrordef:=new(perrordef,init);
  2229. {$ifdef UNITALIASES}
  2230. { unit aliases }
  2231. unitaliases:=new(pdictionary,init);
  2232. {$endif}
  2233. for token:=first_overloaded to last_overloaded do
  2234. overloaded_operators[token]:=nil;
  2235. end;
  2236. procedure DoneSymtable;
  2237. begin
  2238. dispose(generrorsym,done);
  2239. dispose(generrordef,done);
  2240. {$ifdef UNITALIASES}
  2241. dispose(unitaliases,done);
  2242. {$endif}
  2243. {$ifndef Delphi}
  2244. {$ifdef TP}
  2245. { close the stream }
  2246. if use_big then
  2247. symbolstream.done;
  2248. {$endif}
  2249. {$endif Delphi}
  2250. end;
  2251. end.
  2252. {
  2253. $Log$
  2254. Revision 1.63 1999-11-17 17:05:06 pierre
  2255. * Notes/hints changes
  2256. Revision 1.62 1999/11/15 22:00:48 peter
  2257. * labels used but not defined give error instead of warning, the warning
  2258. is now only with declared but not defined and not used.
  2259. Revision 1.61 1999/11/15 17:52:59 pierre
  2260. + one field added for ttoken record for operator
  2261. linking the id to the corresponding operator token that
  2262. can now now all be overloaded
  2263. * overloaded operators are resetted to nil in InitSymtable
  2264. (bug when trying to compile a uint that overloads operators twice)
  2265. Revision 1.60 1999/11/09 23:35:50 pierre
  2266. + better reference pos for forward defs
  2267. Revision 1.59 1999/11/06 16:21:57 jonas
  2268. + search optimial register to use in alignment code (compile with
  2269. -dalignreg, -dalignregdebug to see chosen register in
  2270. assembler code). Still needs support in ag386bin.
  2271. Revision 1.58 1999/11/06 14:34:28 peter
  2272. * truncated log to 20 revs
  2273. Revision 1.57 1999/11/05 17:18:03 pierre
  2274. * local browsing works at first level
  2275. ie for function defined in interface or implementation
  2276. not yet for functions inside other functions
  2277. Revision 1.56 1999/11/04 23:13:25 peter
  2278. * moved unit alias support into ifdef
  2279. Revision 1.55 1999/11/04 10:54:02 peter
  2280. + -Ua<oldname>=<newname> unit alias support
  2281. Revision 1.54 1999/10/26 12:30:46 peter
  2282. * const parameter is now checked
  2283. * better and generic check if a node can be used for assigning
  2284. * export fixes
  2285. * procvar equal works now (it never had worked at least from 0.99.8)
  2286. * defcoll changed to linkedlist with pparaitem so it can easily be
  2287. walked both directions
  2288. Revision 1.53 1999/10/06 17:39:15 peter
  2289. * fixed stabs writting for forward types
  2290. Revision 1.52 1999/10/03 19:44:42 peter
  2291. * removed objpasunit reference, tvarrec is now searched in systemunit
  2292. where it already was located
  2293. Revision 1.51 1999/10/01 08:02:49 peter
  2294. * forward type declaration rewritten
  2295. Revision 1.50 1999/09/28 20:48:25 florian
  2296. * fixed bug 610
  2297. + added $D- for TP in symtable.pas else it can't be compiled anymore
  2298. (too much symbols :()
  2299. Revision 1.49 1999/09/27 23:44:59 peter
  2300. * procinfo is now a pointer
  2301. * support for result setting in sub procedure
  2302. Revision 1.48 1999/09/12 21:35:38 florian
  2303. * fixed a crash under Linux. Why doesn't have the damned Windows DPMI nil pointer
  2304. protection???
  2305. Revision 1.47 1999/09/12 08:48:09 florian
  2306. * bugs 593 and 607 fixed
  2307. * some other potential bugs with array constructors fixed
  2308. * for classes compiled in $M+ and it's childs, the default access method
  2309. is now published
  2310. * fixed copyright message (it is now 1993-99)
  2311. Revision 1.46 1999/09/10 18:48:10 florian
  2312. * some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
  2313. * most things for stored properties fixed
  2314. Revision 1.45 1999/09/08 08:05:44 peter
  2315. * fixed bug 248
  2316. Revision 1.44 1999/08/31 15:46:21 pierre
  2317. * do_crc must be false for all browser stuff
  2318. + tmacrosym defined_at_startup set in def_macro and set_macro
  2319. Revision 1.43 1999/08/27 10:39:24 pierre
  2320. * uf_local_browser made problem when computing interface CRC
  2321. Revision 1.42 1999/08/13 21:33:13 peter
  2322. * support for array constructors extended and more error checking
  2323. Revision 1.41 1999/08/13 14:24:22 pierre
  2324. + stabs for classes and classref working,
  2325. a class still needs an ^ to get that content of it,
  2326. but the class fields inside a class don't result into an
  2327. infinite loop anymore!
  2328. Revision 1.40 1999/08/10 16:25:42 pierre
  2329. * unitid changed to word
  2330. Revision 1.39 1999/08/10 12:33:36 pierre
  2331. * pprocsym defined earlier for use in tprocdef
  2332. Revision 1.38 1999/08/05 16:53:18 peter
  2333. * V_Fatal=1, all other V_ are also increased
  2334. * Check for local procedure when assigning procvar
  2335. * fixed comment parsing because directives
  2336. * oldtp mode directives better supported
  2337. * added some messages to errore.msg
  2338. }