symsym.pas 81 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  4. Implementation for the symbols types of the symtable
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit symsym;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,
  24. { target }
  25. cpuinfo,globtype,
  26. { symtable }
  27. symconst,symbase,symtype,symdef,
  28. { ppu }
  29. ppu,symppu,
  30. {$ifdef var_notification}
  31. cclasses,symnot,
  32. {$endif}
  33. { aasm }
  34. aasmbase,aasmtai,cpubase,
  35. globals
  36. ;
  37. type
  38. {************************************************
  39. TSym
  40. ************************************************}
  41. { this object is the base for all symbol objects }
  42. tstoredsym = class(tsym)
  43. protected
  44. _mangledname : pstring;
  45. public
  46. refs : longint;
  47. lastref,
  48. defref,
  49. lastwritten : tref;
  50. refcount : longint;
  51. {$ifdef GDB}
  52. isstabwritten : boolean;
  53. {$endif GDB}
  54. constructor create(const n : string);
  55. constructor loadsym(ppufile:tcompilerppufile);
  56. destructor destroy;override;
  57. procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
  58. procedure writesym(ppufile:tcompilerppufile);
  59. procedure deref;override;
  60. {$ifdef GDB}
  61. function stabstring : pchar;virtual;
  62. procedure concatstabto(asmlist : taasmoutput);virtual;
  63. {$endif GDB}
  64. procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
  65. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
  66. function is_visible_for_proc(currprocdef:tprocdef):boolean;
  67. function is_visible_for_object(currobjdef:tobjectdef):boolean;
  68. function mangledname : string;
  69. procedure generate_mangledname;virtual;abstract;
  70. end;
  71. tlabelsym = class(tstoredsym)
  72. lab : tasmlabel;
  73. used,
  74. defined : boolean;
  75. code : pointer; { should be tnode }
  76. constructor create(const n : string; l : tasmlabel);
  77. destructor destroy;override;
  78. constructor ppuload(ppufile:tcompilerppufile);
  79. procedure generate_mangledname;override;
  80. procedure ppuwrite(ppufile:tcompilerppufile);override;
  81. end;
  82. tunitsym = class(tstoredsym)
  83. unitsymtable : tsymtable;
  84. prevsym : tunitsym;
  85. constructor create(const n : string;ref : tsymtable);
  86. constructor ppuload(ppufile:tcompilerppufile);
  87. destructor destroy;override;
  88. procedure ppuwrite(ppufile:tcompilerppufile);override;
  89. procedure restoreunitsym;
  90. {$ifdef GDB}
  91. procedure concatstabto(asmlist : taasmoutput);override;
  92. {$endif GDB}
  93. end;
  94. terrorsym = class(tstoredsym)
  95. constructor create;
  96. end;
  97. Tprocdefcallback = procedure(p:Tprocdef;arg:pointer);
  98. tprocsym = class(tstoredsym)
  99. protected
  100. pdlistfirst,
  101. pdlistlast : pprocdeflist; { linked list of overloaded procdefs }
  102. function getprocdef(nr:cardinal):Tprocdef;
  103. public
  104. procdef_count : byte;
  105. is_global : boolean;
  106. overloadchecked : boolean;
  107. overloadcount : word; { amount of overloaded functions in this module }
  108. property procdef[nr:cardinal]:Tprocdef read getprocdef;
  109. constructor create(const n : string);
  110. constructor ppuload(ppufile:tcompilerppufile);
  111. destructor destroy;override;
  112. { writes all declarations except the specified one }
  113. procedure write_parameter_lists(skipdef:tprocdef);
  114. { tests, if all procedures definitions are defined and not }
  115. { only forward }
  116. procedure check_forward;
  117. procedure unchain_overload;
  118. procedure ppuwrite(ppufile:tcompilerppufile);override;
  119. procedure deref;override;
  120. procedure addprocdef(p:tprocdef);
  121. procedure add_para_match_to(Aprocsym:Tprocsym);
  122. procedure concat_procdefs_to(s:Tprocsym);
  123. procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  124. function first_procdef:Tprocdef;
  125. function last_procdef:Tprocdef;
  126. function search_procdef_nopara_boolret:Tprocdef;
  127. function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  128. function search_procdef_bypara(params:Tparalinkedlist;
  129. allowconvert,
  130. allowdefault:boolean):Tprocdef;
  131. function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  132. function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
  133. function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
  134. function search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
  135. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  136. {$ifdef GDB}
  137. function stabstring : pchar;override;
  138. procedure concatstabto(asmlist : taasmoutput);override;
  139. {$endif GDB}
  140. end;
  141. ttypesym = class(tstoredsym)
  142. restype : ttype;
  143. {$ifdef GDB}
  144. isusedinstab : boolean;
  145. {$endif GDB}
  146. constructor create(const n : string;const tt : ttype);
  147. constructor ppuload(ppufile:tcompilerppufile);
  148. procedure ppuwrite(ppufile:tcompilerppufile);override;
  149. procedure deref;override;
  150. function gettypedef:tdef;override;
  151. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  152. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  153. {$ifdef GDB}
  154. function stabstring : pchar;override;
  155. procedure concatstabto(asmlist : taasmoutput);override;
  156. {$endif GDB}
  157. end;
  158. tvarsym = class(tstoredsym)
  159. address : longint;
  160. localvarsym : tvarsym;
  161. vartype : ttype;
  162. varoptions : tvaroptions;
  163. reg : tregister; { if reg<>R_NO, then the variable is an register variable }
  164. varspez : tvarspez; { sets the type of access }
  165. varstate : tvarstate;
  166. paraitem : tparaitem;
  167. {$ifdef var_notification}
  168. notifications : Tlinkedlist;
  169. {$endif}
  170. constructor create(const n : string;const tt : ttype);
  171. constructor create_dll(const n : string;const tt : ttype);
  172. constructor create_C(const n,mangled : string;const tt : ttype);
  173. constructor ppuload(ppufile:tcompilerppufile);
  174. destructor destroy;override;
  175. procedure ppuwrite(ppufile:tcompilerppufile);override;
  176. procedure deref;override;
  177. procedure generate_mangledname;override;
  178. procedure set_mangledname(const s:string);
  179. function getsize : longint;
  180. function getvaluesize : longint;
  181. {$ifdef var_notification}
  182. function register_notification(flags:Tnotification_flags;
  183. callback:Tnotification_callback):cardinal;
  184. {$endif}
  185. {$ifdef GDB}
  186. function stabstring : pchar;override;
  187. procedure concatstabto(asmlist : taasmoutput);override;
  188. {$endif GDB}
  189. end;
  190. tpropertysym = class(tstoredsym)
  191. propoptions : tpropertyoptions;
  192. propoverriden : tpropertysym;
  193. proptype,
  194. indextype : ttype;
  195. index,
  196. default : longint;
  197. readaccess,
  198. writeaccess,
  199. storedaccess : tsymlist;
  200. constructor create(const n : string);
  201. destructor destroy;override;
  202. constructor ppuload(ppufile:tcompilerppufile);
  203. function getsize : longint;
  204. procedure ppuwrite(ppufile:tcompilerppufile);override;
  205. function gettypedef:tdef;override;
  206. procedure deref;override;
  207. procedure dooverride(overriden:tpropertysym);
  208. {$ifdef GDB}
  209. function stabstring : pchar;override;
  210. procedure concatstabto(asmlist : taasmoutput);override;
  211. {$endif GDB}
  212. end;
  213. tfuncretsym = class(tstoredsym)
  214. returntype : ttype;
  215. address : longint;
  216. funcretstate : tvarstate;
  217. constructor create(const n : string;const tt : ttype);
  218. constructor ppuload(ppufile:tcompilerppufile);
  219. destructor destroy;override;
  220. procedure ppuwrite(ppufile:tcompilerppufile);override;
  221. procedure deref;override;
  222. {$ifdef GDB}
  223. procedure concatstabto(asmlist : taasmoutput);override;
  224. {$endif GDB}
  225. end;
  226. tabsolutesym = class(tvarsym)
  227. abstyp : absolutetyp;
  228. absseg : boolean;
  229. ref : tstoredsym;
  230. asmname : pstring;
  231. constructor create(const n : string;const tt : ttype);
  232. constructor ppuload(ppufile:tcompilerppufile);
  233. procedure deref;override;
  234. function mangledname : string;
  235. procedure ppuwrite(ppufile:tcompilerppufile);override;
  236. {$ifdef GDB}
  237. procedure concatstabto(asmlist : taasmoutput);override;
  238. {$endif GDB}
  239. end;
  240. ttypedconstsym = class(tstoredsym)
  241. typedconsttype : ttype;
  242. is_writable : boolean;
  243. constructor create(const n : string;p : tdef;writable : boolean);
  244. constructor createtype(const n : string;const tt : ttype;writable : boolean);
  245. constructor ppuload(ppufile:tcompilerppufile);
  246. destructor destroy;override;
  247. procedure generate_mangledname;override;
  248. procedure ppuwrite(ppufile:tcompilerppufile);override;
  249. procedure deref;override;
  250. function getsize:longint;
  251. {$ifdef GDB}
  252. function stabstring : pchar;override;
  253. {$endif GDB}
  254. end;
  255. tconstvalue = record
  256. case integer of
  257. 0: (valueord : tconstexprint);
  258. 1: (valueordptr : tconstptruint);
  259. 2: (valueptr : pointer; len : longint);
  260. end;
  261. tconstsym = class(tstoredsym)
  262. consttype : ttype;
  263. consttyp : tconsttyp;
  264. value : tconstvalue;
  265. resstrindex : longint; { needed for resource strings }
  266. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
  267. constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  268. constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  269. constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
  270. constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  271. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  272. constructor ppuload(ppufile:tcompilerppufile);
  273. destructor destroy;override;
  274. function mangledname : string;
  275. procedure deref;override;
  276. procedure ppuwrite(ppufile:tcompilerppufile);override;
  277. {$ifdef GDB}
  278. function stabstring : pchar;override;
  279. procedure concatstabto(asmlist : taasmoutput);override;
  280. {$endif GDB}
  281. end;
  282. tenumsym = class(tstoredsym)
  283. value : longint;
  284. definition : tenumdef;
  285. nextenum : tenumsym;
  286. constructor create(const n : string;def : tenumdef;v : longint);
  287. constructor ppuload(ppufile:tcompilerppufile);
  288. procedure ppuwrite(ppufile:tcompilerppufile);override;
  289. procedure deref;override;
  290. procedure order;
  291. {$ifdef GDB}
  292. procedure concatstabto(asmlist : taasmoutput);override;
  293. {$endif GDB}
  294. end;
  295. tsyssym = class(tstoredsym)
  296. number : longint;
  297. constructor create(const n : string;l : longint);
  298. constructor ppuload(ppufile:tcompilerppufile);
  299. destructor destroy;override;
  300. procedure ppuwrite(ppufile:tcompilerppufile);override;
  301. {$ifdef GDB}
  302. procedure concatstabto(asmlist : taasmoutput);override;
  303. {$endif GDB}
  304. end;
  305. { compiler generated symbol to point to rtti and init/finalize tables }
  306. trttisym = class(tstoredsym)
  307. lab : tasmsymbol;
  308. rttityp : trttitype;
  309. constructor create(const n:string;rt:trttitype);
  310. constructor ppuload(ppufile:tcompilerppufile);
  311. procedure ppuwrite(ppufile:tcompilerppufile);override;
  312. function mangledname:string;
  313. function get_label:tasmsymbol;
  314. end;
  315. { register variables }
  316. pregvarinfo = ^tregvarinfo;
  317. tregvarinfo = record
  318. regvars : array[1..maxvarregs] of tvarsym;
  319. regvars_para : array[1..maxvarregs] of boolean;
  320. regvars_refs : array[1..maxvarregs] of longint;
  321. fpuregvars : array[1..maxfpuvarregs] of tvarsym;
  322. fpuregvars_para : array[1..maxfpuvarregs] of boolean;
  323. fpuregvars_refs : array[1..maxfpuvarregs] of longint;
  324. end;
  325. var
  326. aktprocsym : tprocsym; { pointer to the symbol for the
  327. currently be parsed procedure }
  328. aktprocdef : tprocdef;
  329. aktcallprocdef : tabstractprocdef; { pointer to the definition of the
  330. currently called procedure,
  331. only set/unset in ncal }
  332. generrorsym : tsym;
  333. otsym : tvarsym;
  334. const
  335. current_object_option : tsymoptions = [sp_public];
  336. { rtti and init/final }
  337. procedure generate_rtti(p:tsym);
  338. procedure generate_inittable(p:tsym);
  339. implementation
  340. uses
  341. {$ifdef Delphi}
  342. sysutils,
  343. {$else Delphi}
  344. strings,
  345. {$endif Delphi}
  346. { global }
  347. verbose,
  348. { target }
  349. systems,
  350. { symtable }
  351. symtable,defutil,defcmp,
  352. {$ifdef GDB}
  353. gdb,
  354. {$endif GDB}
  355. { tree }
  356. node,
  357. { aasm }
  358. aasmcpu,
  359. { module }
  360. fmodule,
  361. { codegen }
  362. paramgr,cgbase,cresstr
  363. ;
  364. {****************************************************************************
  365. Helpers
  366. ****************************************************************************}
  367. {****************************************************************************
  368. TSYM (base for all symtypes)
  369. ****************************************************************************}
  370. constructor tstoredsym.create(const n : string);
  371. begin
  372. inherited create(n);
  373. symoptions:=current_object_option;
  374. {$ifdef GDB}
  375. isstabwritten := false;
  376. {$endif GDB}
  377. fileinfo:=akttokenpos;
  378. defref:=nil;
  379. refs:=0;
  380. lastwritten:=nil;
  381. refcount:=0;
  382. if (cs_browser in aktmoduleswitches) and make_ref then
  383. begin
  384. defref:=tref.create(defref,@akttokenpos);
  385. inc(refcount);
  386. end;
  387. lastref:=defref;
  388. _mangledname:=nil;
  389. end;
  390. constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
  391. var
  392. s : string;
  393. nr : word;
  394. begin
  395. nr:=ppufile.getword;
  396. s:=ppufile.getstring;
  397. inherited create(s);
  398. { force the correct indexnr. must be after create! }
  399. indexnr:=nr;
  400. ppufile.getsmallset(symoptions);
  401. ppufile.getposinfo(fileinfo);
  402. lastref:=nil;
  403. defref:=nil;
  404. refs:=0;
  405. lastwritten:=nil;
  406. refcount:=0;
  407. _mangledname:=nil;
  408. {$ifdef GDB}
  409. isstabwritten := false;
  410. {$endif GDB}
  411. end;
  412. procedure tstoredsym.deref;
  413. begin
  414. end;
  415. procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
  416. var
  417. pos : tfileposinfo;
  418. move_last : boolean;
  419. begin
  420. move_last:=lastwritten=lastref;
  421. while (not ppufile.endofentry) do
  422. begin
  423. ppufile.getposinfo(pos);
  424. inc(refcount);
  425. lastref:=tref.create(lastref,@pos);
  426. lastref.is_written:=true;
  427. if refcount=1 then
  428. defref:=lastref;
  429. end;
  430. if move_last then
  431. lastwritten:=lastref;
  432. end;
  433. { big problem here :
  434. wrong refs were written because of
  435. interface parsing of other units PM
  436. moduleindex must be checked !! }
  437. function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  438. var
  439. ref : tref;
  440. symref_written,move_last : boolean;
  441. begin
  442. write_references:=false;
  443. if lastwritten=lastref then
  444. exit;
  445. { should we update lastref }
  446. move_last:=true;
  447. symref_written:=false;
  448. { write symbol refs }
  449. if assigned(lastwritten) then
  450. ref:=lastwritten
  451. else
  452. ref:=defref;
  453. while assigned(ref) do
  454. begin
  455. if ref.moduleindex=current_module.unit_index then
  456. begin
  457. { write address to this symbol }
  458. if not symref_written then
  459. begin
  460. ppufile.putderef(self);
  461. symref_written:=true;
  462. end;
  463. ppufile.putposinfo(ref.posinfo);
  464. ref.is_written:=true;
  465. if move_last then
  466. lastwritten:=ref;
  467. end
  468. else if not ref.is_written then
  469. move_last:=false
  470. else if move_last then
  471. lastwritten:=ref;
  472. ref:=ref.nextref;
  473. end;
  474. if symref_written then
  475. ppufile.writeentry(ibsymref);
  476. write_references:=symref_written;
  477. end;
  478. destructor tstoredsym.destroy;
  479. begin
  480. if assigned(_mangledname) then
  481. begin
  482. {$ifdef MEMDEBUG}
  483. memmanglednames.start;
  484. {$endif MEMDEBUG}
  485. stringdispose(_mangledname);
  486. {$ifdef MEMDEBUG}
  487. memmanglednames.stop;
  488. {$endif MEMDEBUG}
  489. end;
  490. if assigned(defref) then
  491. begin
  492. {$ifdef MEMDEBUG}
  493. membrowser.start;
  494. {$endif MEMDEBUG}
  495. defref.freechain;
  496. defref.free;
  497. {$ifdef MEMDEBUG}
  498. membrowser.stop;
  499. {$endif MEMDEBUG}
  500. end;
  501. inherited destroy;
  502. end;
  503. procedure tstoredsym.writesym(ppufile:tcompilerppufile);
  504. begin
  505. ppufile.putword(indexnr);
  506. ppufile.putstring(_realname^);
  507. ppufile.putsmallset(symoptions);
  508. ppufile.putposinfo(fileinfo);
  509. end;
  510. {$ifdef GDB}
  511. function tstoredsym.stabstring : pchar;
  512. begin
  513. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  514. tostr(fileinfo.line)+',0');
  515. end;
  516. procedure tstoredsym.concatstabto(asmlist : taasmoutput);
  517. var
  518. stab_str : pchar;
  519. begin
  520. if not isstabwritten then
  521. begin
  522. stab_str := stabstring;
  523. { count_dbx(stab_str); moved to GDB.PAS }
  524. asmList.concat(Tai_stabs.Create(stab_str));
  525. isstabwritten:=true;
  526. end;
  527. end;
  528. {$endif GDB}
  529. function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
  530. begin
  531. is_visible_for_proc:=false;
  532. { private symbols are allowed when we are in the same
  533. module as they are defined }
  534. if (sp_private in symoptions) and
  535. assigned(owner.defowner) and
  536. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  537. (owner.defowner.owner.unitid<>0) then
  538. exit;
  539. { protected symbols are vissible in the module that defines them and
  540. also visible to related objects }
  541. if (sp_protected in symoptions) and
  542. (
  543. (
  544. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  545. (owner.defowner.owner.unitid<>0)
  546. ) and
  547. not(
  548. assigned(currprocdef) and
  549. assigned(currprocdef._class) and
  550. currprocdef._class.is_related(tobjectdef(owner.defowner))
  551. )
  552. ) then
  553. exit;
  554. is_visible_for_proc:=true;
  555. end;
  556. function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
  557. begin
  558. is_visible_for_object:=false;
  559. { private symbols are allowed when we are in the same
  560. module as they are defined }
  561. if (sp_private in symoptions) and
  562. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  563. (owner.defowner.owner.unitid<>0) then
  564. exit;
  565. { protected symbols are vissible in the module that defines them and
  566. also visible to related objects }
  567. if (sp_protected in symoptions) and
  568. (
  569. (
  570. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  571. (owner.defowner.owner.unitid<>0)
  572. ) and
  573. not(
  574. assigned(currobjdef) and
  575. currobjdef.is_related(tobjectdef(owner.defowner))
  576. )
  577. ) then
  578. exit;
  579. is_visible_for_object:=true;
  580. end;
  581. function tstoredsym.mangledname : string;
  582. begin
  583. if not assigned(_mangledname) then
  584. begin
  585. generate_mangledname;
  586. if not assigned(_mangledname) then
  587. internalerror(200204171);
  588. end;
  589. mangledname:=_mangledname^
  590. end;
  591. {****************************************************************************
  592. TLABELSYM
  593. ****************************************************************************}
  594. constructor tlabelsym.create(const n : string; l : tasmlabel);
  595. begin
  596. inherited create(n);
  597. typ:=labelsym;
  598. lab:=l;
  599. used:=false;
  600. defined:=false;
  601. code:=nil;
  602. end;
  603. constructor tlabelsym.ppuload(ppufile:tcompilerppufile);
  604. begin
  605. inherited loadsym(ppufile);
  606. typ:=labelsym;
  607. { this is all dummy
  608. it is only used for local browsing }
  609. lab:=nil;
  610. code:=nil;
  611. used:=false;
  612. defined:=true;
  613. end;
  614. destructor tlabelsym.destroy;
  615. begin
  616. inherited destroy;
  617. end;
  618. procedure tlabelsym.generate_mangledname;
  619. begin
  620. _mangledname:=stringdup(lab.name);
  621. end;
  622. procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
  623. begin
  624. if owner.symtabletype=globalsymtable then
  625. Message(sym_e_ill_label_decl)
  626. else
  627. begin
  628. inherited writesym(ppufile);
  629. ppufile.writeentry(iblabelsym);
  630. end;
  631. end;
  632. {****************************************************************************
  633. TUNITSYM
  634. ****************************************************************************}
  635. constructor tunitsym.create(const n : string;ref : tsymtable);
  636. var
  637. old_make_ref : boolean;
  638. begin
  639. old_make_ref:=make_ref;
  640. make_ref:=false;
  641. inherited create(n);
  642. make_ref:=old_make_ref;
  643. typ:=unitsym;
  644. unitsymtable:=ref;
  645. if assigned(ref) and
  646. (ref.symtabletype=globalsymtable) then
  647. begin
  648. prevsym:=tglobalsymtable(ref).unitsym;
  649. tglobalsymtable(ref).unitsym:=self;
  650. end;
  651. end;
  652. constructor tunitsym.ppuload(ppufile:tcompilerppufile);
  653. begin
  654. inherited loadsym(ppufile);
  655. typ:=unitsym;
  656. unitsymtable:=nil;
  657. prevsym:=nil;
  658. refs:=0;
  659. end;
  660. { we need to remove it from the prevsym chain ! }
  661. procedure tunitsym.restoreunitsym;
  662. var pus,ppus : tunitsym;
  663. begin
  664. if assigned(unitsymtable) and
  665. (unitsymtable.symtabletype=globalsymtable) then
  666. begin
  667. ppus:=nil;
  668. pus:=tglobalsymtable(unitsymtable).unitsym;
  669. if pus=self then
  670. tglobalsymtable(unitsymtable).unitsym:=prevsym
  671. else while assigned(pus) do
  672. begin
  673. if pus=self then
  674. begin
  675. ppus.prevsym:=prevsym;
  676. break;
  677. end
  678. else
  679. begin
  680. ppus:=pus;
  681. pus:=ppus.prevsym;
  682. end;
  683. end;
  684. end;
  685. unitsymtable:=nil;
  686. prevsym:=nil;
  687. end;
  688. destructor tunitsym.destroy;
  689. begin
  690. restoreunitsym;
  691. inherited destroy;
  692. end;
  693. procedure tunitsym.ppuwrite(ppufile:tcompilerppufile);
  694. begin
  695. inherited writesym(ppufile);
  696. ppufile.writeentry(ibunitsym);
  697. end;
  698. {$ifdef GDB}
  699. procedure tunitsym.concatstabto(asmlist : taasmoutput);
  700. begin
  701. {Nothing to write to stabs !}
  702. end;
  703. {$endif GDB}
  704. {****************************************************************************
  705. TPROCSYM
  706. ****************************************************************************}
  707. constructor tprocsym.create(const n : string);
  708. begin
  709. inherited create(n);
  710. typ:=procsym;
  711. pdlistfirst:=nil;
  712. pdlistlast:=nil;
  713. owner:=nil;
  714. is_global:=false;
  715. overloadchecked:=false;
  716. overloadcount:=0;
  717. procdef_count:=0;
  718. end;
  719. constructor tprocsym.ppuload(ppufile:tcompilerppufile);
  720. var
  721. pd : tprocdef;
  722. begin
  723. inherited loadsym(ppufile);
  724. typ:=procsym;
  725. pdlistfirst:=nil;
  726. pdlistlast:=nil;
  727. procdef_count:=0;
  728. repeat
  729. pd:=tprocdef(ppufile.getderef);
  730. if pd=nil then
  731. break;
  732. addprocdef(pd);
  733. until false;
  734. is_global:=false;
  735. overloadchecked:=false;
  736. overloadcount:=$ffff; { invalid, not used anymore }
  737. end;
  738. destructor tprocsym.destroy;
  739. var
  740. hp,p : pprocdeflist;
  741. begin
  742. p:=pdlistfirst;
  743. while assigned(p) do
  744. begin
  745. hp:=p^.next;
  746. dispose(p);
  747. p:=hp;
  748. end;
  749. inherited destroy;
  750. end;
  751. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  752. var
  753. p : pprocdeflist;
  754. begin
  755. p:=pdlistfirst;
  756. while assigned(p) do
  757. begin
  758. if p^.def<>skipdef then
  759. MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
  760. p:=p^.next;
  761. end;
  762. end;
  763. procedure tprocsym.check_forward;
  764. var
  765. p : pprocdeflist;
  766. begin
  767. p:=pdlistfirst;
  768. while assigned(p) do
  769. begin
  770. if (p^.def.procsym=self) and
  771. (p^.def.forwarddef) then
  772. begin
  773. MessagePos1(p^.def.fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
  774. { Turn futher error messages off }
  775. p^.def.forwarddef:=false;
  776. end;
  777. p:=p^.next;
  778. end;
  779. end;
  780. procedure tprocsym.deref;
  781. var
  782. p : pprocdeflist;
  783. begin
  784. p:=pdlistfirst;
  785. while assigned(p) do
  786. begin
  787. resolvedef(pointer(p^.def));
  788. p:=p^.next;
  789. end;
  790. end;
  791. procedure tprocsym.addprocdef(p:tprocdef);
  792. var
  793. pd : pprocdeflist;
  794. begin
  795. new(pd);
  796. pd^.def:=p;
  797. pd^.next:=nil;
  798. { Add at end of list to keep always
  799. a correct order, also after loading from ppu }
  800. if assigned(pdlistlast) then
  801. begin
  802. pdlistlast^.next:=pd;
  803. pdlistlast:=pd;
  804. end
  805. else
  806. begin
  807. pdlistfirst:=pd;
  808. pdlistlast:=pd;
  809. end;
  810. inc(procdef_count);
  811. end;
  812. function Tprocsym.getprocdef(nr:cardinal):Tprocdef;
  813. var
  814. i : cardinal;
  815. pd : Pprocdeflist;
  816. begin
  817. pd:=pdlistfirst;
  818. for i:=2 to nr do
  819. begin
  820. if not assigned(pd) then
  821. internalerror(200209051);
  822. pd:=pd^.next;
  823. end;
  824. getprocdef:=pd^.def;
  825. end;
  826. procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
  827. var
  828. pd:Pprocdeflist;
  829. begin
  830. pd:=pdlistfirst;
  831. while assigned(pd) do
  832. begin
  833. if Aprocsym.search_procdef_bypara(pd^.def.para,false,true)=nil then
  834. Aprocsym.addprocdef(pd^.def);
  835. pd:=pd^.next;
  836. end;
  837. end;
  838. procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
  839. var
  840. pd : Pprocdeflist;
  841. begin
  842. pd:=pdlistfirst;
  843. while assigned(pd) do
  844. begin
  845. s.addprocdef(pd^.def);
  846. pd:=pd^.next;
  847. end;
  848. end;
  849. function Tprocsym.first_procdef:Tprocdef;
  850. begin
  851. if assigned(pdlistfirst) then
  852. first_procdef:=pdlistfirst^.def
  853. else
  854. first_procdef:=nil;
  855. end;
  856. function Tprocsym.last_procdef:Tprocdef;
  857. begin
  858. if assigned(pdlistlast) then
  859. last_procdef:=pdlistlast^.def
  860. else
  861. last_procdef:=nil;
  862. end;
  863. procedure Tprocsym.foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
  864. var
  865. p : Pprocdeflist;
  866. begin
  867. p:=pdlistfirst;
  868. while assigned(p) do
  869. begin
  870. proc2call(p^.def,arg);
  871. p:=p^.next;
  872. end;
  873. end;
  874. function Tprocsym.search_procdef_nopara_boolret:Tprocdef;
  875. var
  876. p : Pprocdeflist;
  877. begin
  878. search_procdef_nopara_boolret:=nil;
  879. p:=pdlistfirst;
  880. while p<>nil do
  881. begin
  882. if p^.def.para.empty and is_boolean(p^.def.rettype.def) then
  883. begin
  884. search_procdef_nopara_boolret:=p^.def;
  885. break;
  886. end;
  887. p:=p^.next;
  888. end;
  889. end;
  890. function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  891. var
  892. p : Pprocdeflist;
  893. begin
  894. search_procdef_bytype:=nil;
  895. p:=pdlistfirst;
  896. while p<>nil do
  897. begin
  898. if p^.def.proctypeoption=pt then
  899. begin
  900. search_procdef_bytype:=p^.def;
  901. break;
  902. end;
  903. p:=p^.next;
  904. end;
  905. end;
  906. function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
  907. allowconvert,
  908. allowdefault:boolean):Tprocdef;
  909. var
  910. pd : Pprocdeflist;
  911. eq : tequaltype;
  912. begin
  913. search_procdef_bypara:=nil;
  914. pd:=pdlistfirst;
  915. while assigned(pd) do
  916. begin
  917. eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault);
  918. if (eq>=te_equal) or
  919. (allowconvert and (eq>te_incompatible)) then
  920. begin
  921. search_procdef_bypara:=pd^.def;
  922. break;
  923. end;
  924. pd:=pd^.next;
  925. end;
  926. end;
  927. function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  928. var
  929. pd : Pprocdeflist;
  930. eq,besteq : tequaltype;
  931. bestpd : tprocdef;
  932. begin
  933. { This function will return the pprocdef of pprocsym that
  934. is the best match for procvardef. When there are multiple
  935. matches it returns nil.}
  936. search_procdef_byprocvardef:=nil;
  937. bestpd:=nil;
  938. besteq:=te_incompatible;
  939. pd:=pdlistfirst;
  940. while assigned(pd) do
  941. begin
  942. eq:=proc_to_procvar_equal(pd^.def,d);
  943. if eq>=te_equal then
  944. begin
  945. { multiple procvars with the same equal level }
  946. if assigned(bestpd) and
  947. (besteq=eq) then
  948. exit;
  949. if eq>besteq then
  950. begin
  951. besteq:=eq;
  952. bestpd:=pd^.def;
  953. end;
  954. end;
  955. pd:=pd^.next;
  956. end;
  957. search_procdef_byprocvardef:=bestpd;
  958. end;
  959. function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
  960. var
  961. pd:Pprocdeflist;
  962. begin
  963. search_procdef_by1paradef:=nil;
  964. pd:=pdlistfirst;
  965. while assigned(pd) do
  966. begin
  967. if equal_defs(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
  968. (Tparaitem(pd^.def.para.first).next=nil) then
  969. begin
  970. search_procdef_by1paradef:=pd^.def;
  971. break;
  972. end;
  973. pd:=pd^.next;
  974. end;
  975. end;
  976. function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
  977. var
  978. convtyp : tconverttype;
  979. pd : pprocdeflist;
  980. bestpd : tprocdef;
  981. eq,
  982. besteq : tequaltype;
  983. hpd : tprocdef;
  984. begin
  985. search_procdef_assignment_operator:=nil;
  986. bestpd:=nil;
  987. besteq:=te_incompatible;
  988. pd:=pdlistfirst;
  989. while assigned(pd) do
  990. begin
  991. if equal_defs(todef,pd^.def.rettype.def) then
  992. begin
  993. eq:=compare_defs_ext(fromdef,Tparaitem(pd^.def.para.first).paratype.def,
  994. nothingn,false,false,convtyp,hpd);
  995. if eq=te_exact then
  996. begin
  997. search_procdef_assignment_operator:=pd^.def;
  998. exit;
  999. end;
  1000. if eq>besteq then
  1001. begin
  1002. bestpd:=pd^.def;
  1003. besteq:=eq;
  1004. end;
  1005. end;
  1006. pd:=pd^.next;
  1007. end;
  1008. search_procdef_assignment_operator:=bestpd;
  1009. end;
  1010. function Tprocsym.search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
  1011. var
  1012. convtyp : tconverttype;
  1013. pd : pprocdeflist;
  1014. bestpd : tprocdef;
  1015. eq1,eq2 : tequaltype;
  1016. eqlev,
  1017. bestlev : byte;
  1018. hpd : tprocdef;
  1019. begin
  1020. search_procdef_binary_operator:=nil;
  1021. bestpd:=nil;
  1022. bestlev:=0;
  1023. pd:=pdlistfirst;
  1024. while assigned(pd) do
  1025. begin
  1026. { Compare def1 with the last para (right to left order) }
  1027. eq1:=compare_defs_ext(def1,Tparaitem(pd^.def.para.last).paratype.def,
  1028. nothingn,false,false,convtyp,hpd);
  1029. if eq1<>te_incompatible then
  1030. begin
  1031. { Compare def2 with the first para (right to left order) }
  1032. eq2:=compare_defs_ext(def2,Tparaitem(pd^.def.para.first).paratype.def,
  1033. nothingn,false,false,convtyp,hpd);
  1034. if eq2<>te_incompatible then
  1035. begin
  1036. eqlev:=byte(eq1)+byte(eq2);
  1037. if eqlev=(byte(te_exact)+byte(te_exact)) then
  1038. begin
  1039. search_procdef_binary_operator:=pd^.def;
  1040. exit;
  1041. end;
  1042. if eqlev>bestlev then
  1043. begin
  1044. bestpd:=pd^.def;
  1045. bestlev:=eqlev;
  1046. end;
  1047. end;
  1048. end;
  1049. pd:=pd^.next;
  1050. end;
  1051. search_procdef_binary_operator:=bestpd;
  1052. end;
  1053. procedure tprocsym.ppuwrite(ppufile:tcompilerppufile);
  1054. var
  1055. p : pprocdeflist;
  1056. begin
  1057. inherited writesym(ppufile);
  1058. p:=pdlistfirst;
  1059. while assigned(p) do
  1060. begin
  1061. { only write the proc definitions that belong
  1062. to this procsym }
  1063. if (p^.def.procsym=self) then
  1064. ppufile.putderef(p^.def);
  1065. p:=p^.next;
  1066. end;
  1067. ppufile.putderef(nil);
  1068. ppufile.writeentry(ibprocsym);
  1069. end;
  1070. function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
  1071. var
  1072. p : pprocdeflist;
  1073. begin
  1074. write_references:=false;
  1075. if not inherited write_references(ppufile,locals) then
  1076. exit;
  1077. write_references:=true;
  1078. p:=pdlistfirst;
  1079. while assigned(p) do
  1080. begin
  1081. if (p^.def.procsym=self) then
  1082. p^.def.write_references(ppufile,locals);
  1083. p:=p^.next;
  1084. end;
  1085. end;
  1086. procedure tprocsym.unchain_overload;
  1087. var
  1088. p,hp : pprocdeflist;
  1089. begin
  1090. { remove all overloaded procdefs from the
  1091. procdeflist that are not in the current symtable }
  1092. p:=pdlistfirst;
  1093. { reset new lists }
  1094. pdlistfirst:=nil;
  1095. pdlistlast:=nil;
  1096. while assigned(p) do
  1097. begin
  1098. hp:=p^.next;
  1099. if (p^.def.procsym=self) then
  1100. begin
  1101. { keep, add to list }
  1102. if assigned(pdlistlast) then
  1103. begin
  1104. pdlistlast^.next:=p;
  1105. pdlistlast:=p;
  1106. end
  1107. else
  1108. begin
  1109. pdlistfirst:=p;
  1110. pdlistlast:=p;
  1111. end;
  1112. p^.next:=nil;
  1113. end
  1114. else
  1115. begin
  1116. { remove }
  1117. dispose(p);
  1118. dec(procdef_count);
  1119. end;
  1120. p:=hp;
  1121. end;
  1122. end;
  1123. {$ifdef GDB}
  1124. function tprocsym.stabstring : pchar;
  1125. begin
  1126. internalerror(200111171);
  1127. stabstring:=nil;
  1128. end;
  1129. procedure tprocsym.concatstabto(asmlist : taasmoutput);
  1130. begin
  1131. internalerror(200111172);
  1132. end;
  1133. {$endif GDB}
  1134. {****************************************************************************
  1135. TERRORSYM
  1136. ****************************************************************************}
  1137. constructor terrorsym.create;
  1138. begin
  1139. inherited create('');
  1140. typ:=errorsym;
  1141. end;
  1142. {****************************************************************************
  1143. TPROPERTYSYM
  1144. ****************************************************************************}
  1145. constructor tpropertysym.create(const n : string);
  1146. begin
  1147. inherited create(n);
  1148. typ:=propertysym;
  1149. propoptions:=[];
  1150. index:=0;
  1151. default:=0;
  1152. proptype.reset;
  1153. indextype.reset;
  1154. readaccess:=tsymlist.create;
  1155. writeaccess:=tsymlist.create;
  1156. storedaccess:=tsymlist.create;
  1157. end;
  1158. constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
  1159. begin
  1160. inherited loadsym(ppufile);
  1161. typ:=propertysym;
  1162. ppufile.getsmallset(propoptions);
  1163. if (ppo_is_override in propoptions) then
  1164. begin
  1165. propoverriden:=tpropertysym(ppufile.getderef);
  1166. { we need to have these objects initialized }
  1167. readaccess:=tsymlist.create;
  1168. writeaccess:=tsymlist.create;
  1169. storedaccess:=tsymlist.create;
  1170. end
  1171. else
  1172. begin
  1173. ppufile.gettype(proptype);
  1174. index:=ppufile.getlongint;
  1175. default:=ppufile.getlongint;
  1176. ppufile.gettype(indextype);
  1177. readaccess:=ppufile.getsymlist;
  1178. writeaccess:=ppufile.getsymlist;
  1179. storedaccess:=ppufile.getsymlist;
  1180. end;
  1181. end;
  1182. destructor tpropertysym.destroy;
  1183. begin
  1184. readaccess.free;
  1185. writeaccess.free;
  1186. storedaccess.free;
  1187. inherited destroy;
  1188. end;
  1189. function tpropertysym.gettypedef:tdef;
  1190. begin
  1191. gettypedef:=proptype.def;
  1192. end;
  1193. procedure tpropertysym.deref;
  1194. begin
  1195. if (ppo_is_override in propoptions) then
  1196. begin
  1197. resolvesym(pointer(propoverriden));
  1198. dooverride(propoverriden);
  1199. end
  1200. else
  1201. begin
  1202. proptype.resolve;
  1203. indextype.resolve;
  1204. readaccess.resolve;
  1205. writeaccess.resolve;
  1206. storedaccess.resolve;
  1207. end;
  1208. end;
  1209. function tpropertysym.getsize : longint;
  1210. begin
  1211. getsize:=0;
  1212. end;
  1213. procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
  1214. begin
  1215. inherited writesym(ppufile);
  1216. ppufile.putsmallset(propoptions);
  1217. if (ppo_is_override in propoptions) then
  1218. ppufile.putderef(propoverriden)
  1219. else
  1220. begin
  1221. ppufile.puttype(proptype);
  1222. ppufile.putlongint(index);
  1223. ppufile.putlongint(default);
  1224. ppufile.puttype(indextype);
  1225. ppufile.putsymlist(readaccess);
  1226. ppufile.putsymlist(writeaccess);
  1227. ppufile.putsymlist(storedaccess);
  1228. end;
  1229. ppufile.writeentry(ibpropertysym);
  1230. end;
  1231. procedure tpropertysym.dooverride(overriden:tpropertysym);
  1232. begin
  1233. propoverriden:=overriden;
  1234. proptype:=overriden.proptype;
  1235. propoptions:=overriden.propoptions+[ppo_is_override];
  1236. index:=overriden.index;
  1237. default:=overriden.default;
  1238. indextype:=overriden.indextype;
  1239. readaccess.free;
  1240. readaccess:=overriden.readaccess.getcopy;
  1241. writeaccess.free;
  1242. writeaccess:=overriden.writeaccess.getcopy;
  1243. storedaccess.free;
  1244. storedaccess:=overriden.storedaccess.getcopy;
  1245. end;
  1246. {$ifdef GDB}
  1247. function tpropertysym.stabstring : pchar;
  1248. begin
  1249. { !!!! don't know how to handle }
  1250. stabstring:=strpnew('');
  1251. end;
  1252. procedure tpropertysym.concatstabto(asmlist : taasmoutput);
  1253. begin
  1254. { !!!! don't know how to handle }
  1255. end;
  1256. {$endif GDB}
  1257. {****************************************************************************
  1258. TFUNCRETSYM
  1259. ****************************************************************************}
  1260. constructor tfuncretsym.create(const n : string;const tt:ttype);
  1261. begin
  1262. inherited create(n);
  1263. typ:=funcretsym;
  1264. returntype:=tt;
  1265. funcretstate:=vs_declared;
  1266. { address valid for ret in param only }
  1267. { otherwise set by insert }
  1268. address:=procinfo.return_offset;
  1269. end;
  1270. constructor tfuncretsym.ppuload(ppufile:tcompilerppufile);
  1271. begin
  1272. inherited loadsym(ppufile);
  1273. ppufile.gettype(returntype);
  1274. address:=ppufile.getlongint;
  1275. typ:=funcretsym;
  1276. end;
  1277. destructor tfuncretsym.destroy;
  1278. begin
  1279. inherited destroy;
  1280. end;
  1281. procedure tfuncretsym.ppuwrite(ppufile:tcompilerppufile);
  1282. begin
  1283. inherited writesym(ppufile);
  1284. ppufile.puttype(returntype);
  1285. ppufile.putlongint(address);
  1286. ppufile.writeentry(ibfuncretsym);
  1287. funcretstate:=vs_used;
  1288. end;
  1289. procedure tfuncretsym.deref;
  1290. begin
  1291. returntype.resolve;
  1292. end;
  1293. {$ifdef GDB}
  1294. procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
  1295. begin
  1296. { Nothing to do here, it is done in genexitcode }
  1297. end;
  1298. {$endif GDB}
  1299. {****************************************************************************
  1300. TABSOLUTESYM
  1301. ****************************************************************************}
  1302. constructor tabsolutesym.create(const n : string;const tt : ttype);
  1303. begin
  1304. inherited create(n,tt);
  1305. typ:=absolutesym;
  1306. end;
  1307. constructor tabsolutesym.ppuload(ppufile:tcompilerppufile);
  1308. begin
  1309. { Note: This needs to load everything of tvarsym.write }
  1310. inherited ppuload(ppufile);
  1311. { load absolute }
  1312. typ:=absolutesym;
  1313. ref:=nil;
  1314. address:=0;
  1315. asmname:=nil;
  1316. abstyp:=absolutetyp(ppufile.getbyte);
  1317. absseg:=false;
  1318. case abstyp of
  1319. tovar :
  1320. asmname:=stringdup(ppufile.getstring);
  1321. toasm :
  1322. asmname:=stringdup(ppufile.getstring);
  1323. toaddr :
  1324. begin
  1325. address:=ppufile.getlongint;
  1326. absseg:=boolean(ppufile.getbyte);
  1327. end;
  1328. end;
  1329. end;
  1330. procedure tabsolutesym.ppuwrite(ppufile:tcompilerppufile);
  1331. var
  1332. hvo : tvaroptions;
  1333. begin
  1334. { Note: This needs to write everything of tvarsym.write }
  1335. inherited writesym(ppufile);
  1336. ppufile.putbyte(byte(varspez));
  1337. ppufile.putlongint(address);
  1338. { write only definition or definitionsym }
  1339. ppufile.puttype(vartype);
  1340. hvo:=varoptions-[vo_regable];
  1341. ppufile.putsmallset(hvo);
  1342. ppufile.putbyte(byte(abstyp));
  1343. case abstyp of
  1344. tovar :
  1345. ppufile.putstring(ref.name);
  1346. toasm :
  1347. ppufile.putstring(asmname^);
  1348. toaddr :
  1349. begin
  1350. ppufile.putlongint(address);
  1351. ppufile.putbyte(byte(absseg));
  1352. end;
  1353. end;
  1354. ppufile.writeentry(ibabsolutesym);
  1355. end;
  1356. procedure tabsolutesym.deref;
  1357. var
  1358. srsym : tsym;
  1359. srsymtable : tsymtable;
  1360. begin
  1361. { inheritance of varsym.deref ! }
  1362. vartype.resolve;
  1363. { own absolute deref }
  1364. if (abstyp=tovar) and (asmname<>nil) then
  1365. begin
  1366. { search previous loaded symtables }
  1367. searchsym(asmname^,srsym,srsymtable);
  1368. if not assigned(srsym) then
  1369. srsym:=searchsymonlyin(owner,asmname^);
  1370. if not assigned(srsym) then
  1371. srsym:=generrorsym;
  1372. ref:=tstoredsym(srsym);
  1373. stringdispose(asmname);
  1374. end;
  1375. end;
  1376. function tabsolutesym.mangledname : string;
  1377. begin
  1378. case abstyp of
  1379. tovar :
  1380. begin
  1381. case ref.typ of
  1382. varsym :
  1383. mangledname:=tvarsym(ref).mangledname;
  1384. else
  1385. internalerror(200111011);
  1386. end;
  1387. end;
  1388. toasm :
  1389. mangledname:=asmname^;
  1390. toaddr :
  1391. mangledname:='$'+tostr(address);
  1392. else
  1393. internalerror(10002);
  1394. end;
  1395. end;
  1396. {$ifdef GDB}
  1397. procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
  1398. begin
  1399. { I don't know how to handle this !! }
  1400. end;
  1401. {$endif GDB}
  1402. {****************************************************************************
  1403. TVARSYM
  1404. ****************************************************************************}
  1405. constructor tvarsym.create(const n : string;const tt : ttype);
  1406. begin
  1407. inherited create(n);
  1408. typ:=varsym;
  1409. vartype:=tt;
  1410. _mangledname:=nil;
  1411. varspez:=vs_value;
  1412. address:=0;
  1413. localvarsym:=nil;
  1414. refs:=0;
  1415. varstate:=vs_used;
  1416. varoptions:=[];
  1417. { can we load the value into a register ? }
  1418. if tstoreddef(tt.def).is_intregable then
  1419. include(varoptions,vo_regable)
  1420. else
  1421. exclude(varoptions,vo_regable);
  1422. if tstoreddef(tt.def).is_fpuregable then
  1423. include(varoptions,vo_fpuregable)
  1424. else
  1425. exclude(varoptions,vo_fpuregable);
  1426. reg:=R_NO;
  1427. end;
  1428. constructor tvarsym.create_dll(const n : string;const tt : ttype);
  1429. begin
  1430. tvarsym(self).create(n,tt);
  1431. include(varoptions,vo_is_dll_var);
  1432. end;
  1433. constructor tvarsym.create_C(const n,mangled : string;const tt : ttype);
  1434. begin
  1435. tvarsym(self).create(n,tt);
  1436. stringdispose(_mangledname);
  1437. _mangledname:=stringdup(mangled);
  1438. end;
  1439. constructor tvarsym.ppuload(ppufile:tcompilerppufile);
  1440. begin
  1441. inherited loadsym(ppufile);
  1442. typ:=varsym;
  1443. reg:=R_NO;
  1444. refs := 0;
  1445. varstate:=vs_used;
  1446. varspez:=tvarspez(ppufile.getbyte);
  1447. address:=ppufile.getlongint;
  1448. localvarsym:=nil;
  1449. ppufile.gettype(vartype);
  1450. ppufile.getsmallset(varoptions);
  1451. if (vo_is_C_var in varoptions) then
  1452. _mangledname:=stringdup(ppufile.getstring);
  1453. end;
  1454. destructor tvarsym.destroy;
  1455. begin
  1456. {$ifdef var_notification}
  1457. if assigned(notifications) then
  1458. notifications.destroy;
  1459. {$endif}
  1460. inherited destroy;
  1461. end;
  1462. procedure tvarsym.deref;
  1463. begin
  1464. vartype.resolve;
  1465. end;
  1466. procedure tvarsym.ppuwrite(ppufile:tcompilerppufile);
  1467. var
  1468. hvo : tvaroptions;
  1469. begin
  1470. inherited writesym(ppufile);
  1471. ppufile.putbyte(byte(varspez));
  1472. ppufile.putlongint(address);
  1473. ppufile.puttype(vartype);
  1474. { symbols which are load are never candidates for a register,
  1475. turn off the regable }
  1476. hvo:=varoptions-[vo_regable,vo_fpuregable];
  1477. ppufile.putsmallset(hvo);
  1478. if (vo_is_C_var in varoptions) then
  1479. ppufile.putstring(mangledname);
  1480. ppufile.writeentry(ibvarsym);
  1481. end;
  1482. procedure tvarsym.generate_mangledname;
  1483. begin
  1484. _mangledname:=stringdup(mangledname_prefix('U',owner)+name);
  1485. end;
  1486. procedure tvarsym.set_mangledname(const s:string);
  1487. begin
  1488. stringdispose(_mangledname);
  1489. _mangledname:=stringdup(s);
  1490. end;
  1491. function tvarsym.getsize : longint;
  1492. begin
  1493. if assigned(vartype.def) then
  1494. getsize:=vartype.def.size
  1495. else
  1496. getsize:=0;
  1497. end;
  1498. function tvarsym.getvaluesize : longint;
  1499. begin
  1500. if assigned(vartype.def) and
  1501. (varspez=vs_value) and
  1502. ((vartype.def.deftype<>arraydef) or
  1503. tarraydef(vartype.def).isDynamicArray or
  1504. (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
  1505. getvaluesize:=vartype.def.size
  1506. else
  1507. getvaluesize:=0;
  1508. end;
  1509. {$ifdef var_notification}
  1510. function Tvarsym.register_notification(flags:Tnotification_flags;callback:
  1511. Tnotification_callback):cardinal;
  1512. var n:Tnotification;
  1513. begin
  1514. if not assigned(notifications) then
  1515. notifications:=Tlinkedlist.create;
  1516. n:=Tnotification.create(flags,callback);
  1517. register_notification:=n.id;
  1518. notifications.concat(n);
  1519. end;
  1520. {$endif}
  1521. {$ifdef GDB}
  1522. function tvarsym.stabstring : pchar;
  1523. var
  1524. st : string;
  1525. begin
  1526. st:=tstoreddef(vartype.def).numberstring;
  1527. if (owner.symtabletype = objectsymtable) and
  1528. (sp_static in symoptions) then
  1529. begin
  1530. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1531. stabstring := strpnew('"'+owner.name^+'__'+name+':'+st+
  1532. '",'+
  1533. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1534. end
  1535. else if (owner.symtabletype = globalsymtable) then
  1536. begin
  1537. { Here we used S instead of
  1538. because with G GDB doesn't look at the address field
  1539. but searches the same name or with a leading underscore
  1540. but these names don't exist in pascal !}
  1541. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1542. stabstring := strpnew('"'+name+':'+st+'",'+
  1543. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1544. end
  1545. else if owner.symtabletype = staticsymtable then
  1546. begin
  1547. stabstring := strpnew('"'+name+':S'+st+'",'+
  1548. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1549. end
  1550. else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
  1551. begin
  1552. case varspez of
  1553. vs_out,
  1554. vs_var : st := 'v'+st;
  1555. vs_value,
  1556. vs_const : if paramanager.push_addr_param(vartype.def,tprocdef(owner.defowner).proccalloption) then
  1557. st := 'v'+st { should be 'i' but 'i' doesn't work }
  1558. else
  1559. st := 'p'+st;
  1560. end;
  1561. stabstring := strpnew('"'+name+':'+st+'",'+
  1562. tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
  1563. tostr(address+owner.address_fixup));
  1564. {offset to ebp => will not work if the framepointer is esp
  1565. so some optimizing will make things harder to debug }
  1566. end
  1567. else if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) then
  1568. if reg<>R_NO then
  1569. begin
  1570. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1571. { this is the register order for GDB}
  1572. stabstring:=strpnew('"'+name+':r'+st+'",'+
  1573. tostr(N_RSYM)+',0,'+
  1574. tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
  1575. end
  1576. else
  1577. { I don't know if this will work (PM) }
  1578. if (vo_is_C_var in varoptions) then
  1579. stabstring := strpnew('"'+name+':S'+st+'",'+
  1580. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
  1581. else
  1582. stabstring := strpnew('"'+name+':'+st+'",'+
  1583. tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner.address_fixup))
  1584. else
  1585. stabstring := inherited stabstring;
  1586. end;
  1587. procedure tvarsym.concatstabto(asmlist : taasmoutput);
  1588. var stab_str : pchar;
  1589. begin
  1590. if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
  1591. (copy(name,1,6)='hidden') then
  1592. exit;
  1593. inherited concatstabto(asmlist);
  1594. if (owner.symtabletype=parasymtable) and
  1595. (reg<>R_NO) then
  1596. begin
  1597. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1598. { this is the register order for GDB}
  1599. stab_str:=strpnew('"'+name+':r'
  1600. +tstoreddef(vartype.def).numberstring+'",'+
  1601. tostr(N_RSYM)+',0,'+
  1602. tostr(fileinfo.line)+','+tostr(stab_regindex[reg]));
  1603. asmList.concat(Tai_stabs.Create(stab_str));
  1604. end;
  1605. end;
  1606. {$endif GDB}
  1607. {****************************************************************************
  1608. TTYPEDCONSTSYM
  1609. *****************************************************************************}
  1610. constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
  1611. begin
  1612. inherited create(n);
  1613. typ:=typedconstsym;
  1614. typedconsttype.setdef(p);
  1615. is_writable:=writable;
  1616. end;
  1617. constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
  1618. begin
  1619. inherited create(n);
  1620. typ:=typedconstsym;
  1621. typedconsttype:=tt;
  1622. is_writable:=writable;
  1623. end;
  1624. constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
  1625. begin
  1626. inherited loadsym(ppufile);
  1627. typ:=typedconstsym;
  1628. ppufile.gettype(typedconsttype);
  1629. is_writable:=boolean(ppufile.getbyte);
  1630. end;
  1631. destructor ttypedconstsym.destroy;
  1632. begin
  1633. inherited destroy;
  1634. end;
  1635. procedure ttypedconstsym.generate_mangledname;
  1636. begin
  1637. _mangledname:=stringdup(mangledname_prefix('TC',owner)+name);
  1638. end;
  1639. function ttypedconstsym.getsize : longint;
  1640. begin
  1641. if assigned(typedconsttype.def) then
  1642. getsize:=typedconsttype.def.size
  1643. else
  1644. getsize:=0;
  1645. end;
  1646. procedure ttypedconstsym.deref;
  1647. begin
  1648. typedconsttype.resolve;
  1649. end;
  1650. procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);
  1651. begin
  1652. inherited writesym(ppufile);
  1653. ppufile.puttype(typedconsttype);
  1654. ppufile.putbyte(byte(is_writable));
  1655. ppufile.writeentry(ibtypedconstsym);
  1656. end;
  1657. {$ifdef GDB}
  1658. function ttypedconstsym.stabstring : pchar;
  1659. var
  1660. st : char;
  1661. begin
  1662. if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then
  1663. st := 'G'
  1664. else
  1665. st := 'S';
  1666. stabstring := strpnew('"'+name+':'+st+
  1667. tstoreddef(typedconsttype.def).numberstring+'",'+tostr(n_STSYM)+',0,'+
  1668. tostr(fileinfo.line)+','+mangledname);
  1669. end;
  1670. {$endif GDB}
  1671. {****************************************************************************
  1672. TCONSTSYM
  1673. ****************************************************************************}
  1674. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
  1675. begin
  1676. inherited create(n);
  1677. fillchar(value, sizeof(value), #0);
  1678. typ:=constsym;
  1679. consttyp:=t;
  1680. value.valueord:=v;
  1681. ResStrIndex:=0;
  1682. consttype.reset;
  1683. end;
  1684. constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  1685. begin
  1686. inherited create(n);
  1687. fillchar(value, sizeof(value), #0);
  1688. typ:=constsym;
  1689. consttyp:=t;
  1690. value.valueord:=v;
  1691. ResStrIndex:=0;
  1692. consttype:=tt;
  1693. end;
  1694. constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  1695. begin
  1696. inherited create(n);
  1697. fillchar(value, sizeof(value), #0);
  1698. typ:=constsym;
  1699. consttyp:=t;
  1700. value.valueordptr:=v;
  1701. ResStrIndex:=0;
  1702. consttype:=tt;
  1703. end;
  1704. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
  1705. begin
  1706. inherited create(n);
  1707. fillchar(value, sizeof(value), #0);
  1708. typ:=constsym;
  1709. consttyp:=t;
  1710. value.valueptr:=v;
  1711. ResStrIndex:=0;
  1712. consttype.reset;
  1713. end;
  1714. constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  1715. begin
  1716. inherited create(n);
  1717. fillchar(value, sizeof(value), #0);
  1718. typ:=constsym;
  1719. consttyp:=t;
  1720. value.valueptr:=v;
  1721. ResStrIndex:=0;
  1722. consttype:=tt;
  1723. end;
  1724. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1725. begin
  1726. inherited create(n);
  1727. fillchar(value, sizeof(value), #0);
  1728. typ:=constsym;
  1729. consttyp:=t;
  1730. value.valueptr:=str;
  1731. consttype.reset;
  1732. value.len:=l;
  1733. if t=constresourcestring then
  1734. ResStrIndex:=ResourceStrings.Register(name,pchar(value.valueptr),value.len);
  1735. end;
  1736. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1737. var
  1738. pd : pbestreal;
  1739. ps : pnormalset;
  1740. pc : pchar;
  1741. begin
  1742. inherited loadsym(ppufile);
  1743. typ:=constsym;
  1744. consttype.reset;
  1745. consttyp:=tconsttyp(ppufile.getbyte);
  1746. fillchar(value, sizeof(value), #0);
  1747. case consttyp of
  1748. constint:
  1749. value.valueord:=ppufile.getexprint;
  1750. constwchar,
  1751. constbool,
  1752. constchar :
  1753. value.valueord:=ppufile.getlongint;
  1754. constord :
  1755. begin
  1756. ppufile.gettype(consttype);
  1757. value.valueord:=ppufile.getexprint;
  1758. end;
  1759. constpointer :
  1760. begin
  1761. ppufile.gettype(consttype);
  1762. value.valueordptr:=ppufile.getptruint;
  1763. end;
  1764. conststring,
  1765. constresourcestring :
  1766. begin
  1767. value.len:=ppufile.getlongint;
  1768. getmem(pc,value.len+1);
  1769. ppufile.getdata(pc^,value.len);
  1770. if consttyp=constresourcestring then
  1771. ResStrIndex:=ppufile.getlongint;
  1772. value.valueptr:=pc;
  1773. end;
  1774. constreal :
  1775. begin
  1776. new(pd);
  1777. pd^:=ppufile.getreal;
  1778. value.valueptr:=pd;
  1779. end;
  1780. constset :
  1781. begin
  1782. ppufile.gettype(consttype);
  1783. new(ps);
  1784. ppufile.getnormalset(ps^);
  1785. value.valueptr:=ps;
  1786. end;
  1787. constguid :
  1788. begin
  1789. new(pguid(value.valueptr));
  1790. ppufile.getdata(value.valueptr^,sizeof(tguid));
  1791. end;
  1792. constnil : ;
  1793. else
  1794. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1795. end;
  1796. end;
  1797. destructor tconstsym.destroy;
  1798. begin
  1799. case consttyp of
  1800. conststring,
  1801. constresourcestring :
  1802. freemem(pchar(value.valueptr),value.len+1);
  1803. constreal :
  1804. dispose(pbestreal(value.valueptr));
  1805. constset :
  1806. dispose(pnormalset(value.valueptr));
  1807. constguid :
  1808. dispose(pguid(value.valueptr));
  1809. end;
  1810. inherited destroy;
  1811. end;
  1812. function tconstsym.mangledname : string;
  1813. begin
  1814. mangledname:=name;
  1815. end;
  1816. procedure tconstsym.deref;
  1817. begin
  1818. if consttyp in [constord,constpointer,constset] then
  1819. consttype.resolve;
  1820. end;
  1821. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  1822. begin
  1823. inherited writesym(ppufile);
  1824. ppufile.putbyte(byte(consttyp));
  1825. case consttyp of
  1826. constnil : ;
  1827. constint:
  1828. ppufile.putexprint(value.valueord);
  1829. constbool,
  1830. constchar :
  1831. ppufile.putlongint(value.valueord);
  1832. constord :
  1833. begin
  1834. ppufile.puttype(consttype);
  1835. ppufile.putexprint(value.valueord);
  1836. end;
  1837. constpointer :
  1838. begin
  1839. ppufile.puttype(consttype);
  1840. ppufile.putptruint(value.valueordptr);
  1841. end;
  1842. conststring,
  1843. constresourcestring :
  1844. begin
  1845. ppufile.putlongint(value.len);
  1846. ppufile.putdata(pchar(value.valueptr)^,value.len);
  1847. if consttyp=constresourcestring then
  1848. ppufile.putlongint(ResStrIndex);
  1849. end;
  1850. constreal :
  1851. ppufile.putreal(pbestreal(value.valueptr)^);
  1852. constset :
  1853. begin
  1854. ppufile.puttype(consttype);
  1855. ppufile.putnormalset(value.valueptr^);
  1856. end;
  1857. constguid :
  1858. ppufile.putdata(value.valueptr^,sizeof(tguid));
  1859. else
  1860. internalerror(13);
  1861. end;
  1862. ppufile.writeentry(ibconstsym);
  1863. end;
  1864. {$ifdef GDB}
  1865. function tconstsym.stabstring : pchar;
  1866. var st : string;
  1867. begin
  1868. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  1869. case consttyp of
  1870. conststring : begin
  1871. st := 's'''+strpas(pchar(value.valueptr))+'''';
  1872. end;
  1873. constbool,
  1874. constint,
  1875. constord,
  1876. constchar : st := 'i'+int64tostr(value.valueord);
  1877. constpointer :
  1878. st := 'i'+int64tostr(value.valueordptr);
  1879. constreal : begin
  1880. system.str(pbestreal(value.valueptr)^,st);
  1881. st := 'r'+st;
  1882. end;
  1883. { if we don't know just put zero !! }
  1884. else st:='i0';
  1885. {***SETCONST}
  1886. {constset:;} {*** I don't know what to do with a set.}
  1887. { sets are not recognized by GDB}
  1888. {***}
  1889. end;
  1890. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  1891. tostr(fileinfo.line)+',0');
  1892. end;
  1893. procedure tconstsym.concatstabto(asmlist : taasmoutput);
  1894. begin
  1895. if consttyp <> conststring then
  1896. inherited concatstabto(asmlist);
  1897. end;
  1898. {$endif GDB}
  1899. {****************************************************************************
  1900. TENUMSYM
  1901. ****************************************************************************}
  1902. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  1903. begin
  1904. inherited create(n);
  1905. typ:=enumsym;
  1906. definition:=def;
  1907. value:=v;
  1908. { check for jumps }
  1909. if v>def.max+1 then
  1910. def.has_jumps:=true;
  1911. { update low and high }
  1912. if def.min>v then
  1913. def.setmin(v);
  1914. if def.max<v then
  1915. def.setmax(v);
  1916. order;
  1917. end;
  1918. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  1919. begin
  1920. inherited loadsym(ppufile);
  1921. typ:=enumsym;
  1922. definition:=tenumdef(ppufile.getderef);
  1923. value:=ppufile.getlongint;
  1924. nextenum := Nil;
  1925. end;
  1926. procedure tenumsym.deref;
  1927. begin
  1928. resolvedef(pointer(definition));
  1929. order;
  1930. end;
  1931. procedure tenumsym.order;
  1932. var
  1933. sym : tenumsym;
  1934. begin
  1935. sym := tenumsym(definition.firstenum);
  1936. if sym = nil then
  1937. begin
  1938. definition.firstenum := self;
  1939. nextenum := nil;
  1940. exit;
  1941. end;
  1942. { reorder the symbols in increasing value }
  1943. if value < sym.value then
  1944. begin
  1945. nextenum := sym;
  1946. definition.firstenum := self;
  1947. end
  1948. else
  1949. begin
  1950. while (sym.value <= value) and assigned(sym.nextenum) do
  1951. sym := sym.nextenum;
  1952. nextenum := sym.nextenum;
  1953. sym.nextenum := self;
  1954. end;
  1955. end;
  1956. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  1957. begin
  1958. inherited writesym(ppufile);
  1959. ppufile.putderef(definition);
  1960. ppufile.putlongint(value);
  1961. ppufile.writeentry(ibenumsym);
  1962. end;
  1963. {$ifdef GDB}
  1964. procedure tenumsym.concatstabto(asmlist : taasmoutput);
  1965. begin
  1966. {enum elements have no stab !}
  1967. end;
  1968. {$EndIf GDB}
  1969. {****************************************************************************
  1970. TTYPESYM
  1971. ****************************************************************************}
  1972. constructor ttypesym.create(const n : string;const tt : ttype);
  1973. begin
  1974. inherited create(n);
  1975. typ:=typesym;
  1976. restype:=tt;
  1977. {$ifdef GDB}
  1978. isusedinstab := false;
  1979. {$endif GDB}
  1980. { register the typesym for the definition }
  1981. if assigned(restype.def) and
  1982. (restype.def.deftype<>errordef) and
  1983. not(assigned(restype.def.typesym)) then
  1984. restype.def.typesym:=self;
  1985. end;
  1986. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  1987. begin
  1988. inherited loadsym(ppufile);
  1989. typ:=typesym;
  1990. {$ifdef GDB}
  1991. isusedinstab := false;
  1992. {$endif GDB}
  1993. ppufile.gettype(restype);
  1994. end;
  1995. function ttypesym.gettypedef:tdef;
  1996. begin
  1997. gettypedef:=restype.def;
  1998. end;
  1999. procedure ttypesym.deref;
  2000. begin
  2001. restype.resolve;
  2002. end;
  2003. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  2004. begin
  2005. inherited writesym(ppufile);
  2006. ppufile.puttype(restype);
  2007. ppufile.writeentry(ibtypesym);
  2008. end;
  2009. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  2010. begin
  2011. inherited load_references(ppufile,locals);
  2012. if (restype.def.deftype=recorddef) then
  2013. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  2014. if (restype.def.deftype=objectdef) then
  2015. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  2016. end;
  2017. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  2018. begin
  2019. if not inherited write_references(ppufile,locals) then
  2020. begin
  2021. { write address of this symbol if record or object
  2022. even if no real refs are there
  2023. because we need it for the symtable }
  2024. if (restype.def.deftype in [recorddef,objectdef]) then
  2025. begin
  2026. ppufile.putderef(self);
  2027. ppufile.writeentry(ibsymref);
  2028. end;
  2029. end;
  2030. write_references:=true;
  2031. if (restype.def.deftype=recorddef) then
  2032. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  2033. if (restype.def.deftype=objectdef) then
  2034. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  2035. end;
  2036. {$ifdef GDB}
  2037. function ttypesym.stabstring : pchar;
  2038. var
  2039. stabchar : string[2];
  2040. short : string;
  2041. begin
  2042. if restype.def.deftype in tagtypes then
  2043. stabchar := 'Tt'
  2044. else
  2045. stabchar := 't';
  2046. short := '"'+name+':'+stabchar+tstoreddef(restype.def).numberstring
  2047. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  2048. stabstring := strpnew(short);
  2049. end;
  2050. procedure ttypesym.concatstabto(asmlist : taasmoutput);
  2051. begin
  2052. {not stabs for forward defs }
  2053. if assigned(restype.def) then
  2054. if (restype.def.typesym = self) then
  2055. tstoreddef(restype.def).concatstabto(asmlist)
  2056. else
  2057. inherited concatstabto(asmlist);
  2058. end;
  2059. {$endif GDB}
  2060. {****************************************************************************
  2061. TSYSSYM
  2062. ****************************************************************************}
  2063. constructor tsyssym.create(const n : string;l : longint);
  2064. begin
  2065. inherited create(n);
  2066. typ:=syssym;
  2067. number:=l;
  2068. end;
  2069. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  2070. begin
  2071. inherited loadsym(ppufile);
  2072. typ:=syssym;
  2073. number:=ppufile.getlongint;
  2074. end;
  2075. destructor tsyssym.destroy;
  2076. begin
  2077. inherited destroy;
  2078. end;
  2079. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  2080. begin
  2081. inherited writesym(ppufile);
  2082. ppufile.putlongint(number);
  2083. ppufile.writeentry(ibsyssym);
  2084. end;
  2085. {$ifdef GDB}
  2086. procedure tsyssym.concatstabto(asmlist : taasmoutput);
  2087. begin
  2088. end;
  2089. {$endif GDB}
  2090. {****************************************************************************
  2091. TRTTISYM
  2092. ****************************************************************************}
  2093. constructor trttisym.create(const n:string;rt:trttitype);
  2094. const
  2095. prefix : array[trttitype] of string[5]=('$rtti','$init');
  2096. begin
  2097. inherited create(prefix[rt]+n);
  2098. typ:=rttisym;
  2099. lab:=nil;
  2100. rttityp:=rt;
  2101. end;
  2102. constructor trttisym.ppuload(ppufile:tcompilerppufile);
  2103. begin
  2104. inherited loadsym(ppufile);
  2105. typ:=rttisym;
  2106. lab:=nil;
  2107. rttityp:=trttitype(ppufile.getbyte);
  2108. end;
  2109. procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
  2110. begin
  2111. inherited writesym(ppufile);
  2112. ppufile.putbyte(byte(rttityp));
  2113. ppufile.writeentry(ibrttisym);
  2114. end;
  2115. function trttisym.mangledname : string;
  2116. const
  2117. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2118. var
  2119. s : string;
  2120. p : tsymtable;
  2121. begin
  2122. s:='';
  2123. p:=owner;
  2124. while assigned(p) and (p.symtabletype=localsymtable) do
  2125. begin
  2126. s:=s+'_'+p.defowner.name;
  2127. p:=p.defowner.owner;
  2128. end;
  2129. if not(p.symtabletype in [globalsymtable,staticsymtable]) then
  2130. internalerror(200108265);
  2131. mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
  2132. end;
  2133. function trttisym.get_label:tasmsymbol;
  2134. begin
  2135. { the label is always a global label }
  2136. if not assigned(lab) then
  2137. lab:=objectlibrary.newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
  2138. get_label:=lab;
  2139. end;
  2140. { persistent rtti generation }
  2141. procedure generate_rtti(p:tsym);
  2142. var
  2143. rsym : trttisym;
  2144. def : tstoreddef;
  2145. begin
  2146. { rtti can only be generated for classes that are always typesyms }
  2147. if not(p.typ=typesym) then
  2148. internalerror(200108261);
  2149. def:=tstoreddef(ttypesym(p).restype.def);
  2150. { only create rtti once for each definition }
  2151. if not(df_has_rttitable in def.defoptions) then
  2152. begin
  2153. { definition should be in the same symtable as the symbol }
  2154. if p.owner<>def.owner then
  2155. internalerror(200108262);
  2156. { create rttisym }
  2157. rsym:=trttisym.create(p.name,fullrtti);
  2158. p.owner.insert(rsym);
  2159. { register rttisym in definition }
  2160. include(def.defoptions,df_has_rttitable);
  2161. def.rttitablesym:=rsym;
  2162. { write rtti data }
  2163. def.write_child_rtti_data(fullrtti);
  2164. if (cs_create_smart in aktmoduleswitches) then
  2165. rttiList.concat(Tai_cut.Create);
  2166. rttilist.concat(tai_align.create(const_align(pointer_size)));
  2167. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2168. def.write_rtti_data(fullrtti);
  2169. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2170. end;
  2171. end;
  2172. { persistent init table generation }
  2173. procedure generate_inittable(p:tsym);
  2174. var
  2175. rsym : trttisym;
  2176. def : tstoreddef;
  2177. begin
  2178. { anonymous types are also allowed for records that can be varsym }
  2179. case p.typ of
  2180. typesym :
  2181. def:=tstoreddef(ttypesym(p).restype.def);
  2182. varsym :
  2183. def:=tstoreddef(tvarsym(p).vartype.def);
  2184. else
  2185. internalerror(200108263);
  2186. end;
  2187. { only create inittable once for each definition }
  2188. if not(df_has_inittable in def.defoptions) then
  2189. begin
  2190. { definition should be in the same symtable as the symbol }
  2191. if p.owner<>def.owner then
  2192. internalerror(200108264);
  2193. { create rttisym }
  2194. rsym:=trttisym.create(p.name,initrtti);
  2195. p.owner.insert(rsym);
  2196. { register rttisym in definition }
  2197. include(def.defoptions,df_has_inittable);
  2198. def.inittablesym:=rsym;
  2199. { write inittable data }
  2200. def.write_child_rtti_data(initrtti);
  2201. if (cs_create_smart in aktmoduleswitches) then
  2202. rttiList.concat(Tai_cut.Create);
  2203. rttilist.concat(tai_align.create(const_align(pointer_size)));
  2204. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2205. def.write_rtti_data(initrtti);
  2206. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2207. end;
  2208. end;
  2209. end.
  2210. {
  2211. $Log$
  2212. Revision 1.85 2002-12-27 18:07:44 peter
  2213. * fix crashes when searching symbols
  2214. Revision 1.84 2002/12/20 16:02:22 peter
  2215. * fix stupid copy&paste bug in binary operator search
  2216. Revision 1.83 2002/12/16 22:08:31 peter
  2217. * fix order of procdefs in procsym, procdefs are now always appended
  2218. so that loading from a ppu will keep the same order. This is
  2219. important for the generation of VMTs
  2220. Revision 1.82 2002/12/11 22:39:23 peter
  2221. * better error message when no operator is found for equal
  2222. Revision 1.81 2002/12/07 14:27:10 carl
  2223. * 3% memory optimization
  2224. * changed some types
  2225. + added type checking with different size for call node and for
  2226. parameters
  2227. Revision 1.80 2002/12/06 17:51:11 peter
  2228. * merged cdecl and array fixes
  2229. Revision 1.79 2002/11/27 20:04:10 peter
  2230. * tvarsym.get_push_size replaced by paramanager.push_size
  2231. Revision 1.78 2002/11/27 02:34:20 peter
  2232. * only find real equal procvars
  2233. Revision 1.77 2002/11/25 18:43:34 carl
  2234. - removed the invalid if <> checking (Delphi is strange on this)
  2235. + implemented abstract warning on instance creation of class with
  2236. abstract methods.
  2237. * some error message cleanups
  2238. Revision 1.76 2002/11/25 17:43:26 peter
  2239. * splitted defbase in defutil,symutil,defcmp
  2240. * merged isconvertable and is_equal into compare_defs(_ext)
  2241. * made operator search faster by walking the list only once
  2242. Revision 1.75 2002/11/23 22:50:09 carl
  2243. * some small speed optimizations
  2244. + added several new warnings/hints
  2245. Revision 1.74 2002/11/22 22:48:11 carl
  2246. * memory optimization with tconstsym (1.5%)
  2247. Revision 1.73 2002/11/18 17:31:59 peter
  2248. * pass proccalloption to ret_in_xxx and push_xxx functions
  2249. Revision 1.72 2002/11/17 16:31:57 carl
  2250. * memory optimization (3-4%) : cleanup of tai fields,
  2251. cleanup of tdef and tsym fields.
  2252. * make it work for m68k
  2253. Revision 1.71 2002/11/09 15:30:07 carl
  2254. + align RTTI tables
  2255. Revision 1.70 2002/10/13 21:33:37 peter
  2256. * give correct fileposition for undefined forward procs
  2257. Revision 1.69 2002/10/05 12:43:29 carl
  2258. * fixes for Delphi 6 compilation
  2259. (warning : Some features do not work under Delphi)
  2260. Revision 1.68 2002/10/05 00:52:20 peter
  2261. * split boolean check in two lines for easier debugging
  2262. Revision 1.67 2002/09/26 12:04:53 florian
  2263. + constsym with type=constguid can be written to ppu now,
  2264. fixes web bug 1820
  2265. Revision 1.66 2002/09/16 14:11:13 peter
  2266. * add argument to equal_paras() to support default values or not
  2267. Revision 1.65 2002/09/09 17:34:16 peter
  2268. * tdicationary.replace added to replace and item in a dictionary. This
  2269. is only allowed for the same name
  2270. * varsyms are inserted in symtable before the types are parsed. This
  2271. fixes the long standing "var longint : longint" bug
  2272. - consume_idlist and idstringlist removed. The loops are inserted
  2273. at the callers place and uses the symtable for duplicate id checking
  2274. Revision 1.64 2002/09/08 11:10:17 carl
  2275. * bugfix 2109 (bad imho, but only way)
  2276. Revision 1.63 2002/09/07 18:17:41 florian
  2277. + tvarsym.paraitem added
  2278. Revision 1.62 2002/09/07 15:25:10 peter
  2279. * old logs removed and tabs fixed
  2280. Revision 1.61 2002/09/05 19:29:45 peter
  2281. * memdebug enhancements
  2282. Revision 1.60 2002/09/05 14:51:42 peter
  2283. * internalerror instead of crash in getprocdef
  2284. Revision 1.59 2002/09/03 16:26:27 daniel
  2285. * Make Tprocdef.defs protected
  2286. Revision 1.58 2002/09/01 08:01:16 daniel
  2287. * Removed sets from Tcallnode.det_resulttype
  2288. + Added read/write notifications of variables. These will be usefull
  2289. for providing information for several optimizations. For example
  2290. the value of the loop variable of a for loop does matter is the
  2291. variable is read after the for loop, but if it's no longer used
  2292. or written, it doesn't matter and this can be used to optimize
  2293. the loop code generation.
  2294. Revision 1.57 2002/08/25 19:25:21 peter
  2295. * sym.insert_in_data removed
  2296. * symtable.insertvardata/insertconstdata added
  2297. * removed insert_in_data call from symtable.insert, it needs to be
  2298. called separatly. This allows to deref the address calculation
  2299. * procedures now calculate the parast addresses after the procedure
  2300. directives are parsed. This fixes the cdecl parast problem
  2301. * push_addr_param has an extra argument that specifies if cdecl is used
  2302. or not
  2303. Revision 1.56 2002/08/25 09:06:21 peter
  2304. * fixed loop in concat_procdefs
  2305. Revision 1.55 2002/08/20 16:54:40 peter
  2306. * write address of varsym always
  2307. Revision 1.54 2002/08/20 10:31:26 daniel
  2308. * Tcallnode.det_resulttype rewritten
  2309. Revision 1.53 2002/08/18 20:06:27 peter
  2310. * inlining is now also allowed in interface
  2311. * renamed write/load to ppuwrite/ppuload
  2312. * tnode storing in ppu
  2313. * nld,ncon,nbas are already updated for storing in ppu
  2314. Revision 1.52 2002/08/17 09:23:42 florian
  2315. * first part of procinfo rewrite
  2316. Revision 1.51 2002/08/16 14:24:59 carl
  2317. * issameref() to test if two references are the same (then emit no opcodes)
  2318. + ret_in_reg to replace ret_in_acc
  2319. (fix some register allocation bugs at the same time)
  2320. + save_std_register now has an extra parameter which is the
  2321. usedinproc registers
  2322. Revision 1.50 2002/08/13 21:40:57 florian
  2323. * more fixes for ppc calling conventions
  2324. Revision 1.49 2002/08/12 15:08:40 carl
  2325. + stab register indexes for powerpc (moved from gdb to cpubase)
  2326. + tprocessor enumeration moved to cpuinfo
  2327. + linker in target_info is now a class
  2328. * many many updates for m68k (will soon start to compile)
  2329. - removed some ifdef or correct them for correct cpu
  2330. Revision 1.48 2002/08/11 14:32:28 peter
  2331. * renamed current_library to objectlibrary
  2332. Revision 1.47 2002/08/11 13:24:14 peter
  2333. * saving of asmsymbols in ppu supported
  2334. * asmsymbollist global is removed and moved into a new class
  2335. tasmlibrarydata that will hold the info of a .a file which
  2336. corresponds with a single module. Added librarydata to tmodule
  2337. to keep the library info stored for the module. In the future the
  2338. objectfiles will also be stored to the tasmlibrarydata class
  2339. * all getlabel/newasmsymbol and friends are moved to the new class
  2340. Revision 1.46 2002/07/23 10:13:23 daniel
  2341. * Added important comment
  2342. Revision 1.45 2002/07/23 09:51:26 daniel
  2343. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2344. are worth comitting.
  2345. Revision 1.44 2002/07/20 17:45:29 daniel
  2346. * Register variables are now possible for global variables too. This is
  2347. important for small programs without procedures.
  2348. Revision 1.43 2002/07/20 11:57:58 florian
  2349. * types.pas renamed to defbase.pas because D6 contains a types
  2350. unit so this would conflicts if D6 programms are compiled
  2351. + Willamette/SSE2 instructions to assembler added
  2352. Revision 1.42 2002/07/11 14:41:31 florian
  2353. * start of the new generic parameter handling
  2354. }