symsym.pas 87 KB

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