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