symsym.pas 79 KB

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