symsym.pas 91 KB

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