symsym.pas 79 KB

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