symtable.pas 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031
  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. objects,
  26. {$endif}
  27. strings,cobjects,
  28. globtype,globals,tokens,systems,verbose,
  29. aasm
  30. {$ifdef i386}
  31. ,i386base
  32. {$endif}
  33. {$ifdef m68k}
  34. ,m68k
  35. {$endif}
  36. {$ifdef alpha}
  37. ,alpha
  38. {$endif}
  39. {$ifdef GDB}
  40. ,gdb
  41. {$endif}
  42. ;
  43. {************************************************
  44. Some internal constants
  45. ************************************************}
  46. const
  47. hasharraysize = 256;
  48. {$ifdef TP}
  49. indexgrowsize = 256;
  50. {$else}
  51. indexgrowsize = 1024;
  52. {$endif}
  53. {************************************************
  54. Constants
  55. ************************************************}
  56. {$i symconst.inc}
  57. {************************************************
  58. Needed forward pointers
  59. ************************************************}
  60. type
  61. { needed for owner (table) of symbol }
  62. psymtable = ^tsymtable;
  63. punitsymtable = ^tunitsymtable;
  64. { needed for names by the definitions }
  65. ptypesym = ^ttypesym;
  66. penumsym = ^tenumsym;
  67. pref = ^tref;
  68. tref = object
  69. nextref : pref;
  70. posinfo : tfileposinfo;
  71. moduleindex : word;
  72. is_written : boolean;
  73. constructor init(ref:pref;pos:pfileposinfo);
  74. destructor done; virtual;
  75. end;
  76. { Deref entry options }
  77. tdereftype = (derefnil,derefaktrecordindex,derefaktstaticindex,
  78. derefunit,derefrecord,derefindex,
  79. dereflocal,derefpara);
  80. pderef = ^tderef;
  81. tderef = object
  82. dereftype : tdereftype;
  83. index : word;
  84. next : pderef;
  85. constructor init(typ:tdereftype;i:word);
  86. destructor done;
  87. end;
  88. psymtableentry = ^tsymtableentry;
  89. tsymtableentry = object(tnamedindexobject)
  90. owner : psymtable;
  91. end;
  92. {************************************************
  93. TDef
  94. ************************************************}
  95. {$i symdefh.inc}
  96. {************************************************
  97. TSym
  98. ************************************************}
  99. {$i symsymh.inc}
  100. {************************************************
  101. TSymtable
  102. ************************************************}
  103. tsymtabletype = (invalidsymtable,withsymtable,staticsymtable,
  104. globalsymtable,unitsymtable,
  105. objectsymtable,recordsymtable,
  106. macrosymtable,localsymtable,
  107. parasymtable,inlineparasymtable,
  108. inlinelocalsymtable,stt_exceptsymtable,
  109. { only used for PPU reading of static part
  110. of a unit }
  111. staticppusymtable);
  112. tcallback = procedure(p : psym);
  113. tsearchhasharray = array[0..hasharraysize-1] of psym;
  114. psearchhasharray = ^tsearchhasharray;
  115. tsymtable = object
  116. symtabletype : tsymtabletype;
  117. unitid : word; { each symtable gets a number }
  118. name : pstring;
  119. datasize : longint;
  120. symindex,
  121. defindex : pindexarray;
  122. symsearch : pdictionary;
  123. next : psymtable;
  124. defowner : pdef; { for records and objects }
  125. { alignment used in this symtable }
  126. alignment : longint;
  127. { only used for parameter symtable to determine the offset relative }
  128. { to the frame pointer and for local inline }
  129. address_fixup : longint;
  130. { this saves all definition to allow a proper clean up }
  131. { separate lexlevel from symtable type }
  132. symtablelevel : byte;
  133. constructor init(t : tsymtabletype);
  134. destructor done;virtual;
  135. { access }
  136. function getdefnr(l : longint) : pdef;
  137. function getsymnr(l : longint) : psym;
  138. { load/write }
  139. constructor load;
  140. procedure write;
  141. constructor loadas(typ : tsymtabletype);
  142. procedure writeas;
  143. procedure loaddefs;
  144. procedure loadsyms;
  145. procedure writedefs;
  146. procedure writesyms;
  147. procedure deref;
  148. procedure clear;
  149. function rename(const olds,news : stringid):psym;
  150. procedure foreach(proc2call : tnamedindexcallback);
  151. function insert(sym : psym):psym;
  152. function search(const s : stringid) : psym;
  153. function speedsearch(const s : stringid;speedvalue : longint) : psym;
  154. procedure registerdef(p : pdef);
  155. procedure allsymbolsused;
  156. procedure allunitsused;
  157. procedure check_forwards;
  158. procedure checklabels;
  159. { change alignment for args only parasymtable }
  160. procedure set_alignment(_alignment : byte);
  161. { find arg having offset only parasymtable }
  162. function find_at_offset(l : longint) : pvarsym;
  163. {$ifdef CHAINPROCSYMS}
  164. procedure chainprocsyms;
  165. {$endif CHAINPROCSYMS}
  166. procedure load_browser;
  167. procedure write_browser;
  168. {$ifdef BrowserLog}
  169. procedure writebrowserlog;
  170. {$endif BrowserLog}
  171. {$ifdef GDB}
  172. procedure concatstabto(asmlist : paasmoutput);virtual;
  173. {$endif GDB}
  174. function getnewtypecount : word; virtual;
  175. end;
  176. tunitsymtable = object(tsymtable)
  177. unittypecount : word;
  178. unitsym : punitsym;
  179. {$ifdef GDB}
  180. dbx_count : longint;
  181. prev_dbx_counter : plongint;
  182. dbx_count_ok : boolean;
  183. is_stab_written : boolean;
  184. {$endif GDB}
  185. constructor init(t : tsymtabletype;const n : string);
  186. constructor loadasunit;
  187. destructor done;virtual;
  188. procedure writeasunit;
  189. {$ifdef GDB}
  190. procedure concattypestabto(asmlist : paasmoutput);
  191. {$endif GDB}
  192. procedure load_symtable_refs;
  193. function getnewtypecount : word; virtual;
  194. end;
  195. pwithsymtable = ^twithsymtable;
  196. twithsymtable = object(tsymtable)
  197. { used for withsymtable for allowing constructors }
  198. direct_with : boolean;
  199. { in fact it is a ptree }
  200. withnode : pointer;
  201. { ptree to load of direct with var }
  202. { already usable before firstwith
  203. needed for firstpass of function parameters PM }
  204. withrefnode : pointer;
  205. constructor init;
  206. destructor done;virtual;
  207. end;
  208. {****************************************************************************
  209. Var / Consts
  210. ****************************************************************************}
  211. const
  212. systemunit : punitsymtable = nil; { pointer to the system unit }
  213. objpasunit : punitsymtable = nil; { pointer to the objpas unit }
  214. current_object_option : symprop = sp_public;
  215. var
  216. { for STAB debugging }
  217. globaltypecount : word;
  218. pglobaltypecount : pword;
  219. registerdef : boolean; { true, when defs should be registered }
  220. defaultsymtablestack, { symtablestack after default units
  221. have been loaded }
  222. symtablestack : psymtable; { linked list of symtables }
  223. srsym : psym; { result of the last search }
  224. srsymtable : psymtable;
  225. lastsrsym : psym; { last sym found in statement }
  226. lastsrsymtable : psymtable;
  227. lastsymknown : boolean;
  228. forwardsallowed : boolean; { true, wenn forward pointers can be
  229. inserted }
  230. constsymtable : psymtable; { symtable were the constants can be
  231. inserted }
  232. voidpointerdef : ppointerdef; { pointer for Void-Pointerdef }
  233. charpointerdef : ppointerdef; { pointer for Char-Pointerdef }
  234. voidfarpointerdef : ppointerdef;
  235. cformaldef : pformaldef; { unique formal definition }
  236. voiddef : porddef; { Pointer to Void (procedure) }
  237. cchardef : porddef; { Pointer to Char }
  238. booldef : porddef; { pointer to boolean type }
  239. u8bitdef : porddef; { Pointer to 8-Bit unsigned }
  240. u16bitdef : porddef; { Pointer to 16-Bit unsigned }
  241. u32bitdef : porddef; { Pointer to 32-Bit unsigned }
  242. s32bitdef : porddef; { Pointer to 32-Bit signed }
  243. cu64bitdef : porddef; { pointer to 64 bit unsigned def }
  244. cs64bitintdef : porddef; { pointer to 64 bit signed def, }
  245. { calculated by the int unit on i386 }
  246. s32floatdef : pfloatdef; { pointer for realconstn }
  247. s64floatdef : pfloatdef; { pointer for realconstn }
  248. s80floatdef : pfloatdef; { pointer to type of temp. floats }
  249. s32fixeddef : pfloatdef; { pointer to type of temp. fixed }
  250. cshortstringdef : pstringdef; { pointer to type of short string const }
  251. clongstringdef : pstringdef; { pointer to type of long string const }
  252. cansistringdef : pstringdef; { pointer to type of ansi string const }
  253. cwidestringdef : pstringdef; { pointer to type of wide string const }
  254. openshortstringdef : pstringdef; { pointer to type of an open shortstring,
  255. needed for readln() }
  256. openchararraydef : parraydef; { pointer to type of an open array of char,
  257. needed for readln() }
  258. cfiledef : pfiledef; { get the same definition for all file }
  259. { uses for stabs }
  260. firstglobaldef, { linked list of all globals defs }
  261. lastglobaldef : pdef; { used to reset stabs/ranges }
  262. class_tobject : pobjectdef; { pointer to the anchestor of all }
  263. { clases }
  264. aktprocsym : pprocsym; { pointer to the symbol for the
  265. currently be parsed procedure }
  266. aktcallprocsym : pprocsym; { pointer to the symbol for the
  267. currently be called procedure,
  268. only set/unset in firstcall }
  269. aktvarsym : pvarsym; { pointer to the symbol for the
  270. currently read var, only used
  271. for variable directives }
  272. procprefix : string; { eindeutige Namen bei geschachtel- }
  273. { ten Unterprogrammen erzeugen }
  274. lexlevel : longint; { level of code }
  275. { 1 for main procedure }
  276. { 2 for normal function or proc }
  277. { higher for locals }
  278. const
  279. main_program_level = 1;
  280. unit_init_level = 1;
  281. normal_function_level = 2;
  282. in_loading : boolean = false;
  283. {$ifdef i386}
  284. bestrealdef : ^pfloatdef = @s80floatdef;
  285. {$endif}
  286. {$ifdef m68k}
  287. bestrealdef : ^pfloatdef = @s64floatdef;
  288. {$endif}
  289. var
  290. macros : psymtable; { pointer for die Symboltabelle mit }
  291. { Makros }
  292. read_member : boolean; { true, wenn Members aus einer PPU- }
  293. { Datei gelesen werden, d.h. ein }
  294. { varsym seine Adresse einlesen soll }
  295. generrorsym : psym; { Jokersymbol, wenn das richtige }
  296. { Symbol nicht gefunden wird }
  297. generrordef : pdef; { Jokersymbol for eine fehlerhafte }
  298. { Typdefinition }
  299. aktobjectdef : pobjectdef; { used for private functions check !! }
  300. const
  301. { last operator which can be overloaded }
  302. first_overloaded = PLUS;
  303. last_overloaded = ASSIGNMENT;
  304. var
  305. overloaded_operators : array[first_overloaded..last_overloaded] of pprocsym;
  306. { unequal is not equal}
  307. const
  308. overloaded_names : array [first_overloaded..last_overloaded] of string[16] =
  309. ('plus','minus','star','slash','equal',
  310. 'greater','lower','greater_or_equal',
  311. 'lower_or_equal','as','is','in','sym_diff',
  312. 'starstar','assign');
  313. {****************************************************************************
  314. Functions
  315. ****************************************************************************}
  316. {*** Misc ***}
  317. function globaldef(const s : string) : pdef;
  318. procedure duplicatesym(sym:psym);
  319. {*** Search ***}
  320. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  321. procedure getsym(const s : stringid;notfounderror : boolean);
  322. procedure getsymonlyin(p : psymtable;const s : stringid);
  323. {*** Forwards ***}
  324. procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
  325. procedure resolve_forwards;
  326. {*** PPU Write/Loading ***}
  327. procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
  328. procedure closecurrentppu;
  329. procedure numberunits;
  330. procedure load_interface;
  331. {*** GDB ***}
  332. {$ifdef GDB}
  333. function typeglobalnumber(const s : string) : string;
  334. {$endif}
  335. {*** Definition ***}
  336. procedure reset_global_defs;
  337. {*** Object Helpers ***}
  338. function search_class_member(pd : pobjectdef;const n : string) : psym;
  339. function search_default_property(pd : pobjectdef) : ppropertysym;
  340. {*** Macro ***}
  341. procedure def_macro(const s : string);
  342. procedure set_macro(const s : string;value : string);
  343. {*** symtable stack ***}
  344. procedure dellexlevel;
  345. {$ifdef DEBUG}
  346. procedure test_symtablestack;
  347. procedure list_symtablestack;
  348. {$endif DEBUG}
  349. {*** dispose of a pdefcoll (args of a function) ***}
  350. procedure disposepdefcoll(var para1 : pdefcoll);
  351. {*** Init / Done ***}
  352. procedure InitSymtable;
  353. procedure DoneSymtable;
  354. implementation
  355. uses
  356. version,
  357. types,ppu,
  358. gendef,files
  359. ,tree
  360. {$ifdef newcg}
  361. ,cgbase
  362. {$else}
  363. ,hcodegen
  364. {$endif}
  365. {$ifdef BrowserLog}
  366. ,browlog
  367. {$endif BrowserLog}
  368. ;
  369. var
  370. aktrecordsymtable : psymtable; { current record read from ppu symtable }
  371. aktstaticsymtable : psymtable; { current static for local ppu symtable }
  372. {$ifdef GDB}
  373. asmoutput : paasmoutput;
  374. {$endif GDB}
  375. {$ifdef TP}
  376. {$ifndef dpmi}
  377. symbolstream : temsstream; { stream which is used to store some info }
  378. {$else}
  379. symbolstream : tmemorystream;
  380. {$endif}
  381. {$endif}
  382. {to dispose the global symtable of a unit }
  383. const
  384. dispose_global : boolean = false;
  385. memsizeinc = 2048; { for long stabstrings }
  386. tagtypes : Set of tdeftype =
  387. [recorddef,enumdef,
  388. {$IfNDef GDBKnowsStrings}
  389. stringdef,
  390. {$EndIf not GDBKnowsStrings}
  391. {$IfNDef GDBKnowsFiles}
  392. filedef,
  393. {$EndIf not GDBKnowsFiles}
  394. objectdef];
  395. {*****************************************************************************
  396. Helper Routines
  397. *****************************************************************************}
  398. function demangledparas(s : string) : string;
  399. var
  400. r : string;
  401. l : longint;
  402. begin
  403. demangledparas:='';
  404. r:=',';
  405. { delete leading $$'s }
  406. l:=pos('$$',s);
  407. while l<>0 do
  408. begin
  409. delete(s,1,l+1);
  410. l:=pos('$$',s);
  411. end;
  412. l:=pos('$',s);
  413. if l=0 then
  414. exit;
  415. delete(s,1,l);
  416. l:=pos('$',s);
  417. if l=0 then
  418. l:=length(s)+1;
  419. while s<>'' do
  420. begin
  421. r:=r+copy(s,1,l-1)+',';
  422. delete(s,1,l);
  423. end;
  424. delete(r,1,1);
  425. delete(r,length(r),1);
  426. demangledparas:=r;
  427. end;
  428. procedure numberunits;
  429. var
  430. counter : longint;
  431. hp : pused_unit;
  432. begin
  433. counter:=1;
  434. psymtable(current_module^.globalsymtable)^.unitid:=0;
  435. hp:=pused_unit(current_module^.used_units.first);
  436. while assigned(hp) do
  437. begin
  438. psymtable(hp^.u^.globalsymtable)^.unitid:=counter;
  439. inc(counter);
  440. hp:=pused_unit(hp^.next);
  441. end;
  442. end;
  443. procedure setstring(var p : pchar;const s : string);
  444. begin
  445. {$ifdef TP}
  446. if use_big then
  447. begin
  448. p:=pchar(symbolstream.getsize);
  449. symbolstream.seek(longint(p));
  450. symbolstream.writestr(@s);
  451. end
  452. else
  453. {$endif TP}
  454. p:=strpnew(s);
  455. end;
  456. procedure duplicatesym(sym:psym);
  457. begin
  458. Message1(sym_e_duplicate_id,sym^.name);
  459. with sym^.fileinfo do
  460. Message2(sym_h_duplicate_id_where,current_module^.sourcefiles^.get_file_name(fileindex),tostr(line));
  461. end;
  462. {****************************************************************************
  463. TRef
  464. ****************************************************************************}
  465. constructor tref.init(ref :pref;pos : pfileposinfo);
  466. begin
  467. nextref:=nil;
  468. if pos<>nil then
  469. posinfo:=pos^;
  470. if assigned(current_module) then
  471. moduleindex:=current_module^.unit_index;
  472. if assigned(ref) then
  473. ref^.nextref:=@self;
  474. is_written:=false;
  475. end;
  476. destructor tref.done;
  477. var
  478. inputfile : pinputfile;
  479. begin
  480. inputfile:=get_source_file(moduleindex,posinfo.fileindex);
  481. if inputfile<>nil then
  482. dec(inputfile^.ref_count);
  483. if assigned(nextref) then
  484. dispose(nextref,done);
  485. nextref:=nil;
  486. end;
  487. {****************************************************************************
  488. TDeref
  489. ****************************************************************************}
  490. constructor tderef.init(typ:tdereftype;i:word);
  491. begin
  492. dereftype:=typ;
  493. index:=i;
  494. next:=nil;
  495. end;
  496. destructor tderef.done;
  497. begin
  498. end;
  499. {*****************************************************************************
  500. PPU Reading Writing
  501. *****************************************************************************}
  502. {$I symppu.inc}
  503. {*****************************************************************************
  504. Definition Helpers
  505. *****************************************************************************}
  506. function globaldef(const s : string) : pdef;
  507. var st : string;
  508. symt : psymtable;
  509. begin
  510. srsym := nil;
  511. if pos('.',s) > 0 then
  512. begin
  513. st := copy(s,1,pos('.',s)-1);
  514. getsym(st,false);
  515. st := copy(s,pos('.',s)+1,255);
  516. if assigned(srsym) then
  517. begin
  518. if srsym^.typ = unitsym then
  519. begin
  520. symt := punitsym(srsym)^.unitsymtable;
  521. srsym := symt^.search(st);
  522. end else srsym := nil;
  523. end;
  524. end else st := s;
  525. if srsym = nil then getsym(st,false);
  526. if srsym = nil then
  527. getsymonlyin(systemunit,st);
  528. if srsym^.typ<>typesym then
  529. begin
  530. Message(type_e_type_id_expected);
  531. exit;
  532. end;
  533. globaldef := ptypesym(srsym)^.definition;
  534. end;
  535. {*****************************************************************************
  536. Symbol / Definition Resolving
  537. *****************************************************************************}
  538. procedure resolvederef(var p:pderef;var st:psymtable;var idx:word);
  539. var
  540. hp : pderef;
  541. pd : pdef;
  542. begin
  543. st:=nil;
  544. idx:=0;
  545. while assigned(p) do
  546. begin
  547. case p^.dereftype of
  548. derefaktrecordindex :
  549. begin
  550. st:=aktrecordsymtable;
  551. idx:=p^.index;
  552. end;
  553. derefaktstaticindex :
  554. begin
  555. st:=aktstaticsymtable;
  556. idx:=p^.index;
  557. end;
  558. derefunit :
  559. begin
  560. {$ifdef NEWMAP}
  561. st:=psymtable(current_module^.map^[p^.index]^.globalsymtable);
  562. {$else NEWMAP}
  563. st:=psymtable(current_module^.map^[p^.index]);
  564. {$endif NEWMAP}
  565. end;
  566. derefrecord :
  567. begin
  568. pd:=st^.getdefnr(p^.index);
  569. case pd^.deftype of
  570. recorddef :
  571. st:=precdef(pd)^.symtable;
  572. objectdef :
  573. st:=pobjectdef(pd)^.publicsyms;
  574. else
  575. internalerror(556658);
  576. end;
  577. end;
  578. dereflocal :
  579. begin
  580. pd:=st^.getdefnr(p^.index);
  581. case pd^.deftype of
  582. procdef :
  583. st:=pprocdef(pd)^.localst;
  584. else
  585. internalerror(556658);
  586. end;
  587. end;
  588. derefpara :
  589. begin
  590. pd:=st^.getdefnr(p^.index);
  591. case pd^.deftype of
  592. procdef :
  593. st:=pprocdef(pd)^.parast;
  594. else
  595. internalerror(556658);
  596. end;
  597. end;
  598. derefindex :
  599. begin
  600. idx:=p^.index;
  601. end;
  602. else
  603. internalerror(556658);
  604. end;
  605. hp:=p;
  606. p:=p^.next;
  607. dispose(hp,done);
  608. end;
  609. end;
  610. procedure resolvedef(var def:pdef);
  611. var
  612. st : psymtable;
  613. idx : word;
  614. begin
  615. resolvederef(pderef(def),st,idx);
  616. if assigned(st) then
  617. def:=st^.getdefnr(idx)
  618. else
  619. def:=nil;
  620. end;
  621. procedure resolvesym(var sym:psym);
  622. var
  623. st : psymtable;
  624. idx : word;
  625. begin
  626. resolvederef(pderef(sym),st,idx);
  627. if assigned(st) then
  628. sym:=st^.getsymnr(idx)
  629. else
  630. sym:=nil;
  631. end;
  632. {*****************************************************************************
  633. Symbol Call Back Functions
  634. *****************************************************************************}
  635. procedure derefsym(p : pnamedindexobject);
  636. begin
  637. psym(p)^.deref;
  638. end;
  639. procedure derefsymsdelayed(p : pnamedindexobject);
  640. begin
  641. if psym(p)^.typ in [absolutesym,propertysym] then
  642. psym(p)^.deref;
  643. end;
  644. procedure check_procsym_forward(sym : pnamedindexobject);
  645. begin
  646. if psym(sym)^.typ=procsym then
  647. pprocsym(sym)^.check_forward
  648. { check also object method table }
  649. { we needn't to test the def list }
  650. { because each object has to have a type sym }
  651. else
  652. if (psym(sym)^.typ=typesym) and
  653. assigned(ptypesym(sym)^.definition) and
  654. (ptypesym(sym)^.definition^.deftype=objectdef) then
  655. pobjectdef(ptypesym(sym)^.definition)^.check_forwards;
  656. end;
  657. procedure labeldefined(p : pnamedindexobject);
  658. begin
  659. if (psym(p)^.typ=labelsym) and
  660. not(plabelsym(p)^.defined) then
  661. Message1(sym_w_label_not_defined,p^.name);
  662. end;
  663. procedure unitsymbolused(p : pnamedindexobject);
  664. begin
  665. if (psym(p)^.typ=unitsym) and
  666. (punitsym(p)^.refs=0) then
  667. comment(V_info,'Unit '+p^.name+' is not used');
  668. end;
  669. procedure varsymbolused(p : pnamedindexobject);
  670. begin
  671. if (psym(p)^.typ=varsym) and
  672. ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
  673. { unused symbol should be reported only if no }
  674. { error is reported }
  675. { if the symbol is in a register it is used }
  676. { also don't count the value parameters which have local copies }
  677. { also don't claim for high param of open parameters (PM) }
  678. if (pvarsym(p)^.refs=0) and
  679. (Errorcount=0) and
  680. (copy(p^.name,1,3)<>'val') and
  681. (copy(p^.name,1,4)<>'high') then
  682. begin
  683. if (psym(p)^.owner^.symtabletype=parasymtable) or pvarsym(p)^.islocalcopy then
  684. MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_not_used,p^.name)
  685. else
  686. MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_not_used,p^.name);
  687. end;
  688. end;
  689. {$ifdef GDB}
  690. procedure concatstab(p : pnamedindexobject);
  691. begin
  692. if psym(p)^.typ <> procsym then
  693. psym(p)^.concatstabto(asmoutput);
  694. end;
  695. procedure concattypestab(p : pnamedindexobject);
  696. begin
  697. if psym(p)^.typ = typesym then
  698. begin
  699. psym(p)^.isstabwritten:=false;
  700. psym(p)^.concatstabto(asmoutput);
  701. end;
  702. end;
  703. procedure forcestabto(asmlist : paasmoutput; pd : pdef);
  704. begin
  705. if not pd^.is_def_stab_written then
  706. begin
  707. if assigned(pd^.sym) then
  708. pd^.sym^.isusedinstab := true;
  709. pd^.concatstabto(asmlist);
  710. end;
  711. end;
  712. {$endif}
  713. {$ifdef CHAINPROCSYMS}
  714. procedure chainprocsym(p : psym);
  715. var
  716. storesymtablestack : psymtable;
  717. begin
  718. if p^.typ=procsym then
  719. begin
  720. storesymtablestack:=symtablestack;
  721. symtablestack:=p^.owner^.next;
  722. while assigned(symtablestack) do
  723. begin
  724. { search for same procsym in other units }
  725. getsym(p^.name,false);
  726. if assigned(srsym) and (srsym^.typ=procsym) then
  727. begin
  728. pprocsym(p)^.nextprocsym:=pprocsym(srsym);
  729. symtablestack:=storesymtablestack;
  730. exit;
  731. end
  732. else if srsym=nil then
  733. symtablestack:=nil
  734. else
  735. symtablestack:=srsymtable^.next;
  736. end;
  737. symtablestack:=storesymtablestack;
  738. end;
  739. end;
  740. {$endif}
  741. procedure write_refs(sym : pnamedindexobject);
  742. begin
  743. psym(sym)^.write_references;
  744. end;
  745. {$ifdef BrowserLog}
  746. procedure add_to_browserlog(p : psym);
  747. begin
  748. p^.add_to_browserlog;
  749. end;
  750. {$endif UseBrowser}
  751. {****************************************************************************
  752. Forward Resolving
  753. ****************************************************************************}
  754. type
  755. presolvelist = ^tresolvelist;
  756. tresolvelist = record
  757. p : ppointerdef;
  758. typ : ptypesym;
  759. next : presolvelist;
  760. end;
  761. var
  762. sroot : presolvelist;
  763. procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
  764. var
  765. p : presolvelist;
  766. begin
  767. new(p);
  768. p^.next:=sroot;
  769. p^.p:=ppd;
  770. ppd^.defsym := typesym;
  771. p^.typ:=typesym;
  772. sroot:=p;
  773. end;
  774. procedure resolve_forwards;
  775. var
  776. p : presolvelist;
  777. begin
  778. p:=sroot;
  779. while p<>nil do
  780. begin
  781. sroot:=sroot^.next;
  782. p^.p^.definition:=p^.typ^.definition;
  783. dispose(p);
  784. p:=sroot;
  785. end;
  786. end;
  787. {*****************************************************************************
  788. Search Symtables for Syms
  789. *****************************************************************************}
  790. procedure getsym(const s : stringid;notfounderror : boolean);
  791. var
  792. speedvalue : longint;
  793. begin
  794. speedvalue:=getspeedvalue(s);
  795. lastsrsym:=nil;
  796. srsymtable:=symtablestack;
  797. while assigned(srsymtable) do
  798. begin
  799. srsym:=srsymtable^.speedsearch(s,speedvalue);
  800. if assigned(srsym) then
  801. exit
  802. else
  803. srsymtable:=srsymtable^.next;
  804. end;
  805. if forwardsallowed then
  806. begin
  807. srsymtable:=symtablestack;
  808. while (srsymtable^.symtabletype in [objectsymtable,recordsymtable]) do
  809. srsymtable:=srsymtable^.next;
  810. srsym:=new(ptypesym,init(s,nil));
  811. srsym^.properties:=sp_forwarddef;
  812. srsymtable^.insert(srsym);
  813. end
  814. else if notfounderror then
  815. begin
  816. Message1(sym_e_id_not_found,s);
  817. srsym:=generrorsym;
  818. end
  819. else srsym:=nil;
  820. end;
  821. procedure getsymonlyin(p : psymtable;const s : stringid);
  822. begin
  823. { the caller have to take care if srsym=nil (FK) }
  824. srsym:=nil;
  825. if assigned(p) then
  826. begin
  827. srsymtable:=p;
  828. srsym:=srsymtable^.search(s);
  829. if assigned(srsym) then
  830. exit
  831. else
  832. begin
  833. if (punitsymtable(srsymtable)=punitsymtable(current_module^.globalsymtable)) then
  834. begin
  835. getsymonlyin(psymtable(current_module^.localsymtable),s);
  836. if assigned(srsym) then
  837. srsymtable:=psymtable(current_module^.localsymtable)
  838. else
  839. Message1(sym_e_id_not_found,s);
  840. end
  841. else
  842. Message1(sym_e_id_not_found,s);
  843. end;
  844. end;
  845. end;
  846. function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  847. {Search for a symbol in a specified symbol table. Returns nil if
  848. the symtable is not found, and also if the symbol cannot be found
  849. in the desired symtable }
  850. var hsymtab:Psymtable;
  851. res:Psym;
  852. begin
  853. res:=nil;
  854. hsymtab:=symtablestack;
  855. while (hsymtab<>nil) and (hsymtab^.symtabletype<>symtabletype) do
  856. hsymtab:=hsymtab^.next;
  857. if hsymtab<>nil then
  858. {We found the desired symtable. Now check if the symbol we
  859. search for is defined in it }
  860. res:=hsymtab^.search(symbol);
  861. search_a_symtable:=res;
  862. end;
  863. {****************************************************************************
  864. TSYMTABLE
  865. ****************************************************************************}
  866. constructor tsymtable.init(t : tsymtabletype);
  867. begin
  868. symtabletype:=t;
  869. symtablelevel:=0;
  870. defowner:=nil;
  871. unitid:=0;
  872. next:=nil;
  873. name:=nil;
  874. address_fixup:=0;
  875. datasize:=0;
  876. new(symindex,init(indexgrowsize));
  877. new(defindex,init(indexgrowsize));
  878. if symtabletype<>withsymtable then
  879. begin
  880. new(symsearch,init);
  881. symsearch^.noclear:=true;
  882. end
  883. else
  884. symsearch:=nil;
  885. alignment:=def_alignment;
  886. end;
  887. destructor tsymtable.done;
  888. begin
  889. stringdispose(name);
  890. dispose(symindex,done);
  891. dispose(defindex,done);
  892. { symsearch can already be disposed or set to nil for withsymtable }
  893. if assigned(symsearch) then
  894. begin
  895. dispose(symsearch,done);
  896. symsearch:=nil;
  897. end;
  898. end;
  899. constructor twithsymtable.init;
  900. begin
  901. inherited init(withsymtable);
  902. direct_with:=false;
  903. withnode:=nil;
  904. withrefnode:=nil;
  905. end;
  906. destructor twithsymtable.done;
  907. begin
  908. symsearch:=nil;
  909. inherited done;
  910. end;
  911. {***********************************************
  912. Helpers
  913. ***********************************************}
  914. function tsymtable.getnewtypecount : word;
  915. begin
  916. getnewtypecount:=pglobaltypecount^;
  917. inc(pglobaltypecount^);
  918. end;
  919. procedure tsymtable.registerdef(p : pdef);
  920. begin
  921. defindex^.insert(p);
  922. { set def owner and indexnb }
  923. p^.owner:=@self;
  924. end;
  925. procedure tsymtable.foreach(proc2call : tnamedindexcallback);
  926. begin
  927. symindex^.foreach(proc2call);
  928. end;
  929. {***********************************************
  930. LOAD / WRITE SYMTABLE FROM PPU
  931. ***********************************************}
  932. procedure tsymtable.loaddefs;
  933. var
  934. hp : pdef;
  935. b : byte;
  936. begin
  937. { load start of definition section, which holds the amount of defs }
  938. if current_ppu^.readentry<>ibstartdefs then
  939. Message(unit_f_ppu_read_error);
  940. current_ppu^.getlongint;
  941. { read definitions }
  942. repeat
  943. b:=current_ppu^.readentry;
  944. case b of
  945. ibpointerdef : hp:=new(ppointerdef,load);
  946. ibarraydef : hp:=new(parraydef,load);
  947. iborddef : hp:=new(porddef,load);
  948. ibfloatdef : hp:=new(pfloatdef,load);
  949. ibprocdef : hp:=new(pprocdef,load);
  950. ibshortstringdef : hp:=new(pstringdef,shortload);
  951. iblongstringdef : hp:=new(pstringdef,longload);
  952. ibansistringdef : hp:=new(pstringdef,ansiload);
  953. ibwidestringdef : hp:=new(pstringdef,wideload);
  954. ibrecorddef : hp:=new(precdef,load);
  955. ibobjectdef : hp:=new(pobjectdef,load);
  956. ibenumdef : hp:=new(penumdef,load);
  957. ibsetdef : hp:=new(psetdef,load);
  958. ibprocvardef : hp:=new(pprocvardef,load);
  959. ibfiledef : hp:=new(pfiledef,load);
  960. ibclassrefdef : hp:=new(pclassrefdef,load);
  961. ibformaldef : hp:=new(pformaldef,load);
  962. ibenddefs : break;
  963. ibend : Message(unit_f_ppu_read_error);
  964. else
  965. Message1(unit_f_ppu_invalid_entry,tostr(b));
  966. end;
  967. hp^.owner:=@self;
  968. defindex^.insert(hp);
  969. until false;
  970. end;
  971. procedure tsymtable.loadsyms;
  972. var
  973. b : byte;
  974. sym : psym;
  975. begin
  976. { load start of definition section, which holds the amount of defs }
  977. if current_ppu^.readentry<>ibstartsyms then
  978. Message(unit_f_ppu_read_error);
  979. { skip amount of symbols, not used currently }
  980. current_ppu^.getlongint;
  981. { load datasize of this symboltable }
  982. datasize:=current_ppu^.getlongint;
  983. { now read the symbols }
  984. repeat
  985. b:=current_ppu^.readentry;
  986. case b of
  987. ibtypesym : sym:=new(ptypesym,load);
  988. ibprocsym : sym:=new(pprocsym,load);
  989. ibconstsym : sym:=new(pconstsym,load);
  990. ibvarsym : sym:=new(pvarsym,load);
  991. ibfuncretsym : sym:=new(pfuncretsym,load);
  992. ibabsolutesym : sym:=new(pabsolutesym,load);
  993. ibenumsym : sym:=new(penumsym,load);
  994. ibtypedconstsym : sym:=new(ptypedconstsym,load);
  995. ibpropertysym : sym:=new(ppropertysym,load);
  996. ibunitsym : sym:=new(punitsym,load);
  997. iblabelsym : sym:=new(plabelsym,load);
  998. ibsyssym : sym:=new(psyssym,load);
  999. ibendsyms : break;
  1000. ibend : Message(unit_f_ppu_read_error);
  1001. else
  1002. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1003. end;
  1004. sym^.owner:=@self;
  1005. symindex^.insert(sym);
  1006. symsearch^.insert(sym);
  1007. until false;
  1008. end;
  1009. procedure tsymtable.writedefs;
  1010. var
  1011. pd : pdef;
  1012. begin
  1013. { each definition get a number, write then the amount of defs to the
  1014. ibstartdef entry }
  1015. current_ppu^.putlongint(defindex^.count);
  1016. current_ppu^.writeentry(ibstartdefs);
  1017. { now write the definition }
  1018. pd:=pdef(defindex^.first);
  1019. while assigned(pd) do
  1020. begin
  1021. pd^.write;
  1022. pd:=pdef(pd^.next);
  1023. end;
  1024. { write end of definitions }
  1025. current_ppu^.writeentry(ibenddefs);
  1026. end;
  1027. procedure tsymtable.writesyms;
  1028. var
  1029. pd : psym;
  1030. begin
  1031. { each definition get a number, write then the amount of syms and the
  1032. datasize to the ibsymdef entry }
  1033. current_ppu^.putlongint(symindex^.count);
  1034. current_ppu^.putlongint(datasize);
  1035. current_ppu^.writeentry(ibstartsyms);
  1036. { foreach is used to write all symbols }
  1037. pd:=psym(symindex^.first);
  1038. while assigned(pd) do
  1039. begin
  1040. pd^.write;
  1041. pd:=psym(pd^.next);
  1042. end;
  1043. { end of symbols }
  1044. current_ppu^.writeentry(ibendsyms);
  1045. end;
  1046. procedure tsymtable.deref;
  1047. var
  1048. hp : pdef;
  1049. hs : psym;
  1050. begin
  1051. hp:=pdef(defindex^.first);
  1052. while assigned(hp) do
  1053. begin
  1054. hp^.deref;
  1055. hp^.symderef;
  1056. hp:=pdef(hp^.next);
  1057. end;
  1058. hs:=psym(symindex^.first);
  1059. while assigned(hs) do
  1060. begin
  1061. hs^.deref;
  1062. hs:=psym(hs^.next);
  1063. end;
  1064. end;
  1065. constructor tsymtable.load;
  1066. var
  1067. st_loading : boolean;
  1068. begin
  1069. st_loading:=in_loading;
  1070. in_loading:=true;
  1071. {$ifndef NEWMAP}
  1072. current_module^.map^[0]:=@self;
  1073. {$else NEWMAP}
  1074. current_module^.globalsymtable:=@self;
  1075. {$endif NEWMAP}
  1076. symtabletype:=unitsymtable;
  1077. symtablelevel:=0;
  1078. { unused for units }
  1079. address_fixup:=0;
  1080. datasize:=0;
  1081. defowner:=nil;
  1082. name:=nil;
  1083. unitid:=0;
  1084. defowner:=nil;
  1085. new(symindex,init(indexgrowsize));
  1086. new(defindex,init(indexgrowsize));
  1087. new(symsearch,init);
  1088. symsearch^.usehash;
  1089. symsearch^.noclear:=true;
  1090. alignment:=def_alignment;
  1091. { load definitions }
  1092. loaddefs;
  1093. { load symbols }
  1094. loadsyms;
  1095. { Now we can deref the symbols and definitions }
  1096. if not(symtabletype in [objectsymtable,recordsymtable]) then
  1097. deref;
  1098. {$ifdef NEWMAP}
  1099. { necessary for dependencies }
  1100. current_module^.globalsymtable:=nil;
  1101. {$endif NEWMAP}
  1102. in_loading:=st_loading;
  1103. end;
  1104. procedure tsymtable.write;
  1105. begin
  1106. { write definitions }
  1107. writedefs;
  1108. { write symbols }
  1109. writesyms;
  1110. end;
  1111. constructor tsymtable.loadas(typ : tsymtabletype);
  1112. var
  1113. storesymtable : psymtable;
  1114. st_loading : boolean;
  1115. begin
  1116. st_loading:=in_loading;
  1117. in_loading:=true;
  1118. symtabletype:=typ;
  1119. new(symindex,init(indexgrowsize));
  1120. new(defindex,init(indexgrowsize));
  1121. new(symsearch,init);
  1122. symsearch^.noclear:=true;
  1123. defowner:=nil;
  1124. storesymtable:=aktrecordsymtable;
  1125. if typ in [recordsymtable,objectsymtable,
  1126. parasymtable,localsymtable] then
  1127. aktrecordsymtable:=@self;
  1128. { used for local browser }
  1129. if typ=staticppusymtable then
  1130. begin
  1131. aktstaticsymtable:=@self;
  1132. symsearch^.usehash;
  1133. end;
  1134. name:=nil;
  1135. alignment:=def_alignment;
  1136. { isn't used there }
  1137. datasize:=0;
  1138. address_fixup:= 0;
  1139. { also unused }
  1140. unitid:=0;
  1141. { load definitions }
  1142. { we need the correct symtable for registering }
  1143. if not (typ in [recordsymtable,objectsymtable]) then
  1144. begin
  1145. next:=symtablestack;
  1146. symtablestack:=@self;
  1147. end;
  1148. { load definitions }
  1149. loaddefs;
  1150. { load symbols }
  1151. loadsyms;
  1152. { now we can deref the syms and defs }
  1153. if not (typ in [recordsymtable,objectsymtable]) then
  1154. deref;
  1155. aktrecordsymtable:=storesymtable;
  1156. if not (typ in [recordsymtable,objectsymtable]) then
  1157. begin
  1158. symtablestack:=next;
  1159. end;
  1160. in_loading:=st_loading;
  1161. end;
  1162. procedure tsymtable.writeas;
  1163. var
  1164. oldtyp : byte;
  1165. storesymtable : psymtable;
  1166. begin
  1167. oldtyp:=current_ppu^.entrytyp;
  1168. storesymtable:=aktrecordsymtable;
  1169. if symtabletype in [recordsymtable,objectsymtable,
  1170. parasymtable,localsymtable] then
  1171. aktrecordsymtable:=@self;
  1172. if (symtabletype in [recordsymtable,objectsymtable]) then
  1173. current_ppu^.entrytyp:=subentryid;
  1174. { write definitions }
  1175. writedefs;
  1176. { write symbols }
  1177. writesyms;
  1178. current_ppu^.entrytyp:=oldtyp;
  1179. aktrecordsymtable:=storesymtable;
  1180. end;
  1181. {***********************************************
  1182. Get Symbol / Def by Number
  1183. ***********************************************}
  1184. function tsymtable.getsymnr(l : longint) : psym;
  1185. var
  1186. hp : psym;
  1187. begin
  1188. hp:=psym(symindex^.search(l));
  1189. if hp=nil then
  1190. internalerror(10999);
  1191. getsymnr:=hp;
  1192. end;
  1193. function tsymtable.getdefnr(l : longint) : pdef;
  1194. var
  1195. hp : pdef;
  1196. begin
  1197. hp:=pdef(defindex^.search(l));
  1198. if hp=nil then
  1199. internalerror(10998);
  1200. getdefnr:=hp;
  1201. end;
  1202. {***********************************************
  1203. Table Access
  1204. ***********************************************}
  1205. procedure tsymtable.clear;
  1206. begin
  1207. { remove no entry from a withsymtable as it is only a pointer to the
  1208. recorddef or objectdef symtable }
  1209. if symtabletype=withsymtable then
  1210. exit;
  1211. symindex^.clear;
  1212. defindex^.clear;
  1213. end;
  1214. function tsymtable.insert(sym:psym):psym;
  1215. var
  1216. hp : psymtable;
  1217. hsym : psym;
  1218. begin
  1219. { set owner and sym indexnb }
  1220. sym^.owner:=@self;
  1221. {$ifdef CHAINPROCSYMS}
  1222. { set the nextprocsym field }
  1223. if sym^.typ=procsym then
  1224. chainprocsym(sym);
  1225. {$endif CHAINPROCSYMS}
  1226. { writes the symbol in data segment if required }
  1227. { also sets the datasize of owner }
  1228. if not in_loading then
  1229. sym^.insert_in_data;
  1230. if (symtabletype in [staticsymtable,globalsymtable]) then
  1231. begin
  1232. hp:=symtablestack;
  1233. while assigned(hp) do
  1234. begin
  1235. if hp^.symtabletype in [staticsymtable,globalsymtable] then
  1236. begin
  1237. hsym:=hp^.search(sym^.name);
  1238. if (assigned(hsym)) and
  1239. (hsym^.properties and sp_forwarddef=0) then
  1240. DuplicateSym(hsym);
  1241. end;
  1242. hp:=hp^.next;
  1243. end;
  1244. end;
  1245. { check for duplicate id in local and parsymtable symtable }
  1246. if (symtabletype=localsymtable) then
  1247. { to be on the sure side: }
  1248. begin
  1249. if assigned(next) and
  1250. (next^.symtabletype=parasymtable) then
  1251. begin
  1252. hsym:=next^.search(sym^.name);
  1253. if assigned(hsym) then
  1254. DuplicateSym(hsym);
  1255. end
  1256. else if (current_module^.flags and uf_local_browser)=0 then
  1257. internalerror(43789);
  1258. end;
  1259. { check for duplicate id in local symtable of methods }
  1260. if (symtabletype=localsymtable) and
  1261. assigned(next) and
  1262. assigned(next^.next) and
  1263. { funcretsym is allowed !! }
  1264. (sym^.typ <> funcretsym) and
  1265. (next^.next^.symtabletype=objectsymtable) then
  1266. begin
  1267. hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
  1268. { but private ids can be reused }
  1269. if assigned(hsym) and
  1270. ((hsym^.properties<>sp_private) or
  1271. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1272. DuplicateSym(hsym);
  1273. end;
  1274. { check for duplicate field id in inherited classes }
  1275. if (sym^.typ=varsym) and
  1276. (symtabletype=objectsymtable) and
  1277. assigned(defowner) then
  1278. begin
  1279. hsym:=search_class_member(pobjectdef(defowner),sym^.name);
  1280. { but private ids can be reused }
  1281. if assigned(hsym) and
  1282. ((hsym^.properties<>sp_private) or
  1283. (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
  1284. DuplicateSym(hsym);
  1285. end;
  1286. if sym^.typ = typesym then
  1287. if assigned(ptypesym(sym)^.definition) then
  1288. begin
  1289. if not assigned(ptypesym(sym)^.definition^.owner) and
  1290. (ptypesym(sym)^.definition^.deftype<>errordef) then
  1291. registerdef(ptypesym(sym)^.definition);
  1292. {$ifdef GDB}
  1293. if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist)
  1294. and (symtabletype in [globalsymtable,staticsymtable]) then
  1295. begin
  1296. ptypesym(sym)^.isusedinstab := true;
  1297. sym^.concatstabto(debuglist);
  1298. end;
  1299. {$endif GDB}
  1300. end;
  1301. { insert in index and search hash }
  1302. symindex^.insert(sym);
  1303. symsearch^.insert(sym);
  1304. insert:=sym;
  1305. end;
  1306. function tsymtable.search(const s : stringid) : psym;
  1307. begin
  1308. {search:=psym(symsearch^.search(s));
  1309. this bypasses the ref generation (PM) }
  1310. search:=speedsearch(s,getspeedvalue(s));
  1311. end;
  1312. function tsymtable.speedsearch(const s : stringid;speedvalue : longint) : psym;
  1313. var
  1314. hp : psym;
  1315. begin
  1316. hp:=psym(symsearch^.speedsearch(s,speedvalue));
  1317. if assigned(hp) then
  1318. begin
  1319. { reject non static members in static procedures,
  1320. be carefull aktprocsym^.definition is not allways
  1321. loaded already (PFV) }
  1322. if (symtabletype=objectsymtable) and
  1323. ((hp^.properties and sp_static)=0) and
  1324. allow_only_static
  1325. {assigned(aktprocsym) and
  1326. assigned(aktprocsym^.definition) and
  1327. ((aktprocsym^.definition^.options and postaticmethod)<>0)} then
  1328. Message(sym_e_only_static_in_static);
  1329. if (symtabletype=unitsymtable) and
  1330. assigned(punitsymtable(@self)^.unitsym) then
  1331. inc(punitsymtable(@self)^.unitsym^.refs);
  1332. { unitsym are only loaded for browsing PM }
  1333. { this was buggy anyway because we could use }
  1334. { unitsyms from other units in _USES !! }
  1335. if (symtabletype=unitsymtable) and (hp^.typ=unitsym) and
  1336. assigned(current_module) and (current_module^.globalsymtable<>@self) then
  1337. hp:=nil;
  1338. if assigned(hp) and
  1339. (cs_browser in aktmoduleswitches) and make_ref then
  1340. begin
  1341. hp^.lastref:=new(pref,init(hp^.lastref,@tokenpos));
  1342. { for symbols that are in tables without
  1343. browser info or syssyms (PM) }
  1344. if hp^.refcount=0 then
  1345. hp^.defref:=hp^.lastref;
  1346. inc(hp^.refcount);
  1347. end;
  1348. end;
  1349. speedsearch:=hp;
  1350. end;
  1351. function tsymtable.rename(const olds,news : stringid):psym;
  1352. begin
  1353. rename:=psym(symsearch^.rename(olds,news));
  1354. end;
  1355. {***********************************************
  1356. Browser
  1357. ***********************************************}
  1358. procedure tsymtable.load_browser;
  1359. var
  1360. b : byte;
  1361. sym : psym;
  1362. prdef : pdef;
  1363. oldrecsyms : psymtable;
  1364. begin
  1365. if symtabletype in [recordsymtable,objectsymtable,
  1366. parasymtable,localsymtable] then
  1367. begin
  1368. oldrecsyms:=aktrecordsymtable;
  1369. aktrecordsymtable:=@self;
  1370. end;
  1371. if symtabletype=staticppusymtable then
  1372. aktstaticsymtable:=@self;
  1373. b:=current_ppu^.readentry;
  1374. if b <> ibbeginsymtablebrowser then
  1375. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1376. repeat
  1377. b:=current_ppu^.readentry;
  1378. case b of
  1379. ibsymref : begin
  1380. sym:=readsymref;
  1381. resolvesym(sym);
  1382. if assigned(sym) then
  1383. sym^.load_references;
  1384. end;
  1385. ibdefref : begin
  1386. prdef:=readdefref;
  1387. resolvedef(prdef);
  1388. if assigned(prdef) then
  1389. begin
  1390. if prdef^.deftype<>procdef then
  1391. Message(unit_f_ppu_read_error);
  1392. pprocdef(prdef)^.load_references;
  1393. end;
  1394. end;
  1395. ibendsymtablebrowser : break;
  1396. else
  1397. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1398. end;
  1399. until false;
  1400. if symtabletype in [recordsymtable,objectsymtable,
  1401. parasymtable,localsymtable] then
  1402. aktrecordsymtable:=oldrecsyms;
  1403. end;
  1404. procedure tsymtable.write_browser;
  1405. var
  1406. oldrecsyms : psymtable;
  1407. begin
  1408. { symbol numbering for references
  1409. should have been done in write PM
  1410. number_symbols;
  1411. number_defs; }
  1412. if symtabletype in [recordsymtable,objectsymtable,
  1413. parasymtable,localsymtable] then
  1414. begin
  1415. oldrecsyms:=aktrecordsymtable;
  1416. aktrecordsymtable:=@self;
  1417. end;
  1418. current_ppu^.writeentry(ibbeginsymtablebrowser);
  1419. foreach({$ifndef TP}@{$endif}write_refs);
  1420. current_ppu^.writeentry(ibendsymtablebrowser);
  1421. if symtabletype in [recordsymtable,objectsymtable,
  1422. parasymtable,localsymtable] then
  1423. aktrecordsymtable:=oldrecsyms;
  1424. end;
  1425. {$ifdef BrowserLog}
  1426. procedure tsymtable.writebrowserlog;
  1427. begin
  1428. if cs_browser in aktmoduleswitches then
  1429. begin
  1430. if assigned(name) then
  1431. Browserlog.AddLog('---Symtable '+name^)
  1432. else
  1433. begin
  1434. if (symtabletype=recordsymtable) and
  1435. assigned(defowner^.sym) then
  1436. Browserlog.AddLog('---Symtable '+defowner^.sym^.name)
  1437. else
  1438. Browserlog.AddLog('---Symtable with no name');
  1439. end;
  1440. Browserlog.Ident;
  1441. foreach({$ifndef TP}@{$endif}add_to_browserlog);
  1442. browserlog.Unident;
  1443. end;
  1444. end;
  1445. {$endif BrowserLog}
  1446. {***********************************************
  1447. Process all entries
  1448. ***********************************************}
  1449. { checks, if all procsyms and methods are defined }
  1450. procedure tsymtable.check_forwards;
  1451. begin
  1452. foreach({$ifndef TP}@{$endif}check_procsym_forward);
  1453. end;
  1454. procedure tsymtable.checklabels;
  1455. begin
  1456. foreach({$ifndef TP}@{$endif}labeldefined);
  1457. end;
  1458. procedure tsymtable.set_alignment(_alignment : byte);
  1459. var
  1460. sym : pvarsym;
  1461. l : longint;
  1462. begin
  1463. { this can not be done if there is an
  1464. hasharray ! }
  1465. alignment:=_alignment;
  1466. if (symtabletype<>parasymtable) then
  1467. internalerror(1111);
  1468. sym:=pvarsym(symindex^.first);
  1469. datasize:=0;
  1470. { there can be only varsyms }
  1471. while assigned(sym) do
  1472. begin
  1473. l:=sym^.getpushsize;
  1474. sym^.address:=datasize;
  1475. datasize:=align(datasize+l,alignment);
  1476. sym:=pvarsym(sym^.next);
  1477. end;
  1478. end;
  1479. function tsymtable.find_at_offset(l : longint) : pvarsym;
  1480. var
  1481. sym : pvarsym;
  1482. begin
  1483. find_at_offset:=nil;
  1484. { this can not be done if there is an
  1485. hasharray ! }
  1486. if (symtabletype<>parasymtable) then
  1487. internalerror(1111);
  1488. sym:=pvarsym(symindex^.first);
  1489. while assigned(sym) do
  1490. begin
  1491. if sym^.address+address_fixup=l then
  1492. begin
  1493. find_at_offset:=sym;
  1494. exit;
  1495. end;
  1496. sym:=pvarsym(sym^.next);
  1497. end;
  1498. end;
  1499. procedure tsymtable.allunitsused;
  1500. begin
  1501. foreach({$ifndef TP}@{$endif}unitsymbolused);
  1502. end;
  1503. procedure tsymtable.allsymbolsused;
  1504. begin
  1505. foreach({$ifndef TP}@{$endif}varsymbolused);
  1506. end;
  1507. {$ifdef CHAINPROCSYMS}
  1508. procedure tsymtable.chainprocsyms;
  1509. begin
  1510. foreach({$ifndef TP}@{$endif}chainprocsym);
  1511. end;
  1512. {$endif CHAINPROCSYMS}
  1513. {$ifdef GDB}
  1514. procedure tsymtable.concatstabto(asmlist : paasmoutput);
  1515. begin
  1516. asmoutput:=asmlist;
  1517. foreach({$ifndef TP}@{$endif}concatstab);
  1518. end;
  1519. {$endif}
  1520. {****************************************************************************
  1521. TUNITSYMTABLE
  1522. ****************************************************************************}
  1523. constructor tunitsymtable.init(t : tsymtabletype; const n : string);
  1524. begin
  1525. inherited init(t);
  1526. name:=stringdup(upper(n));
  1527. unitid:=0;
  1528. unitsym:=nil;
  1529. symsearch^.usehash;
  1530. { reset GDB things }
  1531. {$ifdef GDB}
  1532. if t = globalsymtable then
  1533. begin
  1534. prev_dbx_counter := dbx_counter;
  1535. dbx_counter := @dbx_count;
  1536. end;
  1537. is_stab_written:=false;
  1538. if cs_gdb_dbx in aktglobalswitches then
  1539. begin
  1540. dbx_count := 0;
  1541. if (symtabletype=globalsymtable) then
  1542. pglobaltypecount := @unittypecount;
  1543. debuglist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))));
  1544. unitid:=current_module^.unitcount;
  1545. inc(current_module^.unitcount);
  1546. debuglist^.concat(new(pai_asm_comment,init(strpnew('Global '+name^+' has index '+tostr(unitid)))));
  1547. end;
  1548. {$endif GDB}
  1549. end;
  1550. constructor tunitsymtable.loadasunit;
  1551. var
  1552. storeGlobalTypeCount : pword;
  1553. b : byte;
  1554. begin
  1555. unitsym:=nil;
  1556. unitid:=0;
  1557. if (current_module^.flags and uf_has_dbx)<>0 then
  1558. begin
  1559. storeGlobalTypeCount:=PGlobalTypeCount;
  1560. PglobalTypeCount:=@UnitTypeCount;
  1561. end;
  1562. { load symtables }
  1563. inherited load;
  1564. { set the name after because it is set to nil in tsymtable.load !! }
  1565. name:=stringdup(current_module^.modulename^);
  1566. { dbx count }
  1567. {$ifdef GDB}
  1568. if (current_module^.flags and uf_has_dbx)<>0 then
  1569. begin
  1570. b := current_ppu^.readentry;
  1571. if b <> ibdbxcount then
  1572. Message(unit_f_ppu_dbx_count_problem)
  1573. else
  1574. dbx_count := readlong;
  1575. dbx_count_ok := true;
  1576. PGlobalTypeCount:=storeGlobalTypeCount;
  1577. end
  1578. else
  1579. dbx_count := 0;
  1580. is_stab_written:=false;
  1581. {$endif GDB}
  1582. b:=current_ppu^.readentry;
  1583. if b<>ibendimplementation then
  1584. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1585. end;
  1586. destructor tunitsymtable.done;
  1587. var
  1588. pus : punitsym;
  1589. begin
  1590. pus:=unitsym;
  1591. while assigned(pus) do
  1592. begin
  1593. unitsym:=pus^.prevsym;
  1594. pus^.prevsym:=nil;
  1595. pus^.unitsymtable:=nil;
  1596. pus:=unitsym;
  1597. end;
  1598. inherited done;
  1599. end;
  1600. procedure tunitsymtable.load_symtable_refs;
  1601. var
  1602. b : byte;
  1603. unitindex : word;
  1604. begin
  1605. if ((current_module^.flags and uf_local_browser)<>0) then
  1606. begin
  1607. current_module^.localsymtable:=new(punitsymtable,loadas(staticppusymtable));
  1608. psymtable(current_module^.localsymtable)^.name:=
  1609. stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
  1610. end;
  1611. { load browser }
  1612. if (current_module^.flags and uf_has_browser)<>0 then
  1613. begin
  1614. {if not (cs_browser in aktmoduleswitches) then
  1615. current_ppu^.skipuntilentry(ibendbrowser)
  1616. else }
  1617. begin
  1618. load_browser;
  1619. unitindex:=1;
  1620. while assigned(current_module^.map^[unitindex]) do
  1621. begin
  1622. {each unit wrote one browser entry }
  1623. load_browser;
  1624. inc(unitindex);
  1625. end;
  1626. b:=current_ppu^.readentry;
  1627. if b<>ibendbrowser then
  1628. Message1(unit_f_ppu_invalid_entry,tostr(b));
  1629. end;
  1630. end;
  1631. if ((current_module^.flags and uf_local_browser)<>0) then
  1632. psymtable(current_module^.localsymtable)^.load_browser;
  1633. end;
  1634. procedure tunitsymtable.writeasunit;
  1635. var
  1636. pu : pused_unit;
  1637. begin
  1638. { first the unitname }
  1639. current_ppu^.putstring(name^);
  1640. current_ppu^.writeentry(ibmodulename);
  1641. writesourcefiles;
  1642. writeusedunit;
  1643. { write the objectfiles and libraries that come for this unit,
  1644. preserve the containers becuase they are still needed to load
  1645. the link.res. All doesn't depend on the crc! It doesn't matter
  1646. if a unit is in a .o or .a file }
  1647. current_ppu^.do_crc:=false;
  1648. writecontainer(current_module^.linkunitfiles,iblinkunitfiles,true,true);
  1649. writecontainer(current_module^.linkofiles,iblinkofiles,true,false);
  1650. writecontainer(current_module^.linksharedlibs,iblinksharedlibs,true,true);
  1651. writecontainer(current_module^.linkstaticlibs,iblinkstaticlibs,true,true);
  1652. current_ppu^.do_crc:=true;
  1653. current_ppu^.writeentry(ibendinterface);
  1654. { write the symtable entries }
  1655. inherited write;
  1656. { write dbx count }
  1657. {$ifdef GDB}
  1658. if cs_gdb_dbx in aktglobalswitches then
  1659. begin
  1660. {$IfDef EXTDEBUG}
  1661. writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  1662. {$ENDIF EXTDEBUG}
  1663. current_ppu^.putlongint(dbx_count);
  1664. current_ppu^.writeentry(ibdbxcount);
  1665. end;
  1666. {$endif GDB}
  1667. current_ppu^.writeentry(ibendimplementation);
  1668. { write static symtable
  1669. needed for local debugging of unit functions }
  1670. if (current_module^.flags and uf_local_browser)<>0 then
  1671. psymtable(current_module^.localsymtable)^.write;
  1672. { write all browser section }
  1673. if (current_module^.flags and uf_has_browser)<>0 then
  1674. begin
  1675. current_ppu^.do_crc:=false; { doesn't affect crc }
  1676. write_browser;
  1677. pu:=pused_unit(current_module^.used_units.first);
  1678. while assigned(pu) do
  1679. begin
  1680. psymtable(pu^.u^.globalsymtable)^.write_browser;
  1681. pu:=pused_unit(pu^.next);
  1682. end;
  1683. current_ppu^.writeentry(ibendbrowser);
  1684. current_ppu^.do_crc:=true;
  1685. end;
  1686. if (current_module^.flags and uf_local_browser)<>0 then
  1687. psymtable(current_module^.localsymtable)^.write_browser;
  1688. { the last entry ibend is written automaticly }
  1689. end;
  1690. function tunitsymtable.getnewtypecount : word;
  1691. begin
  1692. {$ifdef GDB}
  1693. if not (cs_gdb_dbx in aktglobalswitches) then
  1694. getnewtypecount:=tsymtable.getnewtypecount
  1695. else
  1696. {$endif GDB}
  1697. if symtabletype = staticsymtable then
  1698. getnewtypecount:=tsymtable.getnewtypecount
  1699. else
  1700. begin
  1701. getnewtypecount:=unittypecount;
  1702. inc(unittypecount);
  1703. end;
  1704. end;
  1705. {$ifdef GDB}
  1706. procedure tunitsymtable.concattypestabto(asmlist : paasmoutput);
  1707. var prev_dbx_count : plongint;
  1708. begin
  1709. if is_stab_written then exit;
  1710. if not assigned(name) then name := stringdup('Main_program');
  1711. if symtabletype = unitsymtable then
  1712. begin
  1713. unitid:=current_module^.unitcount;
  1714. inc(current_module^.unitcount);
  1715. end;
  1716. asmlist^.concat(new(pai_asm_comment,init(strpnew('Begin unit '+name^
  1717. +' has index '+tostr(unitid)))));
  1718. if cs_gdb_dbx in aktglobalswitches then
  1719. begin
  1720. if dbx_count_ok then
  1721. begin
  1722. asmlist^.insert(new(pai_asm_comment,init(strpnew('"repeated" unit '+name^
  1723. +' has index '+tostr(unitid)))));
  1724. do_count_dbx:=true;
  1725. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1726. +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))));
  1727. exit;
  1728. end;
  1729. prev_dbx_count := dbx_counter;
  1730. dbx_counter := nil;
  1731. if symtabletype = unitsymtable then
  1732. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1733. +tostr(N_BINCL)+',0,0,0'))));
  1734. dbx_counter := @dbx_count;
  1735. end;
  1736. asmoutput:=asmlist;
  1737. foreach({$ifndef TP}@{$endif}concattypestab);
  1738. if cs_gdb_dbx in aktglobalswitches then
  1739. begin
  1740. dbx_counter := prev_dbx_count;
  1741. do_count_dbx:=true;
  1742. asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1743. +tostr(N_EINCL)+',0,0,0'))));
  1744. dbx_count_ok := true;
  1745. end;
  1746. asmlist^.concat(new(pai_asm_comment,init(strpnew('End unit '+name^
  1747. +' has index '+tostr(unitid)))));
  1748. is_stab_written:=true;
  1749. end;
  1750. {$endif}
  1751. {****************************************************************************
  1752. Definitions
  1753. ****************************************************************************}
  1754. {$I symdef.inc}
  1755. {****************************************************************************
  1756. Symbols
  1757. ****************************************************************************}
  1758. {$I symsym.inc}
  1759. {****************************************************************************
  1760. GDB Helpers
  1761. ****************************************************************************}
  1762. {$ifdef GDB}
  1763. function typeglobalnumber(const s : string) : string;
  1764. var st : string;
  1765. symt : psymtable;
  1766. old_make_ref : boolean;
  1767. begin
  1768. old_make_ref:=make_ref;
  1769. make_ref:=false;
  1770. typeglobalnumber := '0';
  1771. srsym := nil;
  1772. if pos('.',s) > 0 then
  1773. begin
  1774. st := copy(s,1,pos('.',s)-1);
  1775. getsym(st,false);
  1776. st := copy(s,pos('.',s)+1,255);
  1777. if assigned(srsym) then
  1778. begin
  1779. if srsym^.typ = unitsym then
  1780. begin
  1781. symt := punitsym(srsym)^.unitsymtable;
  1782. srsym := symt^.search(st);
  1783. end else srsym := nil;
  1784. end;
  1785. end else st := s;
  1786. if srsym = nil then getsym(st,true);
  1787. if srsym^.typ<>typesym then
  1788. begin
  1789. Message(type_e_type_id_expected);
  1790. exit;
  1791. end;
  1792. typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
  1793. make_ref:=old_make_ref;
  1794. end;
  1795. {$endif GDB}
  1796. {****************************************************************************
  1797. Definition Helpers
  1798. ****************************************************************************}
  1799. procedure reset_global_defs;
  1800. var
  1801. def : pdef;
  1802. {$ifdef debug}
  1803. prevdef : pdef;
  1804. {$endif debug}
  1805. begin
  1806. {$ifdef debug}
  1807. prevdef:=nil;
  1808. {$endif debug}
  1809. {$ifdef GDB}
  1810. pglobaltypecount:=@globaltypecount;
  1811. {$endif GDB}
  1812. def:=firstglobaldef;
  1813. while assigned(def) do
  1814. begin
  1815. {$ifdef GDB}
  1816. if assigned(def^.sym) then
  1817. def^.sym^.isusedinstab:=false;
  1818. def^.is_def_stab_written:=false;
  1819. {$endif GDB}
  1820. {if not current_module^.in_implementation then}
  1821. begin
  1822. { reset rangenr's }
  1823. case def^.deftype of
  1824. orddef : porddef(def)^.rangenr:=0;
  1825. enumdef : penumdef(def)^.rangenr:=0;
  1826. arraydef : parraydef(def)^.rangenr:=0;
  1827. end;
  1828. if def^.deftype<>objectdef then
  1829. def^.has_rtti:=false;
  1830. def^.has_inittable:=false;
  1831. end;
  1832. {$ifdef debug}
  1833. prevdef:=def;
  1834. {$endif debug}
  1835. def:=def^.nextglobal;
  1836. end;
  1837. end;
  1838. {****************************************************************************
  1839. Object Helpers
  1840. ****************************************************************************}
  1841. function search_class_member(pd : pobjectdef;const n : string) : psym;
  1842. { searches n in symtable of pd and all anchestors }
  1843. var
  1844. sym : psym;
  1845. begin
  1846. sym:=nil;
  1847. while assigned(pd) do
  1848. begin
  1849. sym:=pd^.publicsyms^.search(n);
  1850. if assigned(sym) then
  1851. break;
  1852. pd:=pd^.childof;
  1853. end;
  1854. { this is needed for static methods in do_member_read pexpr unit PM
  1855. caused bug0214 }
  1856. if assigned(sym) then
  1857. begin
  1858. srsymtable:=pd^.publicsyms;
  1859. end;
  1860. search_class_member:=sym;
  1861. end;
  1862. var
  1863. _defaultprop : ppropertysym;
  1864. procedure testfordefaultproperty(p : pnamedindexobject);
  1865. begin
  1866. if (psym(p)^.typ=propertysym) and ((ppropertysym(p)^.options and ppo_defaultproperty)<>0) then
  1867. _defaultprop:=ppropertysym(p);
  1868. end;
  1869. function search_default_property(pd : pobjectdef) : ppropertysym;
  1870. { returns the default property of a class, searches also anchestors }
  1871. begin
  1872. _defaultprop:=nil;
  1873. while assigned(pd) do
  1874. begin
  1875. pd^.publicsyms^.foreach({$ifndef TP}@{$endif}testfordefaultproperty);
  1876. if assigned(_defaultprop) then
  1877. break;
  1878. pd:=pd^.childof;
  1879. end;
  1880. search_default_property:=_defaultprop;
  1881. end;
  1882. {****************************************************************************
  1883. Macro's
  1884. ****************************************************************************}
  1885. procedure def_macro(const s : string);
  1886. var
  1887. mac : pmacrosym;
  1888. begin
  1889. mac:=pmacrosym(macros^.search(s));
  1890. if mac=nil then
  1891. begin
  1892. mac:=new(pmacrosym,init(s));
  1893. Message1(parser_m_macro_defined,mac^.name);
  1894. macros^.insert(mac);
  1895. end;
  1896. mac^.defined:=true;
  1897. end;
  1898. procedure set_macro(const s : string;value : string);
  1899. var
  1900. mac : pmacrosym;
  1901. begin
  1902. mac:=pmacrosym(macros^.search(s));
  1903. if mac=nil then
  1904. begin
  1905. mac:=new(pmacrosym,init(s));
  1906. macros^.insert(mac);
  1907. end
  1908. else
  1909. begin
  1910. if assigned(mac^.buftext) then
  1911. freemem(mac^.buftext,mac^.buflen);
  1912. end;
  1913. Message2(parser_m_macro_set_to,mac^.name,value);
  1914. mac^.buflen:=length(value);
  1915. getmem(mac^.buftext,mac^.buflen);
  1916. move(value[1],mac^.buftext^,mac^.buflen);
  1917. mac^.defined:=true;
  1918. end;
  1919. {****************************************************************************
  1920. Symtable Stack
  1921. ****************************************************************************}
  1922. procedure dellexlevel;
  1923. var
  1924. p : psymtable;
  1925. begin
  1926. p:=symtablestack;
  1927. symtablestack:=p^.next;
  1928. { symbol tables of unit interfaces are never disposed }
  1929. { this is handle by the unit unitm }
  1930. if not(p^.symtabletype in [unitsymtable,globalsymtable,stt_exceptsymtable]) or dispose_global then
  1931. dispose(p,done);
  1932. end;
  1933. {$ifdef DEBUG}
  1934. procedure test_symtablestack;
  1935. var
  1936. p : psymtable;
  1937. i : longint;
  1938. begin
  1939. p:=symtablestack;
  1940. i:=0;
  1941. while assigned(p) do
  1942. begin
  1943. inc(i);
  1944. p:=p^.next;
  1945. if i>500 then
  1946. Message(sym_f_internal_error_in_symtablestack);
  1947. end;
  1948. end;
  1949. procedure list_symtablestack;
  1950. var
  1951. p : psymtable;
  1952. i : longint;
  1953. begin
  1954. p:=symtablestack;
  1955. i:=0;
  1956. while assigned(p) do
  1957. begin
  1958. inc(i);
  1959. writeln(i,' ',p^.name^);
  1960. p:=p^.next;
  1961. if i>500 then
  1962. Message(sym_f_internal_error_in_symtablestack);
  1963. end;
  1964. end;
  1965. {$endif DEBUG}
  1966. {****************************************************************************
  1967. Init/Done Symtable
  1968. ****************************************************************************}
  1969. {$ifdef tp}
  1970. procedure do_streamerror;
  1971. begin
  1972. if symbolstream.status=-2 then
  1973. WriteLn('Error: Not enough EMS memory')
  1974. else
  1975. WriteLn('Error: EMS Error ',symbolstream.status);
  1976. halt(1);
  1977. end;
  1978. {$endif TP}
  1979. procedure InitSymtable;
  1980. begin
  1981. {$ifdef TP}
  1982. { Allocate stream }
  1983. if use_big then
  1984. begin
  1985. streamerror:=@do_streamerror;
  1986. { symbolstream.init('TMPFILE',stcreate,16000); }
  1987. {$ifndef dpmi}
  1988. symbolstream.init(10000,4000000); {using ems streams}
  1989. {$else}
  1990. symbolstream.init(1000000,16000); {using memory streams}
  1991. {$endif}
  1992. if symbolstream.errorinfo=stiniterror then
  1993. do_streamerror;
  1994. { write something, because pos 0 means nil pointer }
  1995. symbolstream.writestr(@inputfile);
  1996. end;
  1997. {$endif tp}
  1998. { Reset symbolstack }
  1999. registerdef:=false;
  2000. read_member:=false;
  2001. symtablestack:=nil;
  2002. systemunit:=nil;
  2003. objpasunit:=nil;
  2004. sroot:=nil;
  2005. {$ifdef GDB}
  2006. firstglobaldef:=nil;
  2007. lastglobaldef:=nil;
  2008. {$endif GDB}
  2009. globaltypecount:=1;
  2010. pglobaltypecount:=@globaltypecount;
  2011. { create error syms and def }
  2012. generrorsym:=new(perrorsym,init);
  2013. generrordef:=new(perrordef,init);
  2014. end;
  2015. procedure DoneSymtable;
  2016. begin
  2017. dispose(generrorsym,done);
  2018. dispose(generrordef,done);
  2019. { unload all symtables
  2020. done with loaded_units
  2021. dispose_global:=true;
  2022. while assigned(symtablestack) do
  2023. dellexlevel; }
  2024. {$ifdef TP}
  2025. { close the stream }
  2026. if use_big then
  2027. symbolstream.done;
  2028. {$endif}
  2029. end;
  2030. end.
  2031. {
  2032. $Log$
  2033. Revision 1.23 1999-06-28 17:02:44 pierre
  2034. merged from v0-99-12 branch
  2035. Revision 1.21.2.2 1999/06/28 16:59:55 pierre
  2036. * fix to get method reference info
  2037. Revision 1.21.2.1 1999/06/22 16:26:46 pierre
  2038. * local browser stuff corrected
  2039. Revision 1.21 1999/06/08 22:23:50 pierre
  2040. * staticppusymtable was loaded a tsymtable instead of tunitsymtable
  2041. Revision 1.20 1999/06/02 22:44:23 pierre
  2042. * previous wrong log corrected
  2043. Revision 1.19 1999/06/02 22:25:53 pierre
  2044. * changed $ifdef FPC @ into $ifndef TP
  2045. Revision 1.18 1999/06/01 14:45:58 peter
  2046. * @procvar is now always needed for FPC
  2047. Revision 1.17 1999/05/27 19:45:08 peter
  2048. * removed oldasm
  2049. * plabel -> pasmlabel
  2050. * -a switches to source writing automaticly
  2051. * assembler readers OOPed
  2052. * asmsymbol automaticly external
  2053. * jumptables and other label fixes for asm readers
  2054. Revision 1.16 1999/05/23 18:42:16 florian
  2055. * better error recovering in typed constants
  2056. * some problems with arrays of const fixed, some problems
  2057. due my previous
  2058. - the location type of array constructor is now LOC_MEM
  2059. - the pushing of high fixed
  2060. - parameter copying fixed
  2061. - zero temp. allocation removed
  2062. * small problem in the assembler writers fixed:
  2063. ref to nil wasn't written correctly
  2064. Revision 1.15 1999/05/17 23:51:41 peter
  2065. * with temp vars now use a reference with a persistant temp instead
  2066. of setting datasize
  2067. Revision 1.14 1999/05/14 17:52:29 peter
  2068. * new deref code
  2069. Revision 1.13 1999/05/13 21:59:48 peter
  2070. * removed oldppu code
  2071. * warning if objpas is loaded from uses
  2072. * first things for new deref writing
  2073. Revision 1.12 1999/05/10 22:34:59 pierre
  2074. * one more unitsym problem fix
  2075. Revision 1.11 1999/05/10 15:02:51 pierre
  2076. unitsym finally problem fixed
  2077. Revision 1.10 1999/05/09 12:46:26 peter
  2078. + hint where a duplicate sym is already defined
  2079. Revision 1.9 1999/05/08 19:52:40 peter
  2080. + MessagePos() which is enhanced Message() function but also gets the
  2081. position info
  2082. * Removed comp warnings
  2083. Revision 1.8 1999/05/06 21:38:38 peter
  2084. * don't register errordef
  2085. Revision 1.7 1999/05/06 09:05:31 peter
  2086. * generic write_float and str_float
  2087. * fixed constant float conversions
  2088. Revision 1.6 1999/05/05 09:19:16 florian
  2089. * more fixes to get it with delphi running
  2090. Revision 1.5 1999/05/01 13:24:43 peter
  2091. * merged nasm compiler
  2092. * old asm moved to oldasm/
  2093. Revision 1.4 1999/04/29 17:25:37 peter
  2094. * small fix for deref
  2095. Revision 1.3 1999/04/26 18:30:03 peter
  2096. * farpointerdef moved into pointerdef.is_far
  2097. Revision 1.151 1999/04/26 13:31:54 peter
  2098. * release storenumber,double_checksum
  2099. Revision 1.150 1999/04/25 17:36:13 peter
  2100. * typo fix for storenumber
  2101. Revision 1.149 1999/04/21 22:05:28 pierre
  2102. + tsymtable.find_at_offset function
  2103. used by ra386att to give arg name from ebp offset with -vz option
  2104. Revision 1.148 1999/04/21 16:31:44 pierre
  2105. ra386att.pas : commit problem !
  2106. Revision 1.147 1999/04/21 09:43:57 peter
  2107. * storenumber works
  2108. * fixed some typos in double_checksum
  2109. + incompatible types type1 and type2 message (with storenumber)
  2110. Revision 1.146 1999/04/19 09:33:14 pierre
  2111. + added tsymtable.set_alignment(longint) function
  2112. to change the offsets of all function args
  2113. if declared as cdecl or stdcall
  2114. (this must be done after because the cdecl is parsed after
  2115. insertion of the function parameterss into parast symboltable)
  2116. Revision 1.145 1999/04/17 13:16:24 peter
  2117. * fixes for storenumber
  2118. Revision 1.144 1999/04/15 10:01:45 peter
  2119. * small update for storenumber
  2120. Revision 1.143 1999/04/14 09:15:04 peter
  2121. * first things to store the symbol/def number in the ppu
  2122. Revision 1.142 1999/04/08 14:54:10 pierre
  2123. * suppression of val para unused warnings
  2124. Revision 1.141 1999/04/07 15:31:09 pierre
  2125. * all formaldefs are now a sinlge definition
  2126. cformaldef (this was necessary for double_checksum)
  2127. + small part of double_checksum code
  2128. Revision 1.140 1999/03/31 13:55:24 peter
  2129. * assembler inlining working for ag386bin
  2130. Revision 1.139 1999/03/24 23:17:30 peter
  2131. * fixed bugs 212,222,225,227,229,231,233
  2132. Revision 1.138 1999/03/21 22:49:11 florian
  2133. * private ids of objects can be reused in child classes
  2134. if they are in another unit
  2135. Revision 1.137 1999/03/17 22:23:20 florian
  2136. * a FPC compiled compiler checks now also in debug mode in assigned
  2137. if a pointer points to the heap
  2138. * when a symtable is loaded, there is no need to check for duplicate
  2139. symbols. This leads to crashes because defowner isn't assigned
  2140. in this case
  2141. Revision 1.136 1999/03/01 13:45:07 pierre
  2142. + added staticppusymtable symtable type for local browsing
  2143. Revision 1.135 1999/02/23 18:29:28 pierre
  2144. * win32 compilation error fix
  2145. + some work for local browser (not cl=omplete yet)
  2146. Revision 1.134 1999/02/22 15:09:42 florian
  2147. * behaviaor of PROTECTED and PRIVATE fixed, works now like TP/Delphi
  2148. Revision 1.133 1999/02/22 13:07:12 pierre
  2149. + -b and -bl options work !
  2150. + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
  2151. is not enabled when quitting global section
  2152. * local vars and procedures are not yet stored into PPU
  2153. Revision 1.132 1999/02/22 02:15:40 peter
  2154. * updates for ag386bin
  2155. Revision 1.131 1999/02/16 00:44:34 peter
  2156. * tp7 fix, assigned() can only be used on vars, not on functions
  2157. Revision 1.130 1999/02/15 13:13:16 pierre
  2158. * fix for bug0216
  2159. Revision 1.129 1999/02/11 09:46:29 pierre
  2160. * fix for normal method calls inside static methods :
  2161. WARNING there were both parser and codegen errors !!
  2162. added static_call boolean to calln tree
  2163. Revision 1.128 1999/02/09 23:03:05 florian
  2164. * check for duplicate field names in inherited classes/objects
  2165. * bug with self from the mailing list solved (the problem
  2166. was that classes were sometimes pushed wrong)
  2167. Revision 1.127 1999/02/08 11:29:06 pierre
  2168. * fix for bug0214
  2169. several problems where combined
  2170. search_class_member did not set srsymtable
  2171. => in do_member_read the call node got a wrong symtable
  2172. in cg386cal the vmt was pushed twice without chacking if it exists
  2173. now %esi is set to zero and pushed if not vmt
  2174. (not very efficient but should work !)
  2175. Revision 1.126 1999/02/05 08:54:31 pierre
  2176. + linkofiles splitted inot linkofiles and linkunitfiles
  2177. because linkofiles must be stored with directory
  2178. to enabled linking of different objects with same name
  2179. in a different directory
  2180. Revision 1.125 1999/02/03 09:44:33 pierre
  2181. * symbol nubering begins with 1 in number_symbols
  2182. * program tmodule has globalsymtable for its staticsymtable
  2183. (to get it displayed in IDE globals list)
  2184. + list of symbol (browcol) greatly improved for IDE
  2185. Revision 1.124 1999/01/27 12:58:33 pierre
  2186. * unused var warning suppressed for high of open arrays
  2187. Revision 1.123 1999/01/21 16:41:03 pierre
  2188. * fix for constructor inside with statements
  2189. Revision 1.122 1999/01/20 10:16:44 peter
  2190. * don't update crc when writing objs,libs and sources
  2191. Revision 1.121 1999/01/14 21:50:00 peter
  2192. * fixed forwardpointer problem with multiple forwards for the same
  2193. typesym. It now uses a linkedlist instead of a single pointer
  2194. Revision 1.120 1999/01/13 14:29:22 daniel
  2195. * nonextfield repaired
  2196. Revision 1.119 1999/01/12 14:25:38 peter
  2197. + BrowserLog for browser.log generation
  2198. + BrowserCol for browser info in TCollections
  2199. * released all other UseBrowser
  2200. Revision 1.118 1999/01/05 08:20:10 florian
  2201. * mainly problem with invalid case ranges fixed (reported by Jonas)
  2202. Revision 1.117 1998/12/30 22:15:57 peter
  2203. + farpointer type
  2204. * absolutesym now also stores if its far
  2205. Revision 1.116 1998/12/30 13:41:16 peter
  2206. * released valuepara
  2207. Revision 1.115 1998/12/11 00:03:48 peter
  2208. + globtype,tokens,version unit splitted from globals
  2209. Revision 1.114 1998/12/10 09:47:29 florian
  2210. + basic operations with int64/qord (compiler with -dint64)
  2211. + rtti of enumerations extended: names are now written
  2212. Revision 1.113 1998/12/08 10:18:17 peter
  2213. + -gh for heaptrc unit
  2214. Revision 1.112 1998/12/04 10:18:10 florian
  2215. * some stuff for procedures of object added
  2216. * bug with overridden virtual constructors fixed (reported by Italo Gomes)
  2217. Revision 1.111 1998/11/30 16:34:46 pierre
  2218. * corrected problems with rangecheck
  2219. + added needed code for no rangecheck in CRC32 functions in ppu unit
  2220. * enumdef lso need its rangenr reset to zero
  2221. when calling reset_global_defs
  2222. Revision 1.110 1998/11/28 16:20:58 peter
  2223. + support for dll variables
  2224. Revision 1.109 1998/11/27 14:50:49 peter
  2225. + open strings, $P switch support
  2226. Revision 1.108 1998/11/24 23:00:32 peter
  2227. * small crash prevention
  2228. Revision 1.107 1998/11/20 15:36:01 florian
  2229. * problems with rtti fixed, hope it works
  2230. Revision 1.106 1998/11/18 15:44:20 peter
  2231. * VALUEPARA for tp7 compatible value parameters
  2232. Revision 1.105 1998/11/17 10:39:18 peter
  2233. * has_rtti,has_inittable reset
  2234. Revision 1.104 1998/11/16 10:13:52 peter
  2235. * label defines are checked at the end of the proc
  2236. Revision 1.103 1998/11/13 15:40:32 pierre
  2237. + added -Se in Makefile cvstest target
  2238. + lexlevel cleanup
  2239. normal_function_level main_program_level and unit_init_level defined
  2240. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  2241. (test added in code !)
  2242. * -Un option was wrong
  2243. * _FAIL and _SELF only keyword inside
  2244. constructors and methods respectively
  2245. Revision 1.102 1998/11/12 16:43:34 florian
  2246. * functions with ansi strings as result didn't work, solved
  2247. Revision 1.101 1998/11/12 12:55:18 pierre
  2248. * fix for bug0176 and bug0177
  2249. Revision 1.100 1998/11/10 10:09:15 peter
  2250. * va_list -> array of const
  2251. Revision 1.99 1998/11/09 11:44:38 peter
  2252. + va_list for printf support
  2253. Revision 1.98 1998/11/05 23:33:35 peter
  2254. * symtable.done sets vars to nil
  2255. Revision 1.97 1998/11/05 12:03:00 peter
  2256. * released useansistring
  2257. * removed -Sv, its now available in fpc modes
  2258. Revision 1.96 1998/10/28 18:26:19 pierre
  2259. * removed some erros after other errors (introduced by useexcept)
  2260. * stabs works again correctly (for how long !)
  2261. Revision 1.95 1998/10/21 08:40:01 florian
  2262. + ansistring operator +
  2263. + $h and string[n] for n>255 added
  2264. * small problem with TP fixed
  2265. Revision 1.94 1998/10/20 08:07:03 pierre
  2266. * several memory corruptions due to double freemem solved
  2267. => never use p^.loc.location:=p^.left^.loc.location;
  2268. + finally I added now by default
  2269. that ra386dir translates global and unit symbols
  2270. + added a first field in tsymtable and
  2271. a nextsym field in tsym
  2272. (this allows to obtain ordered type info for
  2273. records and objects in gdb !)
  2274. Revision 1.93 1998/10/19 08:55:08 pierre
  2275. * wrong stabs info corrected once again !!
  2276. + variable vmt offset with vmt field only if required
  2277. implemented now !!!
  2278. Revision 1.92 1998/10/16 13:12:56 pierre
  2279. * added vmt_offsets in destructors code also !!!
  2280. * vmt_offset code for m68k
  2281. Revision 1.91 1998/10/16 08:48:38 peter
  2282. * fixed some misplaced $endif GDB
  2283. Revision 1.90 1998/10/15 15:13:32 pierre
  2284. + added oo_hasconstructor and oo_hasdestructor
  2285. for objects options
  2286. Revision 1.89 1998/10/14 13:38:25 peter
  2287. * fixed path with staticlib/objects in ppufiles
  2288. Revision 1.88 1998/10/09 16:36:07 pierre
  2289. * some memory leaks specific to usebrowser define fixed
  2290. * removed tmodule.implsymtable (was like tmodule.localsymtable)
  2291. Revision 1.87 1998/10/09 11:47:57 pierre
  2292. * still more memory leaks fixes !!
  2293. Revision 1.86 1998/10/08 17:17:35 pierre
  2294. * current_module old scanner tagged as invalid if unit is recompiled
  2295. + added ppheap for better info on tracegetmem of heaptrc
  2296. (adds line column and file index)
  2297. * several memory leaks removed ith help of heaptrc !!
  2298. Revision 1.85 1998/10/08 13:48:51 peter
  2299. * fixed memory leaks for do nothing source
  2300. * fixed unit interdependency
  2301. Revision 1.84 1998/10/06 17:16:58 pierre
  2302. * some memory leaks fixed (thanks to Peter for heaptrc !)
  2303. Revision 1.83 1998/09/26 17:45:45 peter
  2304. + idtoken and only one token table
  2305. Revision 1.82 1998/09/25 09:52:57 peter
  2306. + store also datasize and # of symbols in ppu
  2307. * # of defs is now also stored in structs
  2308. Revision 1.81 1998/09/24 23:49:21 peter
  2309. + aktmodeswitches
  2310. Revision 1.80 1998/09/23 12:20:51 pierre
  2311. * main program tmodule had no symtable (crashed browser)
  2312. * unit symbols problem fixed !!
  2313. Revision 1.79 1998/09/23 12:03:57 peter
  2314. * overloading fix for array of const
  2315. Revision 1.78 1998/09/22 17:13:54 pierre
  2316. + browsing updated and developed
  2317. records and objects fields are also stored
  2318. Revision 1.77 1998/09/22 15:37:24 peter
  2319. + array of const start
  2320. Revision 1.76 1998/09/21 10:00:08 peter
  2321. * store number of defs in ppu file
  2322. Revision 1.75 1998/09/21 08:58:31 peter
  2323. + speedsearch, which also needs speedvalue as parameter
  2324. Revision 1.74 1998/09/21 08:45:25 pierre
  2325. + added vmt_offset in tobjectdef.write for fututre use
  2326. (first steps to have objects without vmt if no virtual !!)
  2327. + added fpu_used field for tabstractprocdef :
  2328. sets this level to 2 if the functions return with value in FPU
  2329. (is then set to correct value at parsing of implementation)
  2330. THIS MIGHT refuse some code with FPU expression too complex
  2331. that were accepted before and even in some cases
  2332. that don't overflow in fact
  2333. ( like if f : float; is a forward that finally in implementation
  2334. only uses one fpu register !!)
  2335. Nevertheless I think that it will improve security on
  2336. FPU operations !!
  2337. * most other changes only for UseBrowser code
  2338. (added symtable references for record and objects)
  2339. local switch for refs to args and local of each function
  2340. (static symtable still missing)
  2341. UseBrowser still not stable and probably broken by
  2342. the definition hash array !!
  2343. Revision 1.73 1998/09/20 09:38:47 florian
  2344. * hasharray for defs fixed
  2345. * ansistring code generation corrected (init/final, assignement)
  2346. Revision 1.72 1998/09/19 22:56:18 florian
  2347. + hash table for getdefnr added
  2348. Revision 1.71 1998/09/18 08:01:40 pierre
  2349. + improvement on the usebrowser part
  2350. (does not work correctly for now)
  2351. Revision 1.70 1998/09/09 11:50:57 pierre
  2352. * forward def are not put in record or objects
  2353. + added check for forwards also in record and objects
  2354. * dummy parasymtable for unit initialization removed from
  2355. symtable stack
  2356. Revision 1.69 1998/09/07 23:10:25 florian
  2357. * a lot of stuff fixed regarding rtti and publishing of properties,
  2358. basics should now work
  2359. Revision 1.68 1998/09/07 19:33:26 florian
  2360. + some stuff for property rtti added:
  2361. - NameIndex of the TPropInfo record is now written correctly
  2362. - the DEFAULT/NODEFAULT keyword is supported now
  2363. - the default value and the storedsym/def are now written to
  2364. the PPU fiel
  2365. Revision 1.67 1998/09/07 18:46:14 peter
  2366. * update smartlinking, uses getdatalabel
  2367. * renamed ptree.value vars to value_str,value_real,value_set
  2368. Revision 1.66 1998/09/07 17:37:05 florian
  2369. * first fixes for published properties
  2370. Revision 1.65 1998/09/06 22:42:03 florian
  2371. + rtti genreation for properties added
  2372. Revision 1.64 1998/09/05 22:11:04 florian
  2373. + switch -vb
  2374. * while/repeat loops accept now also word/longbool conditions
  2375. * makebooltojump did an invalid ungetregister32, fixed
  2376. Revision 1.63 1998/09/04 17:34:23 pierre
  2377. * bug with datalabel corrected
  2378. + assembler errors better commented
  2379. * one nested record crash removed
  2380. Revision 1.62 1998/09/04 08:42:10 peter
  2381. * updated some error messages
  2382. Revision 1.61 1998/09/03 16:03:21 florian
  2383. + rtti generation
  2384. * init table generation changed
  2385. Revision 1.60 1998/09/01 17:39:52 peter
  2386. + internal constant functions
  2387. Revision 1.59 1998/09/01 12:53:27 peter
  2388. + aktpackenum
  2389. Revision 1.58 1998/09/01 07:54:26 pierre
  2390. * UseBrowser a little updated (might still be buggy !!)
  2391. * bug in psub.pas in function specifier removed
  2392. * stdcall allowed in interface and in implementation
  2393. (FPC will not yet complain if it is missing in either part
  2394. because stdcall is only a dummy !!)
  2395. Revision 1.57 1998/08/31 12:26:33 peter
  2396. * m68k and palmos updates from surebugfixes
  2397. Revision 1.56 1998/08/21 14:08:55 pierre
  2398. + TEST_FUNCRET now default (old code removed)
  2399. works also for m68k (at least compiles)
  2400. Revision 1.55 1998/08/21 08:43:32 pierre
  2401. * pocdecl and poclearstack are now different
  2402. external must but written as last specification
  2403. Revision 1.54 1998/08/20 09:26:48 pierre
  2404. + funcret setting in underproc testing
  2405. compile with _dTEST_FUNCRET
  2406. Revision 1.53 1998/08/19 18:04:56 peter
  2407. * fixed current_module^.in_implementation flag
  2408. Revision 1.51 1998/08/18 14:17:12 pierre
  2409. * bug about assigning the return value of a function to
  2410. a procvar fixed : warning
  2411. assigning a proc to a procvar need @ in FPC mode !!
  2412. * missing file/line info restored
  2413. Revision 1.50 1998/08/17 10:10:13 peter
  2414. - removed OLDPPU
  2415. Revision 1.49 1998/08/12 19:39:31 peter
  2416. * fixed some crashes
  2417. Revision 1.48 1998/08/10 14:50:32 peter
  2418. + localswitches, moduleswitches, globalswitches splitting
  2419. Revision 1.47 1998/08/10 10:00:19 peter
  2420. * Moved symbolstream to symtable.pas
  2421. Revision 1.46 1998/08/08 10:19:19 florian
  2422. * small fixes to write the extended type correct
  2423. Revision 1.45 1998/08/02 16:42:00 florian
  2424. * on o : tobject do should also work now, the exceptsymtable shouldn't be
  2425. disposed by dellexlevel
  2426. Revision 1.44 1998/07/30 11:18:21 florian
  2427. + first implementation of try ... except on .. do end;
  2428. * limitiation of 65535 bytes parameters for cdecl removed
  2429. Revision 1.43 1998/07/28 21:52:56 florian
  2430. + implementation of raise and try..finally
  2431. + some misc. exception stuff
  2432. Revision 1.42 1998/07/20 10:23:03 florian
  2433. * better ansi string assignement
  2434. Revision 1.41 1998/07/18 22:54:31 florian
  2435. * some ansi/wide/longstring support fixed:
  2436. o parameter passing
  2437. o returning as result from functions
  2438. Revision 1.40 1998/07/14 14:47:09 peter
  2439. * released NEWINPUT
  2440. Revision 1.39 1998/07/10 00:00:06 peter
  2441. * fixed ttypesym bug finally
  2442. * fileinfo in the symtable and better using for unused vars
  2443. Revision 1.38 1998/07/07 11:20:17 peter
  2444. + NEWINPUT for a better inputfile and scanner object
  2445. Revision 1.37 1998/06/24 14:48:42 peter
  2446. * ifdef newppu -> ifndef oldppu
  2447. Revision 1.36 1998/06/17 14:10:19 peter
  2448. * small os2 fixes
  2449. * fixed interdependent units with newppu (remake3 under linux works now)
  2450. Revision 1.35 1998/06/16 08:56:35 peter
  2451. + targetcpu
  2452. * cleaner pmodules for newppu
  2453. Revision 1.34 1998/06/15 15:38:12 pierre
  2454. * small bug in systems.pas corrected
  2455. + operators in different units better hanlded
  2456. Revision 1.33 1998/06/15 14:10:53 daniel
  2457. * File was ruined, fixed.
  2458. Revision 1.31 1998/06/13 00:10:20 peter
  2459. * working browser and newppu
  2460. * some small fixes against crashes which occured in bp7 (but not in
  2461. fpc?!)
  2462. Revision 1.30 1998/06/09 16:01:53 pierre
  2463. + added procedure directive parsing for procvars
  2464. (accepted are popstack cdecl and pascal)
  2465. + added C vars with the following syntax
  2466. var C calias 'true_c_name';(can be followed by external)
  2467. reason is that you must add the Cprefix
  2468. which is target dependent
  2469. Revision 1.29 1998/06/07 15:30:26 florian
  2470. + first working rtti
  2471. + data init/final. for local variables
  2472. Revision 1.28 1998/06/06 09:27:39 peter
  2473. * new depend file generated
  2474. Revision 1.27 1998/06/05 14:37:38 pierre
  2475. * fixes for inline for operators
  2476. * inline procedure more correctly restricted
  2477. Revision 1.26 1998/06/04 23:52:03 peter
  2478. * m68k compiles
  2479. + .def file creation moved to gendef.pas so it could also be used
  2480. for win32
  2481. Revision 1.25 1998/06/04 09:55:48 pierre
  2482. * demangled name of procsym reworked to become independant of the
  2483. mangling scheme
  2484. Revision 1.24 1998/06/03 22:49:04 peter
  2485. + wordbool,longbool
  2486. * rename bis,von -> high,low
  2487. * moved some systemunit loading/creating to psystem.pas
  2488. Revision 1.23 1998/05/28 14:40:30 peter
  2489. * fixes for newppu, remake3 works now with it
  2490. Revision 1.22 1998/05/27 19:45:09 peter
  2491. * symtable.pas splitted into includefiles
  2492. * symtable adapted for $ifndef OLDPPU
  2493. Revision 1.21 1998/05/23 01:21:31 peter
  2494. + aktasmmode, aktoptprocessor, aktoutputformat
  2495. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  2496. + $LIBNAME to set the library name where the unit will be put in
  2497. * splitted cgi386 a bit (codeseg to large for bp7)
  2498. * nasm, tasm works again. nasm moved to ag386nsm.pas
  2499. Revision 1.20 1998/05/21 19:33:37 peter
  2500. + better procedure directive handling and only one table
  2501. Revision 1.19 1998/05/20 09:42:37 pierre
  2502. + UseTokenInfo now default
  2503. * unit in interface uses and implementation uses gives error now
  2504. * only one error for unknown symbol (uses lastsymknown boolean)
  2505. the problem came from the label code !
  2506. + first inlined procedures and function work
  2507. (warning there might be allowed cases were the result is still wrong !!)
  2508. * UseBrower updated gives a global list of all position of all used symbols
  2509. with switch -gb
  2510. Revision 1.18 1998/05/11 13:07:57 peter
  2511. + $ifndef OLDPPU for the new ppuformat
  2512. + $define GDB not longer required
  2513. * removed all warnings and stripped some log comments
  2514. * no findfirst/findnext anymore to remove smartlink *.o files
  2515. Revision 1.17 1998/05/06 08:38:48 pierre
  2516. * better position info with UseTokenInfo
  2517. UseTokenInfo greatly simplified
  2518. + added check for changed tree after first time firstpass
  2519. (if we could remove all the cases were it happen
  2520. we could skip all firstpass if firstpasscount > 1)
  2521. Only with ExtDebug
  2522. Revision 1.16 1998/05/05 15:24:20 michael
  2523. * Fix to save units with classes.
  2524. Revision 1.15 1998/05/04 17:54:29 peter
  2525. + smartlinking works (only case jumptable left todo)
  2526. * redesign of systems.pas to support assemblers and linkers
  2527. + Unitname is now also in the PPU-file, increased version to 14
  2528. Revision 1.14 1998/05/01 16:38:46 florian
  2529. * handling of private and protected fixed
  2530. + change_keywords_to_tp implemented to remove
  2531. keywords which aren't supported by tp
  2532. * break and continue are now symbols of the system unit
  2533. + widestring, longstring and ansistring type released
  2534. Revision 1.13 1998/05/01 09:01:25 florian
  2535. + correct semantics of private and protected
  2536. * small fix in variable scope:
  2537. a id can be used in a parameter list of a method, even it is used in
  2538. an anchestor class as field id
  2539. Revision 1.12 1998/05/01 07:43:57 florian
  2540. + basics for rtti implemented
  2541. + switch $m (generate rtti for published sections)
  2542. Revision 1.11 1998/04/30 15:59:42 pierre
  2543. * GDB works again better :
  2544. correct type info in one pass
  2545. + UseTokenInfo for better source position
  2546. * fixed one remaining bug in scanner for line counts
  2547. * several little fixes
  2548. Revision 1.10 1998/04/29 10:34:05 pierre
  2549. + added some code for ansistring (not complete nor working yet)
  2550. * corrected operator overloading
  2551. * corrected nasm output
  2552. + started inline procedures
  2553. + added starstarn : use ** for exponentiation (^ gave problems)
  2554. + started UseTokenInfo cond to get accurate positions
  2555. Revision 1.9 1998/04/27 23:10:29 peter
  2556. + new scanner
  2557. * $makelib -> if smartlink
  2558. * small filename fixes pmodule.setfilename
  2559. * moved import from files.pas -> import.pas
  2560. Revision 1.8 1998/04/21 10:16:48 peter
  2561. * patches from strasbourg
  2562. * objects is not used anymore in the fpc compiled version
  2563. Revision 1.7 1998/04/13 22:20:36 florian
  2564. + stricter checking for duplicate id, solves also bug0097
  2565. Revision 1.6 1998/04/13 17:20:43 florian
  2566. * tdef.done much faster implemented
  2567. Revision 1.5 1998/04/10 21:36:56 florian
  2568. + some stuff to support method pointers (procedure of object) added
  2569. (declaration, parameter handling)
  2570. Revision 1.4 1998/04/08 16:58:08 pierre
  2571. * several bugfixes
  2572. ADD ADC and AND are also sign extended
  2573. nasm output OK (program still crashes at end
  2574. and creates wrong assembler files !!)
  2575. procsym types sym in tdef removed !!
  2576. Revision 1.3 1998/04/07 13:19:52 pierre
  2577. * bugfixes for reset_gdb_info
  2578. in MEM parsing for go32v2
  2579. better external symbol creation
  2580. support for rhgdb.exe (lowercase file names)
  2581. Revision 1.2 1998/04/06 13:09:04 daniel
  2582. * Emergency solution for bug in reset_gdb_info.
  2583. }