symsym.pas 80 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707
  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,false);
  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_used;
  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. begin
  1291. {$ifdef x86}
  1292. if use_sse(vartype.def) then
  1293. varregable:=vr_mmreg
  1294. else
  1295. {$else x86}
  1296. varregable:=vr_fpureg;
  1297. {$endif x86}
  1298. end;
  1299. end;
  1300. end;
  1301. {****************************************************************************
  1302. TFIELDVARSYM
  1303. ****************************************************************************}
  1304. constructor tfieldvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1305. begin
  1306. inherited create(n,vsp,tt,vopts);
  1307. typ:=fieldvarsym;
  1308. fieldoffset:=0;
  1309. end;
  1310. constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
  1311. begin
  1312. inherited ppuload(ppufile);
  1313. typ:=fieldvarsym;
  1314. fieldoffset:=ppufile.getaint;
  1315. end;
  1316. procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
  1317. begin
  1318. inherited ppuwrite(ppufile);
  1319. ppufile.putaint(fieldoffset);
  1320. ppufile.writeentry(ibfieldvarsym);
  1321. end;
  1322. {$ifdef GDB}
  1323. function tfieldvarsym.stabstring:Pchar;
  1324. var
  1325. st : string;
  1326. begin
  1327. stabstring:=nil;
  1328. case owner.symtabletype of
  1329. objectsymtable :
  1330. begin
  1331. if (sp_static in symoptions) then
  1332. begin
  1333. st:=tstoreddef(vartype.def).numberstring;
  1334. if (cs_gdb_gsym in aktglobalswitches) then
  1335. st:='G'+st
  1336. else
  1337. st:='S'+st;
  1338. stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}',[st]);
  1339. end;
  1340. end;
  1341. end;
  1342. end;
  1343. {$endif GDB}
  1344. {****************************************************************************
  1345. TABSTRACTNORMALVARSYM
  1346. ****************************************************************************}
  1347. constructor tabstractnormalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1348. begin
  1349. inherited create(n,vsp,tt,vopts);
  1350. fillchar(localloc,sizeof(localloc),0);
  1351. defaultconstsym:=nil;
  1352. end;
  1353. constructor tabstractnormalvarsym.ppuload(ppufile:tcompilerppufile);
  1354. begin
  1355. inherited ppuload(ppufile);
  1356. fillchar(localloc,sizeof(localloc),0);
  1357. ppufile.getderef(defaultconstsymderef);
  1358. end;
  1359. procedure tabstractnormalvarsym.buildderef;
  1360. begin
  1361. inherited buildderef;
  1362. defaultconstsymderef.build(defaultconstsym);
  1363. end;
  1364. procedure tabstractnormalvarsym.deref;
  1365. begin
  1366. inherited deref;
  1367. defaultconstsym:=tsym(defaultconstsymderef.resolve);
  1368. end;
  1369. procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1370. begin
  1371. inherited ppuwrite(ppufile);
  1372. ppufile.putderef(defaultconstsymderef);
  1373. end;
  1374. {****************************************************************************
  1375. TGLOBALVARSYM
  1376. ****************************************************************************}
  1377. constructor tglobalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1378. begin
  1379. inherited create(n,vsp,tt,vopts);
  1380. typ:=globalvarsym;
  1381. _mangledname:=nil;
  1382. end;
  1383. constructor tglobalvarsym.create_dll(const n : string;vsp:tvarspez;const tt : ttype);
  1384. begin
  1385. tglobalvarsym(self).create(n,vsp,tt,[vo_is_dll_var]);
  1386. end;
  1387. constructor tglobalvarsym.create_C(const n,mangled : string;vsp:tvarspez;const tt : ttype);
  1388. begin
  1389. tglobalvarsym(self).create(n,vsp,tt,[]);
  1390. set_mangledname(mangled);
  1391. end;
  1392. constructor tglobalvarsym.ppuload(ppufile:tcompilerppufile);
  1393. begin
  1394. inherited ppuload(ppufile);
  1395. typ:=globalvarsym;
  1396. if vo_has_mangledname in varoptions then
  1397. _mangledname:=stringdup(ppufile.getstring)
  1398. else
  1399. _mangledname:=nil;
  1400. end;
  1401. destructor tglobalvarsym.destroy;
  1402. begin
  1403. if assigned(_mangledname) then
  1404. begin
  1405. {$ifdef MEMDEBUG}
  1406. memmanglednames.start;
  1407. {$endif MEMDEBUG}
  1408. stringdispose(_mangledname);
  1409. {$ifdef MEMDEBUG}
  1410. memmanglednames.stop;
  1411. {$endif MEMDEBUG}
  1412. end;
  1413. inherited destroy;
  1414. end;
  1415. procedure tglobalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1416. begin
  1417. inherited ppuwrite(ppufile);
  1418. if vo_has_mangledname in varoptions then
  1419. ppufile.putstring(_mangledname^);
  1420. ppufile.writeentry(ibglobalvarsym);
  1421. end;
  1422. function tglobalvarsym.mangledname:string;
  1423. begin
  1424. if not assigned(_mangledname) then
  1425. begin
  1426. {$ifdef compress}
  1427. _mangledname:=stringdup(minilzw_encode(make_mangledname('U',owner,name)));
  1428. {$else}
  1429. _mangledname:=stringdup(make_mangledname('U',owner,name));
  1430. {$endif}
  1431. end;
  1432. result:=_mangledname^;
  1433. end;
  1434. procedure tglobalvarsym.set_mangledname(const s:string);
  1435. begin
  1436. stringdispose(_mangledname);
  1437. {$ifdef compress}
  1438. _mangledname:=stringdup(minilzw_encode(s));
  1439. {$else}
  1440. _mangledname:=stringdup(s);
  1441. {$endif}
  1442. include(varoptions,vo_has_mangledname);
  1443. end;
  1444. {$ifdef GDB}
  1445. function Tglobalvarsym.stabstring:Pchar;
  1446. var st:string;
  1447. threadvaroffset:string;
  1448. regidx:Tregisterindex;
  1449. begin
  1450. result:=nil;
  1451. st:=tstoreddef(vartype.def).numberstring;
  1452. case localloc.loc of
  1453. LOC_REGISTER,
  1454. LOC_CREGISTER,
  1455. LOC_MMREGISTER,
  1456. LOC_CMMREGISTER,
  1457. LOC_FPUREGISTER,
  1458. LOC_CFPUREGISTER :
  1459. begin
  1460. regidx:=findreg_by_number(localloc.register);
  1461. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1462. { this is the register order for GDB}
  1463. if regidx<>0 then
  1464. stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
  1465. end;
  1466. else
  1467. begin
  1468. if (vo_is_thread_var in varoptions) then
  1469. threadvaroffset:='+'+tostr(sizeof(aint))
  1470. else
  1471. threadvaroffset:='';
  1472. { Here we used S instead of
  1473. because with G GDB doesn't look at the address field
  1474. but searches the same name or with a leading underscore
  1475. but these names don't exist in pascal !}
  1476. if (cs_gdb_gsym in aktglobalswitches) then
  1477. st:='G'+st
  1478. else
  1479. st:='S'+st;
  1480. stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
  1481. end;
  1482. end;
  1483. end;
  1484. {$endif GDB}
  1485. {****************************************************************************
  1486. TLOCALVARSYM
  1487. ****************************************************************************}
  1488. constructor tlocalvarsym.create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1489. begin
  1490. inherited create(n,vsp,tt,vopts);
  1491. typ:=localvarsym;
  1492. end;
  1493. constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile);
  1494. begin
  1495. inherited ppuload(ppufile);
  1496. typ:=localvarsym;
  1497. end;
  1498. procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile);
  1499. begin
  1500. inherited ppuwrite(ppufile);
  1501. ppufile.writeentry(iblocalvarsym);
  1502. end;
  1503. {$ifdef GDB}
  1504. function tlocalvarsym.stabstring:Pchar;
  1505. var st:string;
  1506. regidx:Tregisterindex;
  1507. begin
  1508. stabstring:=nil;
  1509. { There is no space allocated for not referenced locals }
  1510. if (owner.symtabletype=localsymtable) and (refs=0) then
  1511. exit;
  1512. st:=tstoreddef(vartype.def).numberstring;
  1513. case localloc.loc of
  1514. LOC_REGISTER,
  1515. LOC_CREGISTER,
  1516. LOC_MMREGISTER,
  1517. LOC_CMMREGISTER,
  1518. LOC_FPUREGISTER,
  1519. LOC_CFPUREGISTER :
  1520. begin
  1521. regidx:=findreg_by_number(localloc.register);
  1522. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1523. { this is the register order for GDB}
  1524. if regidx<>0 then
  1525. stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
  1526. end;
  1527. LOC_REFERENCE :
  1528. { offset to ebp => will not work if the framepointer is esp
  1529. so some optimizing will make things harder to debug }
  1530. stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
  1531. else
  1532. internalerror(2003091814);
  1533. end;
  1534. end;
  1535. {$endif GDB}
  1536. {****************************************************************************
  1537. TPARAVARSYM
  1538. ****************************************************************************}
  1539. constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
  1540. begin
  1541. inherited create(n,vsp,tt,vopts);
  1542. typ:=paravarsym;
  1543. paranr:=nr;
  1544. paraloc[calleeside].init;
  1545. paraloc[callerside].init;
  1546. end;
  1547. destructor tparavarsym.destroy;
  1548. begin
  1549. paraloc[calleeside].done;
  1550. paraloc[callerside].done;
  1551. inherited destroy;
  1552. end;
  1553. constructor tparavarsym.ppuload(ppufile:tcompilerppufile);
  1554. var
  1555. b : byte;
  1556. begin
  1557. inherited ppuload(ppufile);
  1558. paranr:=ppufile.getword;
  1559. paraloc[calleeside].init;
  1560. paraloc[callerside].init;
  1561. if vo_has_explicit_paraloc in varoptions then
  1562. begin
  1563. b:=ppufile.getbyte;
  1564. if b<>sizeof(paraloc[callerside].location^) then
  1565. internalerror(200411154);
  1566. ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^));
  1567. paraloc[callerside].size:=paraloc[callerside].location^.size;
  1568. paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size];
  1569. end;
  1570. typ:=paravarsym;
  1571. end;
  1572. procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile);
  1573. begin
  1574. inherited ppuwrite(ppufile);
  1575. ppufile.putword(paranr);
  1576. if vo_has_explicit_paraloc in varoptions then
  1577. begin
  1578. paraloc[callerside].check_simple_location;
  1579. ppufile.putbyte(sizeof(paraloc[callerside].location^));
  1580. ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^));
  1581. end;
  1582. ppufile.writeentry(ibparavarsym);
  1583. end;
  1584. {$ifdef GDB}
  1585. function tparavarsym.stabstring:Pchar;
  1586. var st:string;
  1587. regidx:Tregisterindex;
  1588. c:char;
  1589. begin
  1590. result:=nil;
  1591. { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
  1592. { while stabs aren't adapted for regvars yet }
  1593. if (vo_is_self in varoptions) then
  1594. begin
  1595. case localloc.loc of
  1596. LOC_REGISTER,
  1597. LOC_CREGISTER:
  1598. regidx:=findreg_by_number(localloc.register);
  1599. LOC_REFERENCE: ;
  1600. else
  1601. internalerror(2003091815);
  1602. end;
  1603. if (po_classmethod in current_procinfo.procdef.procoptions) or
  1604. (po_staticmethod in current_procinfo.procdef.procoptions) then
  1605. begin
  1606. if (localloc.loc=LOC_REFERENCE) then
  1607. stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
  1608. [Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)]);
  1609. (* else
  1610. stabstring:=stabstr_evaluate('"pvmt:r$1",${N_RSYM},0,0,$2',
  1611. [Tstoreddef(pvmttype.def).numberstring,tostr(regstabs_table[regidx])]) *)
  1612. end
  1613. else
  1614. begin
  1615. if not(is_class(current_procinfo.procdef._class)) then
  1616. c:='v'
  1617. else
  1618. c:='p';
  1619. if (localloc.loc=LOC_REFERENCE) then
  1620. stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
  1621. [c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]);
  1622. (* else
  1623. stabstring:=stabstr_evaluate('"$$t:r$1",${N_RSYM},0,0,$2',
  1624. [c+current_procinfo.procdef._class.numberstring,tostr(regstabs_table[regidx])]); *)
  1625. end;
  1626. end
  1627. else
  1628. begin
  1629. st:=tstoreddef(vartype.def).numberstring;
  1630. if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
  1631. not(vo_has_local_copy in varoptions) and
  1632. not is_open_string(vartype.def) then
  1633. st := 'v'+st { should be 'i' but 'i' doesn't work }
  1634. else
  1635. st := 'p'+st;
  1636. case localloc.loc of
  1637. LOC_REGISTER,
  1638. LOC_CREGISTER,
  1639. LOC_MMREGISTER,
  1640. LOC_CMMREGISTER,
  1641. LOC_FPUREGISTER,
  1642. LOC_CFPUREGISTER :
  1643. begin
  1644. regidx:=findreg_by_number(localloc.register);
  1645. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1646. { this is the register order for GDB}
  1647. if regidx<>0 then
  1648. stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
  1649. end;
  1650. LOC_REFERENCE :
  1651. { offset to ebp => will not work if the framepointer is esp
  1652. so some optimizing will make things harder to debug }
  1653. stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
  1654. else
  1655. internalerror(2003091814);
  1656. end;
  1657. end;
  1658. end;
  1659. {$endif GDB}
  1660. {****************************************************************************
  1661. TABSOLUTEVARSYM
  1662. ****************************************************************************}
  1663. constructor tabsolutevarsym.create(const n : string;const tt : ttype);
  1664. begin
  1665. inherited create(n,vs_value,tt,[]);
  1666. typ:=absolutevarsym;
  1667. ref:=nil;
  1668. end;
  1669. constructor tabsolutevarsym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);
  1670. begin
  1671. inherited create(n,vs_value,tt,[]);
  1672. typ:=absolutevarsym;
  1673. ref:=_ref;
  1674. end;
  1675. destructor tabsolutevarsym.destroy;
  1676. begin
  1677. if assigned(ref) then
  1678. ref.free;
  1679. inherited destroy;
  1680. end;
  1681. constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile);
  1682. begin
  1683. inherited ppuload(ppufile);
  1684. typ:=absolutevarsym;
  1685. ref:=nil;
  1686. asmname:=nil;
  1687. abstyp:=absolutetyp(ppufile.getbyte);
  1688. {$ifdef i386}
  1689. absseg:=false;
  1690. {$endif i386}
  1691. case abstyp of
  1692. tovar :
  1693. ref:=ppufile.getsymlist;
  1694. toasm :
  1695. asmname:=stringdup(ppufile.getstring);
  1696. toaddr :
  1697. begin
  1698. addroffset:=ppufile.getaint;
  1699. {$ifdef i386}
  1700. absseg:=boolean(ppufile.getbyte);
  1701. {$endif i386}
  1702. end;
  1703. end;
  1704. end;
  1705. procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile);
  1706. begin
  1707. inherited ppuwrite(ppufile);
  1708. ppufile.putbyte(byte(abstyp));
  1709. case abstyp of
  1710. tovar :
  1711. ppufile.putsymlist(ref);
  1712. toasm :
  1713. ppufile.putstring(asmname^);
  1714. toaddr :
  1715. begin
  1716. ppufile.putaint(addroffset);
  1717. {$ifdef i386}
  1718. ppufile.putbyte(byte(absseg));
  1719. {$endif i386}
  1720. end;
  1721. end;
  1722. ppufile.writeentry(ibabsolutevarsym);
  1723. end;
  1724. procedure tabsolutevarsym.buildderef;
  1725. begin
  1726. inherited buildderef;
  1727. if (abstyp=tovar) then
  1728. ref.buildderef;
  1729. end;
  1730. procedure tabsolutevarsym.deref;
  1731. begin
  1732. inherited deref;
  1733. { own absolute deref }
  1734. if (abstyp=tovar) then
  1735. ref.resolve;
  1736. end;
  1737. function tabsolutevarsym.mangledname : string;
  1738. begin
  1739. case abstyp of
  1740. toasm :
  1741. mangledname:=asmname^;
  1742. toaddr :
  1743. mangledname:='$'+tostr(addroffset);
  1744. else
  1745. internalerror(200411061);
  1746. end;
  1747. end;
  1748. {$ifdef GDB}
  1749. function tabsolutevarsym.stabstring:Pchar;
  1750. begin
  1751. stabstring:=nil;
  1752. end;
  1753. {$endif GDB}
  1754. {****************************************************************************
  1755. TTYPEDCONSTSYM
  1756. *****************************************************************************}
  1757. constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
  1758. begin
  1759. inherited create(n);
  1760. typ:=typedconstsym;
  1761. typedconsttype.setdef(p);
  1762. is_writable:=writable;
  1763. end;
  1764. constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
  1765. begin
  1766. inherited create(n);
  1767. typ:=typedconstsym;
  1768. typedconsttype:=tt;
  1769. is_writable:=writable;
  1770. end;
  1771. constructor ttypedconstsym.ppuload(ppufile:tcompilerppufile);
  1772. begin
  1773. inherited ppuload(ppufile);
  1774. typ:=typedconstsym;
  1775. ppufile.gettype(typedconsttype);
  1776. is_writable:=boolean(ppufile.getbyte);
  1777. end;
  1778. destructor ttypedconstsym.destroy;
  1779. begin
  1780. if assigned(_mangledname) then
  1781. begin
  1782. {$ifdef MEMDEBUG}
  1783. memmanglednames.start;
  1784. {$endif MEMDEBUG}
  1785. stringdispose(_mangledname);
  1786. {$ifdef MEMDEBUG}
  1787. memmanglednames.stop;
  1788. {$endif MEMDEBUG}
  1789. end;
  1790. inherited destroy;
  1791. end;
  1792. function ttypedconstsym.mangledname:string;
  1793. begin
  1794. if not assigned(_mangledname) then
  1795. begin
  1796. {$ifdef compress}
  1797. _mangledname:=stringdup(make_mangledname('TC',owner,name));
  1798. {$else}
  1799. _mangledname:=stringdup(make_mangledname('TC',owner,name));
  1800. {$endif}
  1801. end;
  1802. result:=_mangledname^;
  1803. end;
  1804. function ttypedconstsym.getsize : longint;
  1805. begin
  1806. if assigned(typedconsttype.def) then
  1807. getsize:=typedconsttype.def.size
  1808. else
  1809. getsize:=0;
  1810. end;
  1811. procedure ttypedconstsym.buildderef;
  1812. begin
  1813. typedconsttype.buildderef;
  1814. end;
  1815. procedure ttypedconstsym.deref;
  1816. begin
  1817. typedconsttype.resolve;
  1818. end;
  1819. procedure ttypedconstsym.ppuwrite(ppufile:tcompilerppufile);
  1820. begin
  1821. inherited ppuwrite(ppufile);
  1822. ppufile.puttype(typedconsttype);
  1823. ppufile.putbyte(byte(is_writable));
  1824. ppufile.writeentry(ibtypedconstsym);
  1825. end;
  1826. {$ifdef GDB}
  1827. function ttypedconstsym.stabstring : pchar;
  1828. var st:char;
  1829. begin
  1830. if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then
  1831. st:='G'
  1832. else
  1833. st:='S';
  1834. stabstring:=stabstr_evaluate('"${name}:$1$2",${N_STSYM},0,${line},${mangledname}',
  1835. [st,Tstoreddef(typedconsttype.def).numberstring]);
  1836. end;
  1837. {$endif GDB}
  1838. {****************************************************************************
  1839. TCONSTSYM
  1840. ****************************************************************************}
  1841. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  1842. begin
  1843. inherited create(n);
  1844. fillchar(value, sizeof(value), #0);
  1845. typ:=constsym;
  1846. consttyp:=t;
  1847. value.valueord:=v;
  1848. ResStrIndex:=0;
  1849. consttype:=tt;
  1850. end;
  1851. constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  1852. begin
  1853. inherited create(n);
  1854. fillchar(value, sizeof(value), #0);
  1855. typ:=constsym;
  1856. consttyp:=t;
  1857. value.valueordptr:=v;
  1858. ResStrIndex:=0;
  1859. consttype:=tt;
  1860. end;
  1861. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  1862. begin
  1863. inherited create(n);
  1864. fillchar(value, sizeof(value), #0);
  1865. typ:=constsym;
  1866. consttyp:=t;
  1867. value.valueptr:=v;
  1868. ResStrIndex:=0;
  1869. consttype:=tt;
  1870. end;
  1871. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1872. begin
  1873. inherited create(n);
  1874. fillchar(value, sizeof(value), #0);
  1875. typ:=constsym;
  1876. consttyp:=t;
  1877. value.valueptr:=str;
  1878. consttype.reset;
  1879. value.len:=l;
  1880. if t=constresourcestring then
  1881. ResStrIndex:=al_resourcestrings.Register(name,pchar(value.valueptr),value.len);
  1882. end;
  1883. constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
  1884. begin
  1885. inherited create(n);
  1886. fillchar(value, sizeof(value), #0);
  1887. typ:=constsym;
  1888. consttyp:=t;
  1889. pcompilerwidestring(value.valueptr):=pw;
  1890. consttype.reset;
  1891. value.len:=getlengthwidestring(pw);
  1892. end;
  1893. constructor tconstsym.ppuload(ppufile:tcompilerppufile);
  1894. var
  1895. pd : pbestreal;
  1896. ps : pnormalset;
  1897. pc : pchar;
  1898. pw : pcompilerwidestring;
  1899. begin
  1900. inherited ppuload(ppufile);
  1901. typ:=constsym;
  1902. consttype.reset;
  1903. consttyp:=tconsttyp(ppufile.getbyte);
  1904. fillchar(value, sizeof(value), #0);
  1905. case consttyp of
  1906. constord :
  1907. begin
  1908. ppufile.gettype(consttype);
  1909. value.valueord:=ppufile.getexprint;
  1910. end;
  1911. constpointer :
  1912. begin
  1913. ppufile.gettype(consttype);
  1914. value.valueordptr:=ppufile.getptruint;
  1915. end;
  1916. constwstring :
  1917. begin
  1918. initwidestring(pw);
  1919. setlengthwidestring(pw,ppufile.getlongint);
  1920. ppufile.getdata(pw^.data,pw^.len*sizeof(tcompilerwidechar));
  1921. pcompilerwidestring(value.valueptr):=pw;
  1922. end;
  1923. conststring,
  1924. constresourcestring :
  1925. begin
  1926. value.len:=ppufile.getlongint;
  1927. getmem(pc,value.len+1);
  1928. ppufile.getdata(pc^,value.len);
  1929. if consttyp=constresourcestring then
  1930. ResStrIndex:=ppufile.getlongint;
  1931. value.valueptr:=pc;
  1932. end;
  1933. constreal :
  1934. begin
  1935. new(pd);
  1936. pd^:=ppufile.getreal;
  1937. value.valueptr:=pd;
  1938. end;
  1939. constset :
  1940. begin
  1941. ppufile.gettype(consttype);
  1942. new(ps);
  1943. ppufile.getnormalset(ps^);
  1944. value.valueptr:=ps;
  1945. end;
  1946. constguid :
  1947. begin
  1948. new(pguid(value.valueptr));
  1949. ppufile.getdata(value.valueptr^,sizeof(tguid));
  1950. end;
  1951. constnil : ;
  1952. else
  1953. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1954. end;
  1955. end;
  1956. destructor tconstsym.destroy;
  1957. begin
  1958. case consttyp of
  1959. conststring,
  1960. constresourcestring :
  1961. freemem(pchar(value.valueptr),value.len+1);
  1962. constwstring :
  1963. donewidestring(pcompilerwidestring(value.valueptr));
  1964. constreal :
  1965. dispose(pbestreal(value.valueptr));
  1966. constset :
  1967. dispose(pnormalset(value.valueptr));
  1968. constguid :
  1969. dispose(pguid(value.valueptr));
  1970. end;
  1971. inherited destroy;
  1972. end;
  1973. procedure tconstsym.buildderef;
  1974. begin
  1975. if consttyp in [constord,constpointer,constset] then
  1976. consttype.buildderef;
  1977. end;
  1978. procedure tconstsym.deref;
  1979. begin
  1980. if consttyp in [constord,constpointer,constset] then
  1981. consttype.resolve;
  1982. end;
  1983. procedure tconstsym.ppuwrite(ppufile:tcompilerppufile);
  1984. begin
  1985. inherited ppuwrite(ppufile);
  1986. ppufile.putbyte(byte(consttyp));
  1987. case consttyp of
  1988. constnil : ;
  1989. constord :
  1990. begin
  1991. ppufile.puttype(consttype);
  1992. ppufile.putexprint(value.valueord);
  1993. end;
  1994. constpointer :
  1995. begin
  1996. ppufile.puttype(consttype);
  1997. ppufile.putptruint(value.valueordptr);
  1998. end;
  1999. constwstring :
  2000. begin
  2001. ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
  2002. ppufile.putdata(pcompilerwidestring(value.valueptr)^.data,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
  2003. end;
  2004. conststring,
  2005. constresourcestring :
  2006. begin
  2007. ppufile.putlongint(value.len);
  2008. ppufile.putdata(pchar(value.valueptr)^,value.len);
  2009. if consttyp=constresourcestring then
  2010. ppufile.putlongint(ResStrIndex);
  2011. end;
  2012. constreal :
  2013. ppufile.putreal(pbestreal(value.valueptr)^);
  2014. constset :
  2015. begin
  2016. ppufile.puttype(consttype);
  2017. ppufile.putnormalset(value.valueptr^);
  2018. end;
  2019. constguid :
  2020. ppufile.putdata(value.valueptr^,sizeof(tguid));
  2021. else
  2022. internalerror(13);
  2023. end;
  2024. ppufile.writeentry(ibconstsym);
  2025. end;
  2026. {$ifdef GDB}
  2027. function Tconstsym.stabstring:Pchar;
  2028. var st : string;
  2029. begin
  2030. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  2031. case consttyp of
  2032. conststring:
  2033. st:='s'''+backspace_quote(octal_quote(strpas(pchar(value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+'''';
  2034. constord:
  2035. st:='i'+tostr(value.valueord);
  2036. constpointer:
  2037. st:='i'+tostr(value.valueordptr);
  2038. constreal:
  2039. begin
  2040. system.str(pbestreal(value.valueptr)^,st);
  2041. st := 'r'+st;
  2042. end;
  2043. { if we don't know just put zero !! }
  2044. else st:='i0';
  2045. {***SETCONST}
  2046. {constset:;} {*** I don't know what to do with a set.}
  2047. { sets are not recognized by GDB}
  2048. {***}
  2049. end;
  2050. { valgrind does not support constants }
  2051. if cs_gdb_valgrind in aktglobalswitches then
  2052. stabstring:=nil
  2053. else
  2054. stabstring:=stabstr_evaluate('"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
  2055. end;
  2056. {$endif GDB}
  2057. {****************************************************************************
  2058. TENUMSYM
  2059. ****************************************************************************}
  2060. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  2061. begin
  2062. inherited create(n);
  2063. typ:=enumsym;
  2064. definition:=def;
  2065. value:=v;
  2066. { First entry? Then we need to set the minval }
  2067. if def.firstenum=nil then
  2068. begin
  2069. if v>0 then
  2070. def.has_jumps:=true;
  2071. def.setmin(v);
  2072. def.setmax(v);
  2073. end
  2074. else
  2075. begin
  2076. { check for jumps }
  2077. if v>def.max+1 then
  2078. def.has_jumps:=true;
  2079. { update low and high }
  2080. if def.min>v then
  2081. def.setmin(v);
  2082. if def.max<v then
  2083. def.setmax(v);
  2084. end;
  2085. order;
  2086. end;
  2087. constructor tenumsym.ppuload(ppufile:tcompilerppufile);
  2088. begin
  2089. inherited ppuload(ppufile);
  2090. typ:=enumsym;
  2091. ppufile.getderef(definitionderef);
  2092. value:=ppufile.getlongint;
  2093. nextenum := Nil;
  2094. end;
  2095. procedure tenumsym.buildderef;
  2096. begin
  2097. definitionderef.build(definition);
  2098. end;
  2099. procedure tenumsym.deref;
  2100. begin
  2101. definition:=tenumdef(definitionderef.resolve);
  2102. order;
  2103. end;
  2104. procedure tenumsym.order;
  2105. var
  2106. sym : tenumsym;
  2107. begin
  2108. sym := tenumsym(definition.firstenum);
  2109. if sym = nil then
  2110. begin
  2111. definition.firstenum := self;
  2112. nextenum := nil;
  2113. exit;
  2114. end;
  2115. { reorder the symbols in increasing value }
  2116. if value < sym.value then
  2117. begin
  2118. nextenum := sym;
  2119. definition.firstenum := self;
  2120. end
  2121. else
  2122. begin
  2123. while (sym.value <= value) and assigned(sym.nextenum) do
  2124. sym := sym.nextenum;
  2125. nextenum := sym.nextenum;
  2126. sym.nextenum := self;
  2127. end;
  2128. end;
  2129. procedure tenumsym.ppuwrite(ppufile:tcompilerppufile);
  2130. begin
  2131. inherited ppuwrite(ppufile);
  2132. ppufile.putderef(definitionderef);
  2133. ppufile.putlongint(value);
  2134. ppufile.writeentry(ibenumsym);
  2135. end;
  2136. {****************************************************************************
  2137. TTYPESYM
  2138. ****************************************************************************}
  2139. constructor ttypesym.create(const n : string;const tt : ttype);
  2140. begin
  2141. inherited create(n);
  2142. typ:=typesym;
  2143. restype:=tt;
  2144. { register the typesym for the definition }
  2145. if assigned(restype.def) and
  2146. (restype.def.deftype<>errordef) and
  2147. not(assigned(restype.def.typesym)) then
  2148. restype.def.typesym:=self;
  2149. end;
  2150. constructor ttypesym.ppuload(ppufile:tcompilerppufile);
  2151. begin
  2152. inherited ppuload(ppufile);
  2153. typ:=typesym;
  2154. ppufile.gettype(restype);
  2155. end;
  2156. function ttypesym.gettypedef:tdef;
  2157. begin
  2158. gettypedef:=restype.def;
  2159. end;
  2160. procedure ttypesym.buildderef;
  2161. begin
  2162. restype.buildderef;
  2163. end;
  2164. procedure ttypesym.deref;
  2165. begin
  2166. restype.resolve;
  2167. end;
  2168. procedure ttypesym.ppuwrite(ppufile:tcompilerppufile);
  2169. begin
  2170. inherited ppuwrite(ppufile);
  2171. ppufile.puttype(restype);
  2172. ppufile.writeentry(ibtypesym);
  2173. end;
  2174. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  2175. begin
  2176. inherited load_references(ppufile,locals);
  2177. if (restype.def.deftype=recorddef) then
  2178. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  2179. if (restype.def.deftype=objectdef) then
  2180. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  2181. end;
  2182. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  2183. var
  2184. d : tderef;
  2185. begin
  2186. d.reset;
  2187. if not inherited write_references(ppufile,locals) then
  2188. begin
  2189. { write address of this symbol if record or object
  2190. even if no real refs are there
  2191. because we need it for the symtable }
  2192. if (restype.def.deftype in [recorddef,objectdef]) then
  2193. begin
  2194. d.build(self);
  2195. ppufile.putderef(d);
  2196. ppufile.writeentry(ibsymref);
  2197. end;
  2198. end;
  2199. write_references:=true;
  2200. if (restype.def.deftype=recorddef) then
  2201. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  2202. if (restype.def.deftype=objectdef) then
  2203. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  2204. end;
  2205. {$ifdef GDB}
  2206. function ttypesym.stabstring : pchar;
  2207. var stabchar:string[2];
  2208. begin
  2209. stabstring:=nil;
  2210. if restype.def<>nil then
  2211. begin
  2212. if restype.def.deftype in tagtypes then
  2213. stabchar:='Tt'
  2214. else
  2215. stabchar:='t';
  2216. stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
  2217. end;
  2218. end;
  2219. {$endif GDB}
  2220. {****************************************************************************
  2221. TSYSSYM
  2222. ****************************************************************************}
  2223. constructor tsyssym.create(const n : string;l : longint);
  2224. begin
  2225. inherited create(n);
  2226. typ:=syssym;
  2227. number:=l;
  2228. end;
  2229. constructor tsyssym.ppuload(ppufile:tcompilerppufile);
  2230. begin
  2231. inherited ppuload(ppufile);
  2232. typ:=syssym;
  2233. number:=ppufile.getlongint;
  2234. end;
  2235. destructor tsyssym.destroy;
  2236. begin
  2237. inherited destroy;
  2238. end;
  2239. procedure tsyssym.ppuwrite(ppufile:tcompilerppufile);
  2240. begin
  2241. inherited ppuwrite(ppufile);
  2242. ppufile.putlongint(number);
  2243. ppufile.writeentry(ibsyssym);
  2244. end;
  2245. {*****************************************************************************
  2246. TMacro
  2247. *****************************************************************************}
  2248. constructor tmacro.create(const n : string);
  2249. begin
  2250. inherited create(n);
  2251. typ:= macrosym;
  2252. owner:= nil;
  2253. defined:=false;
  2254. is_used:=false;
  2255. is_compiler_var:= false;
  2256. buftext:=nil;
  2257. buflen:=0;
  2258. end;
  2259. constructor tmacro.ppuload(ppufile:tcompilerppufile);
  2260. begin
  2261. inherited ppuload(ppufile);
  2262. typ:=macrosym;
  2263. name:=ppufile.getstring;
  2264. defined:=boolean(ppufile.getbyte);
  2265. is_compiler_var:=boolean(ppufile.getbyte);
  2266. is_used:=false;
  2267. buflen:= ppufile.getlongint;
  2268. if buflen > 0 then
  2269. begin
  2270. getmem(buftext, buflen);
  2271. ppufile.getdata(buftext^, buflen)
  2272. end
  2273. else
  2274. buftext:=nil;
  2275. end;
  2276. destructor tmacro.destroy;
  2277. begin
  2278. if assigned(buftext) then
  2279. freemem(buftext,buflen);
  2280. inherited destroy;
  2281. end;
  2282. procedure tmacro.ppuwrite(ppufile:tcompilerppufile);
  2283. begin
  2284. inherited ppuwrite(ppufile);
  2285. ppufile.putstring(name);
  2286. ppufile.putbyte(byte(defined));
  2287. ppufile.putbyte(byte(is_compiler_var));
  2288. ppufile.putlongint(buflen);
  2289. if buflen > 0 then
  2290. ppufile.putdata(buftext^,buflen);
  2291. ppufile.writeentry(ibmacrosym);
  2292. end;
  2293. {****************************************************************************
  2294. TRTTISYM
  2295. ****************************************************************************}
  2296. constructor trttisym.create(const n:string;rt:trttitype);
  2297. const
  2298. prefix : array[trttitype] of string[5]=('$rtti','$init');
  2299. begin
  2300. inherited create(prefix[rt]+n);
  2301. include(symoptions,sp_internal);
  2302. typ:=rttisym;
  2303. lab:=nil;
  2304. rttityp:=rt;
  2305. end;
  2306. destructor trttisym.destroy;
  2307. begin
  2308. if assigned(_mangledname) then
  2309. begin
  2310. {$ifdef MEMDEBUG}
  2311. memmanglednames.start;
  2312. {$endif MEMDEBUG}
  2313. stringdispose(_mangledname);
  2314. {$ifdef MEMDEBUG}
  2315. memmanglednames.stop;
  2316. {$endif MEMDEBUG}
  2317. end;
  2318. inherited destroy;
  2319. end;
  2320. constructor trttisym.ppuload(ppufile:tcompilerppufile);
  2321. begin
  2322. inherited ppuload(ppufile);
  2323. typ:=rttisym;
  2324. lab:=nil;
  2325. rttityp:=trttitype(ppufile.getbyte);
  2326. end;
  2327. procedure trttisym.ppuwrite(ppufile:tcompilerppufile);
  2328. begin
  2329. inherited ppuwrite(ppufile);
  2330. ppufile.putbyte(byte(rttityp));
  2331. ppufile.writeentry(ibrttisym);
  2332. end;
  2333. function trttisym.mangledname : string;
  2334. const
  2335. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2336. begin
  2337. if not assigned(_mangledname) then
  2338. _mangledname:=stringdup(make_mangledname(prefix[rttityp],owner,Copy(name,5,255)));
  2339. result:=_mangledname^;
  2340. end;
  2341. function trttisym.get_label:tasmsymbol;
  2342. begin
  2343. { the label is always a global label }
  2344. if not assigned(lab) then
  2345. lab:=objectlibrary.newasmsymbol(mangledname,AB_EXTERNAL,AT_DATA);
  2346. get_label:=lab;
  2347. end;
  2348. end.