symsym.pas 82 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
  4. Implementation for the symbols types of the symtable
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit symsym;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,
  24. { target }
  25. cpuinfo,
  26. { symtable }
  27. symconst,symbase,symtype,symdef,
  28. { ppu }
  29. ppu,symppu,
  30. { aasm }
  31. aasm,cpubase,
  32. globals
  33. ;
  34. type
  35. {************************************************
  36. TSym
  37. ************************************************}
  38. { this object is the base for all symbol objects }
  39. tstoredsym = class(tsym)
  40. protected
  41. _mangledname : pstring;
  42. public
  43. {$ifdef GDB}
  44. isstabwritten : boolean;
  45. {$endif GDB}
  46. refs : longint;
  47. lastref,
  48. defref,
  49. lastwritten : tref;
  50. refcount : longint;
  51. constructor create(const n : string);
  52. constructor loadsym(ppufile:tcompilerppufile);
  53. destructor destroy;override;
  54. procedure write(ppufile:tcompilerppufile);virtual;abstract;
  55. procedure writesym(ppufile:tcompilerppufile);
  56. procedure deref;override;
  57. procedure insert_in_data;virtual;
  58. {$ifdef GDB}
  59. function stabstring : pchar;virtual;
  60. procedure concatstabto(asmlist : taasmoutput);virtual;
  61. {$endif GDB}
  62. procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
  63. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
  64. function is_visible_for_proc(currprocdef:tprocdef):boolean;
  65. function is_visible_for_object(currobjdef:tobjectdef):boolean;
  66. function mangledname : string;
  67. procedure generate_mangledname;virtual;abstract;
  68. end;
  69. tlabelsym = class(tstoredsym)
  70. lab : tasmlabel;
  71. used,
  72. defined : boolean;
  73. code : pointer; { should be tnode }
  74. constructor create(const n : string; l : tasmlabel);
  75. destructor destroy;override;
  76. constructor load(ppufile:tcompilerppufile);
  77. procedure generate_mangledname;override;
  78. procedure write(ppufile:tcompilerppufile);override;
  79. end;
  80. tunitsym = class(tstoredsym)
  81. unitsymtable : tsymtable;
  82. prevsym : tunitsym;
  83. constructor create(const n : string;ref : tsymtable);
  84. constructor load(ppufile:tcompilerppufile);
  85. destructor destroy;override;
  86. procedure write(ppufile:tcompilerppufile);override;
  87. procedure restoreunitsym;
  88. {$ifdef GDB}
  89. procedure concatstabto(asmlist : taasmoutput);override;
  90. {$endif GDB}
  91. end;
  92. terrorsym = class(tstoredsym)
  93. constructor create;
  94. end;
  95. tprocsym = class(tstoredsym)
  96. defs : pprocdeflist; { linked list of overloaded procdefs }
  97. is_global : boolean;
  98. overloadchecked : boolean;
  99. overloadcount : longint; { amount of overloaded functions in this module }
  100. constructor create(const n : string);
  101. constructor load(ppufile:tcompilerppufile);
  102. destructor destroy;override;
  103. { writes all declarations except the specified one }
  104. procedure write_parameter_lists(skipdef:tprocdef);
  105. { tests, if all procedures definitions are defined and not }
  106. { only forward }
  107. procedure check_forward;
  108. procedure unchain_overload;
  109. procedure write(ppufile:tcompilerppufile);override;
  110. procedure deref;override;
  111. procedure addprocdef(p:tprocdef);
  112. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  113. {$ifdef GDB}
  114. function stabstring : pchar;override;
  115. procedure concatstabto(asmlist : taasmoutput);override;
  116. {$endif GDB}
  117. end;
  118. ttypesym = class(tstoredsym)
  119. restype : ttype;
  120. {$ifdef GDB}
  121. isusedinstab : boolean;
  122. {$endif GDB}
  123. constructor create(const n : string;const tt : ttype);
  124. constructor load(ppufile:tcompilerppufile);
  125. procedure write(ppufile:tcompilerppufile);override;
  126. procedure deref;override;
  127. function gettypedef:tdef;override;
  128. procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
  129. function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
  130. {$ifdef GDB}
  131. function stabstring : pchar;override;
  132. procedure concatstabto(asmlist : taasmoutput);override;
  133. {$endif GDB}
  134. end;
  135. tvarsym = class(tstoredsym)
  136. address : longint;
  137. localvarsym : tvarsym;
  138. vartype : ttype;
  139. varoptions : tvaroptions;
  140. reg : tregister; { if reg<>R_NO, then the variable is an register variable }
  141. varspez : tvarspez; { sets the type of access }
  142. varstate : tvarstate;
  143. constructor create(const n : string;const tt : ttype);
  144. constructor create_dll(const n : string;const tt : ttype);
  145. constructor create_C(const n,mangled : string;const tt : ttype);
  146. constructor load(ppufile:tcompilerppufile);
  147. destructor destroy;override;
  148. procedure write(ppufile:tcompilerppufile);override;
  149. procedure deref;override;
  150. procedure generate_mangledname;override;
  151. procedure set_mangledname(const s:string);
  152. procedure insert_in_data;override;
  153. function getsize : longint;
  154. function getvaluesize : longint;
  155. function getpushsize : longint;
  156. {$ifdef GDB}
  157. function stabstring : pchar;override;
  158. procedure concatstabto(asmlist : taasmoutput);override;
  159. {$endif GDB}
  160. end;
  161. tpropertysym = class(tstoredsym)
  162. propoptions : tpropertyoptions;
  163. propoverriden : tpropertysym;
  164. proptype,
  165. indextype : ttype;
  166. index,
  167. default : longint;
  168. readaccess,
  169. writeaccess,
  170. storedaccess : tsymlist;
  171. constructor create(const n : string);
  172. destructor destroy;override;
  173. constructor load(ppufile:tcompilerppufile);
  174. function getsize : longint;
  175. procedure write(ppufile:tcompilerppufile);override;
  176. function gettypedef:tdef;override;
  177. procedure deref;override;
  178. procedure dooverride(overriden:tpropertysym);
  179. {$ifdef GDB}
  180. function stabstring : pchar;override;
  181. procedure concatstabto(asmlist : taasmoutput);override;
  182. {$endif GDB}
  183. end;
  184. tfuncretsym = class(tstoredsym)
  185. returntype : ttype;
  186. address : longint;
  187. funcretstate : tvarstate;
  188. constructor create(const n : string;const tt : ttype);
  189. constructor load(ppufile:tcompilerppufile);
  190. destructor destroy;override;
  191. procedure write(ppufile:tcompilerppufile);override;
  192. procedure deref;override;
  193. procedure insert_in_data;override;
  194. {$ifdef GDB}
  195. procedure concatstabto(asmlist : taasmoutput);override;
  196. {$endif GDB}
  197. end;
  198. tabsolutesym = class(tvarsym)
  199. abstyp : absolutetyp;
  200. absseg : boolean;
  201. ref : tstoredsym;
  202. asmname : pstring;
  203. constructor create(const n : string;const tt : ttype);
  204. constructor load(ppufile:tcompilerppufile);
  205. procedure deref;override;
  206. function mangledname : string;
  207. procedure write(ppufile:tcompilerppufile);override;
  208. procedure insert_in_data;override;
  209. {$ifdef GDB}
  210. procedure concatstabto(asmlist : taasmoutput);override;
  211. {$endif GDB}
  212. end;
  213. ttypedconstsym = class(tstoredsym)
  214. typedconsttype : ttype;
  215. is_writable : boolean;
  216. constructor create(const n : string;p : tdef;writable : boolean);
  217. constructor createtype(const n : string;const tt : ttype;writable : boolean);
  218. constructor load(ppufile:tcompilerppufile);
  219. destructor destroy;override;
  220. procedure generate_mangledname;override;
  221. procedure write(ppufile:tcompilerppufile);override;
  222. procedure deref;override;
  223. function getsize:longint;
  224. procedure insert_in_data;override;
  225. {$ifdef GDB}
  226. function stabstring : pchar;override;
  227. {$endif GDB}
  228. end;
  229. tconstsym = class(tstoredsym)
  230. consttype : ttype;
  231. consttyp : tconsttyp;
  232. resstrindex, { needed for resource strings }
  233. valueord : tconstexprint; { used for ordinal values }
  234. valueordptr : TConstPtrUInt; { used for pointer values }
  235. valueptr : pointer; { used for string, set, real values }
  236. len : longint; { len is needed for string length }
  237. constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
  238. constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  239. constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  240. constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
  241. constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  242. constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  243. constructor load(ppufile:tcompilerppufile);
  244. destructor destroy;override;
  245. function mangledname : string;
  246. procedure deref;override;
  247. procedure write(ppufile:tcompilerppufile);override;
  248. {$ifdef GDB}
  249. function stabstring : pchar;override;
  250. procedure concatstabto(asmlist : taasmoutput);override;
  251. {$endif GDB}
  252. end;
  253. tenumsym = class(tstoredsym)
  254. value : longint;
  255. definition : tenumdef;
  256. nextenum : tenumsym;
  257. constructor create(const n : string;def : tenumdef;v : longint);
  258. constructor load(ppufile:tcompilerppufile);
  259. procedure write(ppufile:tcompilerppufile);override;
  260. procedure deref;override;
  261. procedure order;
  262. {$ifdef GDB}
  263. procedure concatstabto(asmlist : taasmoutput);override;
  264. {$endif GDB}
  265. end;
  266. tsyssym = class(tstoredsym)
  267. number : longint;
  268. constructor create(const n : string;l : longint);
  269. constructor load(ppufile:tcompilerppufile);
  270. destructor destroy;override;
  271. procedure write(ppufile:tcompilerppufile);override;
  272. {$ifdef GDB}
  273. procedure concatstabto(asmlist : taasmoutput);override;
  274. {$endif GDB}
  275. end;
  276. { compiler generated symbol to point to rtti and init/finalize tables }
  277. trttisym = class(tstoredsym)
  278. lab : tasmsymbol;
  279. rttityp : trttitype;
  280. constructor create(const n:string;rt:trttitype);
  281. constructor load(ppufile:tcompilerppufile);
  282. procedure write(ppufile:tcompilerppufile);override;
  283. function mangledname:string;
  284. function get_label:tasmsymbol;
  285. end;
  286. { register variables }
  287. pregvarinfo = ^tregvarinfo;
  288. tregvarinfo = record
  289. regvars : array[1..maxvarregs] of tvarsym;
  290. regvars_para : array[1..maxvarregs] of boolean;
  291. regvars_refs : array[1..maxvarregs] of longint;
  292. fpuregvars : array[1..maxfpuvarregs] of tvarsym;
  293. fpuregvars_para : array[1..maxfpuvarregs] of boolean;
  294. fpuregvars_refs : array[1..maxfpuvarregs] of longint;
  295. end;
  296. var
  297. aktprocsym : tprocsym; { pointer to the symbol for the
  298. currently be parsed procedure }
  299. aktprocdef : tprocdef;
  300. aktcallprocdef : tabstractprocdef; { pointer to the definition of the
  301. currently called procedure,
  302. only set/unset in ncal }
  303. aktvarsym : tvarsym; { pointer to the symbol for the
  304. currently read var, only used
  305. for variable directives }
  306. generrorsym : tsym;
  307. const
  308. current_object_option : tsymoptions = [sp_public];
  309. { rtti and init/final }
  310. procedure generate_rtti(p:tsym);
  311. procedure generate_inittable(p:tsym);
  312. implementation
  313. uses
  314. {$ifdef Delphi}
  315. sysutils,
  316. {$else Delphi}
  317. strings,
  318. {$endif Delphi}
  319. { global }
  320. globtype,verbose,
  321. { target }
  322. systems,
  323. { symtable }
  324. symtable,types,
  325. {$ifdef GDB}
  326. gdb,
  327. {$endif GDB}
  328. { aasm }
  329. cpuasm,
  330. { module }
  331. fmodule,
  332. { codegen }
  333. cgbase,cresstr
  334. ;
  335. {****************************************************************************
  336. Helpers
  337. ****************************************************************************}
  338. {****************************************************************************
  339. TSYM (base for all symtypes)
  340. ****************************************************************************}
  341. constructor tstoredsym.create(const n : string);
  342. begin
  343. inherited create(n);
  344. symoptions:=current_object_option;
  345. {$ifdef GDB}
  346. isstabwritten := false;
  347. {$endif GDB}
  348. fileinfo:=akttokenpos;
  349. defref:=nil;
  350. refs:=0;
  351. lastwritten:=nil;
  352. refcount:=0;
  353. if (cs_browser in aktmoduleswitches) and make_ref then
  354. begin
  355. defref:=tref.create(defref,@akttokenpos);
  356. inc(refcount);
  357. end;
  358. lastref:=defref;
  359. _mangledname:=nil;
  360. end;
  361. constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
  362. var
  363. s : string;
  364. nr : word;
  365. begin
  366. nr:=ppufile.getword;
  367. s:=ppufile.getstring;
  368. inherited create(s);
  369. { force the correct indexnr. must be after create! }
  370. indexnr:=nr;
  371. ppufile.getsmallset(symoptions);
  372. ppufile.getposinfo(fileinfo);
  373. lastref:=nil;
  374. defref:=nil;
  375. refs:=0;
  376. lastwritten:=nil;
  377. refcount:=0;
  378. _mangledname:=nil;
  379. {$ifdef GDB}
  380. isstabwritten := false;
  381. {$endif GDB}
  382. end;
  383. procedure tstoredsym.deref;
  384. begin
  385. end;
  386. procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
  387. var
  388. pos : tfileposinfo;
  389. move_last : boolean;
  390. begin
  391. move_last:=lastwritten=lastref;
  392. while (not ppufile.endofentry) do
  393. begin
  394. ppufile.getposinfo(pos);
  395. inc(refcount);
  396. lastref:=tref.create(lastref,@pos);
  397. lastref.is_written:=true;
  398. if refcount=1 then
  399. defref:=lastref;
  400. end;
  401. if move_last then
  402. lastwritten:=lastref;
  403. end;
  404. { big problem here :
  405. wrong refs were written because of
  406. interface parsing of other units PM
  407. moduleindex must be checked !! }
  408. function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  409. var
  410. ref : tref;
  411. symref_written,move_last : boolean;
  412. begin
  413. write_references:=false;
  414. if lastwritten=lastref then
  415. exit;
  416. { should we update lastref }
  417. move_last:=true;
  418. symref_written:=false;
  419. { write symbol refs }
  420. if assigned(lastwritten) then
  421. ref:=lastwritten
  422. else
  423. ref:=defref;
  424. while assigned(ref) do
  425. begin
  426. if ref.moduleindex=current_module.unit_index then
  427. begin
  428. { write address to this symbol }
  429. if not symref_written then
  430. begin
  431. ppufile.putderef(self);
  432. symref_written:=true;
  433. end;
  434. ppufile.putposinfo(ref.posinfo);
  435. ref.is_written:=true;
  436. if move_last then
  437. lastwritten:=ref;
  438. end
  439. else if not ref.is_written then
  440. move_last:=false
  441. else if move_last then
  442. lastwritten:=ref;
  443. ref:=ref.nextref;
  444. end;
  445. if symref_written then
  446. ppufile.writeentry(ibsymref);
  447. write_references:=symref_written;
  448. end;
  449. destructor tstoredsym.destroy;
  450. begin
  451. if assigned(_mangledname) then
  452. stringdispose(_mangledname);
  453. if assigned(defref) then
  454. begin
  455. defref.freechain;
  456. defref.free;
  457. end;
  458. inherited destroy;
  459. end;
  460. procedure tstoredsym.writesym(ppufile:tcompilerppufile);
  461. begin
  462. ppufile.putword(indexnr);
  463. ppufile.putstring(_realname^);
  464. ppufile.putsmallset(symoptions);
  465. ppufile.putposinfo(fileinfo);
  466. end;
  467. { for most symbol types there is nothing to do at all }
  468. procedure tstoredsym.insert_in_data;
  469. begin
  470. end;
  471. {$ifdef GDB}
  472. function tstoredsym.stabstring : pchar;
  473. begin
  474. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  475. tostr(fileinfo.line)+',0');
  476. end;
  477. procedure tstoredsym.concatstabto(asmlist : taasmoutput);
  478. var
  479. stab_str : pchar;
  480. begin
  481. if not isstabwritten then
  482. begin
  483. stab_str := stabstring;
  484. { count_dbx(stab_str); moved to GDB.PAS }
  485. asmList.concat(Tai_stabs.Create(stab_str));
  486. isstabwritten:=true;
  487. end;
  488. end;
  489. {$endif GDB}
  490. function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
  491. begin
  492. is_visible_for_proc:=false;
  493. { private symbols are allowed when we are in the same
  494. module as they are defined }
  495. if (sp_private in symoptions) and
  496. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  497. (owner.defowner.owner.unitid<>0) then
  498. exit;
  499. { protected symbols are vissible in the module that defines them and
  500. also visible to related objects }
  501. if (sp_protected in symoptions) and
  502. (
  503. (
  504. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  505. (owner.defowner.owner.unitid<>0)
  506. ) and
  507. not(
  508. assigned(currprocdef) and
  509. assigned(currprocdef._class) and
  510. currprocdef._class.is_related(tobjectdef(owner.defowner))
  511. )
  512. ) then
  513. exit;
  514. is_visible_for_proc:=true;
  515. end;
  516. function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
  517. begin
  518. is_visible_for_object:=false;
  519. { private symbols are allowed when we are in the same
  520. module as they are defined }
  521. if (sp_private in symoptions) and
  522. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  523. (owner.defowner.owner.unitid<>0) then
  524. exit;
  525. { protected symbols are vissible in the module that defines them and
  526. also visible to related objects }
  527. if (sp_protected in symoptions) and
  528. (
  529. (
  530. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  531. (owner.defowner.owner.unitid<>0)
  532. ) and
  533. not(
  534. assigned(currobjdef) and
  535. currobjdef.is_related(tobjectdef(owner.defowner))
  536. )
  537. ) then
  538. exit;
  539. is_visible_for_object:=true;
  540. end;
  541. function tstoredsym.mangledname : string;
  542. begin
  543. if not assigned(_mangledname) then
  544. begin
  545. generate_mangledname;
  546. if not assigned(_mangledname) then
  547. internalerror(200204171);
  548. end;
  549. mangledname:=_mangledname^
  550. end;
  551. {****************************************************************************
  552. TLABELSYM
  553. ****************************************************************************}
  554. constructor tlabelsym.create(const n : string; l : tasmlabel);
  555. begin
  556. inherited create(n);
  557. typ:=labelsym;
  558. lab:=l;
  559. used:=false;
  560. defined:=false;
  561. code:=nil;
  562. end;
  563. constructor tlabelsym.load(ppufile:tcompilerppufile);
  564. begin
  565. inherited loadsym(ppufile);
  566. typ:=labelsym;
  567. { this is all dummy
  568. it is only used for local browsing }
  569. lab:=nil;
  570. code:=nil;
  571. used:=false;
  572. defined:=true;
  573. end;
  574. destructor tlabelsym.destroy;
  575. begin
  576. inherited destroy;
  577. end;
  578. procedure tlabelsym.generate_mangledname;
  579. begin
  580. _mangledname:=stringdup(lab.name);
  581. end;
  582. procedure tlabelsym.write(ppufile:tcompilerppufile);
  583. begin
  584. if owner.symtabletype=globalsymtable then
  585. Message(sym_e_ill_label_decl)
  586. else
  587. begin
  588. inherited writesym(ppufile);
  589. ppufile.writeentry(iblabelsym);
  590. end;
  591. end;
  592. {****************************************************************************
  593. TUNITSYM
  594. ****************************************************************************}
  595. constructor tunitsym.create(const n : string;ref : tsymtable);
  596. var
  597. old_make_ref : boolean;
  598. begin
  599. old_make_ref:=make_ref;
  600. make_ref:=false;
  601. inherited create(n);
  602. make_ref:=old_make_ref;
  603. typ:=unitsym;
  604. unitsymtable:=ref;
  605. if assigned(ref) and
  606. (ref.symtabletype=globalsymtable) then
  607. begin
  608. prevsym:=tglobalsymtable(ref).unitsym;
  609. tglobalsymtable(ref).unitsym:=self;
  610. end;
  611. end;
  612. constructor tunitsym.load(ppufile:tcompilerppufile);
  613. begin
  614. inherited loadsym(ppufile);
  615. typ:=unitsym;
  616. unitsymtable:=nil;
  617. prevsym:=nil;
  618. refs:=0;
  619. end;
  620. { we need to remove it from the prevsym chain ! }
  621. procedure tunitsym.restoreunitsym;
  622. var pus,ppus : tunitsym;
  623. begin
  624. if assigned(unitsymtable) and
  625. (unitsymtable.symtabletype=globalsymtable) then
  626. begin
  627. ppus:=nil;
  628. pus:=tglobalsymtable(unitsymtable).unitsym;
  629. if pus=self then
  630. tglobalsymtable(unitsymtable).unitsym:=prevsym
  631. else while assigned(pus) do
  632. begin
  633. if pus=self then
  634. begin
  635. ppus.prevsym:=prevsym;
  636. break;
  637. end
  638. else
  639. begin
  640. ppus:=pus;
  641. pus:=ppus.prevsym;
  642. end;
  643. end;
  644. end;
  645. unitsymtable:=nil;
  646. prevsym:=nil;
  647. end;
  648. destructor tunitsym.destroy;
  649. begin
  650. restoreunitsym;
  651. inherited destroy;
  652. end;
  653. procedure tunitsym.write(ppufile:tcompilerppufile);
  654. begin
  655. inherited writesym(ppufile);
  656. ppufile.writeentry(ibunitsym);
  657. end;
  658. {$ifdef GDB}
  659. procedure tunitsym.concatstabto(asmlist : taasmoutput);
  660. begin
  661. {Nothing to write to stabs !}
  662. end;
  663. {$endif GDB}
  664. {****************************************************************************
  665. TPROCSYM
  666. ****************************************************************************}
  667. constructor tprocsym.create(const n : string);
  668. begin
  669. inherited create(n);
  670. typ:=procsym;
  671. defs:=nil;
  672. owner:=nil;
  673. is_global:=false;
  674. overloadchecked:=false;
  675. overloadcount:=0;
  676. end;
  677. constructor tprocsym.load(ppufile:tcompilerppufile);
  678. var
  679. pd : tprocdef;
  680. begin
  681. inherited loadsym(ppufile);
  682. typ:=procsym;
  683. defs:=nil;
  684. repeat
  685. pd:=tprocdef(ppufile.getderef);
  686. if pd=nil then
  687. break;
  688. addprocdef(pd);
  689. until false;
  690. is_global:=false;
  691. overloadchecked:=false;
  692. overloadcount:=-1; { invalid, not used anymore }
  693. end;
  694. destructor tprocsym.destroy;
  695. var
  696. hp,p : pprocdeflist;
  697. begin
  698. p:=defs;
  699. while assigned(p) do
  700. begin
  701. hp:=p^.next;
  702. dispose(p);
  703. p:=hp;
  704. end;
  705. inherited destroy;
  706. end;
  707. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  708. var
  709. p : pprocdeflist;
  710. begin
  711. p:=defs;
  712. while assigned(p) do
  713. begin
  714. if p^.def<>skipdef then
  715. MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
  716. p:=p^.next;
  717. end;
  718. end;
  719. procedure tprocsym.check_forward;
  720. var
  721. p : pprocdeflist;
  722. begin
  723. p:=defs;
  724. while assigned(p) do
  725. begin
  726. if (p^.def.procsym=self) and
  727. (p^.def.forwarddef) then
  728. begin
  729. MessagePos1(fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
  730. { Turn futher error messages off }
  731. p^.def.forwarddef:=false;
  732. end;
  733. p:=p^.next;
  734. end;
  735. end;
  736. procedure tprocsym.deref;
  737. var
  738. p : pprocdeflist;
  739. begin
  740. p:=defs;
  741. while assigned(p) do
  742. begin
  743. resolvedef(pointer(p^.def));
  744. p:=p^.next;
  745. end;
  746. end;
  747. procedure tprocsym.addprocdef(p:tprocdef);
  748. var
  749. pd : pprocdeflist;
  750. begin
  751. new(pd);
  752. pd^.def:=p;
  753. pd^.next:=defs;
  754. defs:=pd;
  755. end;
  756. procedure tprocsym.write(ppufile:tcompilerppufile);
  757. var
  758. p : pprocdeflist;
  759. begin
  760. inherited writesym(ppufile);
  761. p:=defs;
  762. while assigned(p) do
  763. begin
  764. { only write the proc definitions that belong
  765. to this procsym }
  766. if (p^.def.procsym=self) then
  767. ppufile.putderef(p^.def);
  768. p:=p^.next;
  769. end;
  770. ppufile.putderef(nil);
  771. ppufile.writeentry(ibprocsym);
  772. end;
  773. function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
  774. var
  775. p : pprocdeflist;
  776. begin
  777. write_references:=false;
  778. if not inherited write_references(ppufile,locals) then
  779. exit;
  780. write_references:=true;
  781. p:=defs;
  782. while assigned(p) do
  783. begin
  784. if (p^.def.procsym=self) then
  785. p^.def.write_references(ppufile,locals);
  786. p:=p^.next;
  787. end;
  788. end;
  789. procedure tprocsym.unchain_overload;
  790. var
  791. p,hp,
  792. first,
  793. last : pprocdeflist;
  794. begin
  795. { remove all overloaded procdefs from the
  796. procdeflist that are not in the current symtable }
  797. first:=nil;
  798. last:=nil;
  799. p:=defs;
  800. while assigned(p) do
  801. begin
  802. hp:=p^.next;
  803. if (p^.def.procsym=self) then
  804. begin
  805. { keep in list }
  806. if not assigned(first) then
  807. begin
  808. first:=p;
  809. last:=p;
  810. end
  811. else
  812. last^.next:=p;
  813. last:=p;
  814. p^.next:=nil;
  815. end
  816. else
  817. begin
  818. { remove }
  819. dispose(p);
  820. end;
  821. p:=hp;
  822. end;
  823. defs:=first;
  824. end;
  825. {$ifdef GDB}
  826. function tprocsym.stabstring : pchar;
  827. begin
  828. internalerror(200111171);
  829. stabstring:=nil;
  830. end;
  831. procedure tprocsym.concatstabto(asmlist : taasmoutput);
  832. begin
  833. internalerror(200111172);
  834. end;
  835. {$endif GDB}
  836. {****************************************************************************
  837. TERRORSYM
  838. ****************************************************************************}
  839. constructor terrorsym.create;
  840. begin
  841. inherited create('');
  842. typ:=errorsym;
  843. end;
  844. {****************************************************************************
  845. TPROPERTYSYM
  846. ****************************************************************************}
  847. constructor tpropertysym.create(const n : string);
  848. begin
  849. inherited create(n);
  850. typ:=propertysym;
  851. propoptions:=[];
  852. index:=0;
  853. default:=0;
  854. proptype.reset;
  855. indextype.reset;
  856. readaccess:=tsymlist.create;
  857. writeaccess:=tsymlist.create;
  858. storedaccess:=tsymlist.create;
  859. end;
  860. constructor tpropertysym.load(ppufile:tcompilerppufile);
  861. begin
  862. inherited loadsym(ppufile);
  863. typ:=propertysym;
  864. ppufile.getsmallset(propoptions);
  865. if (ppo_is_override in propoptions) then
  866. begin
  867. propoverriden:=tpropertysym(ppufile.getderef);
  868. { we need to have these objects initialized }
  869. readaccess:=tsymlist.create;
  870. writeaccess:=tsymlist.create;
  871. storedaccess:=tsymlist.create;
  872. end
  873. else
  874. begin
  875. ppufile.gettype(proptype);
  876. index:=ppufile.getlongint;
  877. default:=ppufile.getlongint;
  878. ppufile.gettype(indextype);
  879. readaccess:=ppufile.getsymlist;
  880. writeaccess:=ppufile.getsymlist;
  881. storedaccess:=ppufile.getsymlist;
  882. end;
  883. end;
  884. destructor tpropertysym.destroy;
  885. begin
  886. readaccess.free;
  887. writeaccess.free;
  888. storedaccess.free;
  889. inherited destroy;
  890. end;
  891. function tpropertysym.gettypedef:tdef;
  892. begin
  893. gettypedef:=proptype.def;
  894. end;
  895. procedure tpropertysym.deref;
  896. begin
  897. if (ppo_is_override in propoptions) then
  898. begin
  899. resolvesym(pointer(propoverriden));
  900. dooverride(propoverriden);
  901. end
  902. else
  903. begin
  904. proptype.resolve;
  905. indextype.resolve;
  906. readaccess.resolve;
  907. writeaccess.resolve;
  908. storedaccess.resolve;
  909. end;
  910. end;
  911. function tpropertysym.getsize : longint;
  912. begin
  913. getsize:=0;
  914. end;
  915. procedure tpropertysym.write(ppufile:tcompilerppufile);
  916. begin
  917. inherited writesym(ppufile);
  918. ppufile.putsmallset(propoptions);
  919. if (ppo_is_override in propoptions) then
  920. ppufile.putderef(propoverriden)
  921. else
  922. begin
  923. ppufile.puttype(proptype);
  924. ppufile.putlongint(index);
  925. ppufile.putlongint(default);
  926. ppufile.puttype(indextype);
  927. ppufile.putsymlist(readaccess);
  928. ppufile.putsymlist(writeaccess);
  929. ppufile.putsymlist(storedaccess);
  930. end;
  931. ppufile.writeentry(ibpropertysym);
  932. end;
  933. procedure tpropertysym.dooverride(overriden:tpropertysym);
  934. begin
  935. propoverriden:=overriden;
  936. proptype:=overriden.proptype;
  937. propoptions:=overriden.propoptions+[ppo_is_override];
  938. index:=overriden.index;
  939. default:=overriden.default;
  940. indextype:=overriden.indextype;
  941. readaccess.clear;
  942. readaccess:=overriden.readaccess.getcopy;
  943. writeaccess.clear;
  944. writeaccess:=overriden.writeaccess.getcopy;
  945. storedaccess.clear;
  946. storedaccess:=overriden.storedaccess.getcopy;
  947. end;
  948. {$ifdef GDB}
  949. function tpropertysym.stabstring : pchar;
  950. begin
  951. { !!!! don't know how to handle }
  952. stabstring:=strpnew('');
  953. end;
  954. procedure tpropertysym.concatstabto(asmlist : taasmoutput);
  955. begin
  956. { !!!! don't know how to handle }
  957. end;
  958. {$endif GDB}
  959. {****************************************************************************
  960. TFUNCRETSYM
  961. ****************************************************************************}
  962. constructor tfuncretsym.create(const n : string;const tt:ttype);
  963. begin
  964. inherited create(n);
  965. typ:=funcretsym;
  966. returntype:=tt;
  967. funcretstate:=vs_declared;
  968. { address valid for ret in param only }
  969. { otherwise set by insert }
  970. address:=pprocinfo(procinfo)^.return_offset;
  971. end;
  972. constructor tfuncretsym.load(ppufile:tcompilerppufile);
  973. begin
  974. inherited loadsym(ppufile);
  975. ppufile.gettype(returntype);
  976. address:=ppufile.getlongint;
  977. typ:=funcretsym;
  978. end;
  979. destructor tfuncretsym.destroy;
  980. begin
  981. inherited destroy;
  982. end;
  983. procedure tfuncretsym.write(ppufile:tcompilerppufile);
  984. begin
  985. inherited writesym(ppufile);
  986. ppufile.puttype(returntype);
  987. ppufile.putlongint(address);
  988. ppufile.writeentry(ibfuncretsym);
  989. funcretstate:=vs_used;
  990. end;
  991. procedure tfuncretsym.deref;
  992. begin
  993. returntype.resolve;
  994. end;
  995. {$ifdef GDB}
  996. procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
  997. begin
  998. { Nothing to do here, it is done in genexitcode }
  999. end;
  1000. {$endif GDB}
  1001. procedure tfuncretsym.insert_in_data;
  1002. var
  1003. varalign,l : longint;
  1004. begin
  1005. { if retoffset is already set then reuse it, this is needed
  1006. when inserting the result variable }
  1007. if procinfo^.return_offset<>0 then
  1008. address:=procinfo^.return_offset
  1009. else
  1010. begin
  1011. { allocate space in local if ret in acc or in fpu }
  1012. if ret_in_acc(returntype.def) or
  1013. (returntype.def.deftype=floatdef) then
  1014. begin
  1015. l:=returntype.def.size;
  1016. varalign:=size_2_align(l);
  1017. varalign:=used_align(varalign,aktalignment.localalignmin,owner.dataalignment);
  1018. address:=align(owner.datasize+l,varalign);
  1019. owner.datasize:=address;
  1020. procinfo^.return_offset:=-address;
  1021. end;
  1022. end;
  1023. end;
  1024. {****************************************************************************
  1025. TABSOLUTESYM
  1026. ****************************************************************************}
  1027. constructor tabsolutesym.create(const n : string;const tt : ttype);
  1028. begin
  1029. inherited create(n,tt);
  1030. typ:=absolutesym;
  1031. end;
  1032. constructor tabsolutesym.load(ppufile:tcompilerppufile);
  1033. begin
  1034. { Note: This needs to load everything of tvarsym.write }
  1035. inherited load(ppufile);
  1036. { load absolute }
  1037. typ:=absolutesym;
  1038. ref:=nil;
  1039. address:=0;
  1040. asmname:=nil;
  1041. abstyp:=absolutetyp(ppufile.getbyte);
  1042. absseg:=false;
  1043. case abstyp of
  1044. tovar :
  1045. asmname:=stringdup(ppufile.getstring);
  1046. toasm :
  1047. asmname:=stringdup(ppufile.getstring);
  1048. toaddr :
  1049. begin
  1050. address:=ppufile.getlongint;
  1051. absseg:=boolean(ppufile.getbyte);
  1052. end;
  1053. end;
  1054. end;
  1055. procedure tabsolutesym.write(ppufile:tcompilerppufile);
  1056. var
  1057. hvo : tvaroptions;
  1058. begin
  1059. { Note: This needs to write everything of tvarsym.write }
  1060. inherited writesym(ppufile);
  1061. ppufile.putbyte(byte(varspez));
  1062. if read_member then
  1063. ppufile.putlongint(address);
  1064. { write only definition or definitionsym }
  1065. ppufile.puttype(vartype);
  1066. hvo:=varoptions-[vo_regable];
  1067. ppufile.putsmallset(hvo);
  1068. ppufile.putbyte(byte(abstyp));
  1069. case abstyp of
  1070. tovar :
  1071. ppufile.putstring(ref.name);
  1072. toasm :
  1073. ppufile.putstring(asmname^);
  1074. toaddr :
  1075. begin
  1076. ppufile.putlongint(address);
  1077. ppufile.putbyte(byte(absseg));
  1078. end;
  1079. end;
  1080. ppufile.writeentry(ibabsolutesym);
  1081. end;
  1082. procedure tabsolutesym.deref;
  1083. var
  1084. srsym : tsym;
  1085. srsymtable : tsymtable;
  1086. begin
  1087. { inheritance of varsym.deref ! }
  1088. vartype.resolve;
  1089. { own absolute deref }
  1090. if (abstyp=tovar) and (asmname<>nil) then
  1091. begin
  1092. { search previous loaded symtables }
  1093. searchsym(asmname^,srsym,srsymtable);
  1094. if not assigned(srsym) then
  1095. srsym:=searchsymonlyin(owner,asmname^);
  1096. if not assigned(srsym) then
  1097. srsym:=generrorsym;
  1098. ref:=tstoredsym(srsym);
  1099. stringdispose(asmname);
  1100. end;
  1101. end;
  1102. function tabsolutesym.mangledname : string;
  1103. begin
  1104. case abstyp of
  1105. tovar :
  1106. begin
  1107. case ref.typ of
  1108. varsym :
  1109. mangledname:=tvarsym(ref).mangledname;
  1110. else
  1111. internalerror(200111011);
  1112. end;
  1113. end;
  1114. toasm :
  1115. mangledname:=asmname^;
  1116. toaddr :
  1117. mangledname:='$'+tostr(address);
  1118. else
  1119. internalerror(10002);
  1120. end;
  1121. end;
  1122. procedure tabsolutesym.insert_in_data;
  1123. begin
  1124. end;
  1125. {$ifdef GDB}
  1126. procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
  1127. begin
  1128. { I don't know how to handle this !! }
  1129. end;
  1130. {$endif GDB}
  1131. {****************************************************************************
  1132. TVARSYM
  1133. ****************************************************************************}
  1134. constructor tvarsym.create(const n : string;const tt : ttype);
  1135. begin
  1136. inherited create(n);
  1137. typ:=varsym;
  1138. vartype:=tt;
  1139. _mangledname:=nil;
  1140. varspez:=vs_value;
  1141. address:=0;
  1142. localvarsym:=nil;
  1143. refs:=0;
  1144. varstate:=vs_used;
  1145. varoptions:=[];
  1146. { can we load the value into a register ? }
  1147. if tstoreddef(tt.def).is_intregable then
  1148. include(varoptions,vo_regable)
  1149. else
  1150. exclude(varoptions,vo_regable);
  1151. if tstoreddef(tt.def).is_fpuregable then
  1152. include(varoptions,vo_fpuregable)
  1153. else
  1154. exclude(varoptions,vo_fpuregable);
  1155. reg:=R_NO;
  1156. end;
  1157. constructor tvarsym.create_dll(const n : string;const tt : ttype);
  1158. begin
  1159. tvarsym(self).create(n,tt);
  1160. include(varoptions,vo_is_dll_var);
  1161. end;
  1162. constructor tvarsym.create_C(const n,mangled : string;const tt : ttype);
  1163. begin
  1164. tvarsym(self).create(n,tt);
  1165. include(varoptions,vo_is_C_var);
  1166. stringdispose(_mangledname);
  1167. _mangledname:=stringdup(mangled);
  1168. end;
  1169. constructor tvarsym.load(ppufile:tcompilerppufile);
  1170. begin
  1171. inherited loadsym(ppufile);
  1172. typ:=varsym;
  1173. reg:=R_NO;
  1174. refs := 0;
  1175. varstate:=vs_used;
  1176. varspez:=tvarspez(ppufile.getbyte);
  1177. if read_member then
  1178. address:=ppufile.getlongint
  1179. else
  1180. address:=0;
  1181. localvarsym:=nil;
  1182. ppufile.gettype(vartype);
  1183. ppufile.getsmallset(varoptions);
  1184. if (vo_is_C_var in varoptions) then
  1185. _mangledname:=stringdup(ppufile.getstring);
  1186. end;
  1187. destructor tvarsym.destroy;
  1188. begin
  1189. inherited destroy;
  1190. end;
  1191. procedure tvarsym.deref;
  1192. begin
  1193. vartype.resolve;
  1194. end;
  1195. procedure tvarsym.write(ppufile:tcompilerppufile);
  1196. var
  1197. hvo : tvaroptions;
  1198. begin
  1199. inherited writesym(ppufile);
  1200. ppufile.putbyte(byte(varspez));
  1201. if read_member then
  1202. ppufile.putlongint(address);
  1203. ppufile.puttype(vartype);
  1204. { symbols which are load are never candidates for a register,
  1205. turn off the regable }
  1206. hvo:=varoptions-[vo_regable,vo_fpuregable];
  1207. ppufile.putsmallset(hvo);
  1208. if (vo_is_C_var in varoptions) then
  1209. ppufile.putstring(mangledname);
  1210. ppufile.writeentry(ibvarsym);
  1211. end;
  1212. procedure tvarsym.generate_mangledname;
  1213. begin
  1214. _mangledname:=stringdup(mangledname_prefix('U',owner)+name);
  1215. end;
  1216. procedure tvarsym.set_mangledname(const s:string);
  1217. begin
  1218. stringdispose(_mangledname);
  1219. _mangledname:=stringdup(s);
  1220. end;
  1221. function tvarsym.getsize : longint;
  1222. begin
  1223. if assigned(vartype.def) then
  1224. getsize:=vartype.def.size
  1225. else
  1226. getsize:=0;
  1227. end;
  1228. function tvarsym.getvaluesize : longint;
  1229. begin
  1230. if assigned(vartype.def) and
  1231. (varspez=vs_value) and
  1232. ((vartype.def.deftype<>arraydef) or
  1233. tarraydef(vartype.def).isDynamicArray or
  1234. (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then
  1235. getvaluesize:=vartype.def.size
  1236. else
  1237. getvaluesize:=0;
  1238. end;
  1239. function tvarsym.getpushsize : longint;
  1240. begin
  1241. if assigned(vartype.def) then
  1242. begin
  1243. case varspez of
  1244. vs_out,
  1245. vs_var :
  1246. getpushsize:=pointer_size;
  1247. vs_value,
  1248. vs_const :
  1249. begin
  1250. if push_addr_param(vartype.def) then
  1251. getpushsize:=pointer_size
  1252. else
  1253. getpushsize:=vartype.def.size;
  1254. end;
  1255. end;
  1256. end
  1257. else
  1258. getpushsize:=0;
  1259. end;
  1260. procedure tvarsym.insert_in_data;
  1261. var
  1262. varalign,
  1263. l,modulo : longint;
  1264. storefilepos : tfileposinfo;
  1265. begin
  1266. if (vo_is_external in varoptions) then
  1267. exit;
  1268. { handle static variables of objects especially }
  1269. if read_member and (owner.symtabletype=objectsymtable) and
  1270. (sp_static in symoptions) then
  1271. begin
  1272. { the data filed is generated in parser.pas
  1273. with a tobject_FIELDNAME variable }
  1274. { this symbol can't be loaded to a register }
  1275. exclude(varoptions,vo_regable);
  1276. exclude(varoptions,vo_fpuregable);
  1277. end
  1278. else
  1279. if not(read_member) then
  1280. begin
  1281. { made problems with parameters etc. ! (FK) }
  1282. { check for instance of an abstract object or class }
  1283. {
  1284. if (tvarsym(sym).definition.deftype=objectdef) and
  1285. ((tobjectdef(tvarsym(sym).definition).options and oo_is_abstract)<>0) then
  1286. Message(sym_e_no_instance_of_abstract_object);
  1287. }
  1288. storefilepos:=aktfilepos;
  1289. aktfilepos:=akttokenpos;
  1290. if (vo_is_thread_var in varoptions) then
  1291. l:=pointer_size
  1292. else
  1293. l:=getvaluesize;
  1294. case owner.symtabletype of
  1295. stt_exceptsymtable:
  1296. { can contain only one symbol, address calculated later }
  1297. ;
  1298. localsymtable :
  1299. begin
  1300. varstate:=vs_declared;
  1301. varalign:=size_2_align(l);
  1302. varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
  1303. address:=align(owner.datasize+l,varalign);
  1304. owner.datasize:=address;
  1305. end;
  1306. staticsymtable :
  1307. begin
  1308. { enable unitialized warning for local symbols }
  1309. varstate:=vs_declared;
  1310. varalign:=size_2_align(l);
  1311. varalign:=used_align(varalign,aktalignment.varalignmin,aktalignment.varalignmax);
  1312. address:=align(owner.datasize,varalign);
  1313. { insert cut for smartlinking or alignment }
  1314. if (cs_create_smart in aktmoduleswitches) then
  1315. bssSegment.concat(Tai_cut.Create)
  1316. else if (address<>owner.datasize) then
  1317. bssSegment.concat(Tai_align.create(varalign));
  1318. owner.datasize:=address+l;
  1319. {$ifdef GDB}
  1320. if cs_debuginfo in aktmoduleswitches then
  1321. concatstabto(bsssegment);
  1322. {$endif GDB}
  1323. if (cs_create_smart in aktmoduleswitches) or
  1324. DLLSource or
  1325. (vo_is_exported in varoptions) or
  1326. (vo_is_C_var in varoptions) then
  1327. bssSegment.concat(Tai_datablock.Create_global(mangledname,l))
  1328. else
  1329. bssSegment.concat(Tai_datablock.Create(mangledname,l));
  1330. { this symbol can't be loaded to a register }
  1331. exclude(varoptions,vo_regable);
  1332. exclude(varoptions,vo_fpuregable);
  1333. end;
  1334. globalsymtable :
  1335. begin
  1336. varalign:=size_2_align(l);
  1337. varalign:=used_align(varalign,aktalignment.varalignmin,aktalignment.varalignmax);
  1338. address:=align(owner.datasize,varalign);
  1339. { insert cut for smartlinking or alignment }
  1340. if (cs_create_smart in aktmoduleswitches) then
  1341. bssSegment.concat(Tai_cut.Create)
  1342. else if (address<>owner.datasize) then
  1343. bssSegment.concat(Tai_align.create(varalign));
  1344. owner.datasize:=address+l;
  1345. {$ifdef GDB}
  1346. if cs_debuginfo in aktmoduleswitches then
  1347. concatstabto(bsssegment);
  1348. {$endif GDB}
  1349. bssSegment.concat(Tai_datablock.Create_global(mangledname,l));
  1350. { this symbol can't be loaded to a register }
  1351. exclude(varoptions,vo_regable);
  1352. exclude(varoptions,vo_fpuregable);
  1353. end;
  1354. recordsymtable,
  1355. objectsymtable :
  1356. begin
  1357. { this symbol can't be loaded to a register }
  1358. exclude(varoptions,vo_regable);
  1359. exclude(varoptions,vo_fpuregable);
  1360. { get the alignment size }
  1361. if (aktalignment.recordalignmax=-1) then
  1362. begin
  1363. varalign:=vartype.def.alignment;
  1364. if (varalign>4) and ((varalign mod 4)<>0) and
  1365. (vartype.def.deftype=arraydef) then
  1366. begin
  1367. Message1(sym_w_wrong_C_pack,vartype.def.typename);
  1368. end;
  1369. if varalign=0 then
  1370. varalign:=l;
  1371. if (owner.dataalignment<aktalignment.maxCrecordalign) then
  1372. begin
  1373. if (varalign>16) and (owner.dataalignment<32) then
  1374. owner.dataalignment:=32
  1375. else if (varalign>12) and (owner.dataalignment<16) then
  1376. owner.dataalignment:=16
  1377. { 12 is needed for long double }
  1378. else if (varalign>8) and (owner.dataalignment<12) then
  1379. owner.dataalignment:=12
  1380. else if (varalign>4) and (owner.dataalignment<8) then
  1381. owner.dataalignment:=8
  1382. else if (varalign>2) and (owner.dataalignment<4) then
  1383. owner.dataalignment:=4
  1384. else if (varalign>1) and (owner.dataalignment<2) then
  1385. owner.dataalignment:=2;
  1386. end;
  1387. owner.dataalignment:=max(owner.dataalignment,aktalignment.maxCrecordalign);
  1388. end
  1389. else
  1390. varalign:=vartype.def.alignment;
  1391. if varalign=0 then
  1392. varalign:=size_2_align(l);
  1393. varalign:=used_align(varalign,aktalignment.recordalignmin,owner.dataalignment);
  1394. address:=align(owner.datasize,varalign);
  1395. owner.datasize:=address+l;
  1396. end;
  1397. parasymtable :
  1398. begin
  1399. { here we need the size of a push instead of the
  1400. size of the data }
  1401. l:=getpushsize;
  1402. varalign:=size_2_align(l);
  1403. varstate:=vs_assigned;
  1404. { we need the new datasize already aligned so we can't
  1405. use the align_address here }
  1406. address:=owner.datasize;
  1407. varalign:=used_align(varalign,owner.dataalignment,owner.dataalignment);
  1408. owner.datasize:=align(address+l,varalign);
  1409. end
  1410. else
  1411. begin
  1412. modulo:=owner.datasize and 3;
  1413. if (l>=4) and (modulo<>0) then
  1414. inc(owner.datasize,4-modulo)
  1415. else
  1416. if (l>=2) and ((modulo and 1)<>0) then
  1417. inc(owner.datasize);
  1418. address:=owner.datasize;
  1419. inc(owner.datasize,l);
  1420. end;
  1421. end;
  1422. aktfilepos:=storefilepos;
  1423. end;
  1424. end;
  1425. {$ifdef GDB}
  1426. function tvarsym.stabstring : pchar;
  1427. var
  1428. st : string;
  1429. begin
  1430. st:=tstoreddef(vartype.def).numberstring;
  1431. if (owner.symtabletype = objectsymtable) and
  1432. (sp_static in symoptions) then
  1433. begin
  1434. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1435. stabstring := strpnew('"'+upper(owner.name^)+'__'+name+':'+st+
  1436. '",'+
  1437. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1438. end
  1439. else if (owner.symtabletype = globalsymtable) then
  1440. begin
  1441. { Here we used S instead of
  1442. because with G GDB doesn't look at the address field
  1443. but searches the same name or with a leading underscore
  1444. but these names don't exist in pascal !}
  1445. if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
  1446. stabstring := strpnew('"'+name+':'+st+'",'+
  1447. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1448. end
  1449. else if owner.symtabletype = staticsymtable then
  1450. begin
  1451. stabstring := strpnew('"'+name+':S'+st+'",'+
  1452. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
  1453. end
  1454. else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
  1455. begin
  1456. case varspez of
  1457. vs_out,
  1458. vs_var : st := 'v'+st;
  1459. vs_value,
  1460. vs_const : if push_addr_param(vartype.def) then
  1461. st := 'v'+st { should be 'i' but 'i' doesn't work }
  1462. else
  1463. st := 'p'+st;
  1464. end;
  1465. stabstring := strpnew('"'+name+':'+st+'",'+
  1466. tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
  1467. tostr(address+owner.address_fixup));
  1468. {offset to ebp => will not work if the framepointer is esp
  1469. so some optimizing will make things harder to debug }
  1470. end
  1471. else if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) then
  1472. {$ifdef i386}
  1473. if reg<>R_NO then
  1474. begin
  1475. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1476. { this is the register order for GDB}
  1477. stabstring:=strpnew('"'+name+':r'+st+'",'+
  1478. tostr(N_RSYM)+',0,'+
  1479. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1480. end
  1481. else
  1482. {$endif i386}
  1483. { I don't know if this will work (PM) }
  1484. if (vo_is_C_var in varoptions) then
  1485. stabstring := strpnew('"'+name+':S'+st+'",'+
  1486. tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
  1487. else
  1488. stabstring := strpnew('"'+name+':'+st+'",'+
  1489. tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner.address_fixup))
  1490. else
  1491. stabstring := inherited stabstring;
  1492. end;
  1493. procedure tvarsym.concatstabto(asmlist : taasmoutput);
  1494. {$ifdef i386}
  1495. var stab_str : pchar;
  1496. {$endif i386}
  1497. begin
  1498. inherited concatstabto(asmlist);
  1499. {$ifdef i386}
  1500. if (owner.symtabletype=parasymtable) and
  1501. (reg<>R_NO) then
  1502. begin
  1503. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1504. { this is the register order for GDB}
  1505. stab_str:=strpnew('"'+name+':r'
  1506. +tstoreddef(vartype.def).numberstring+'",'+
  1507. tostr(N_RSYM)+',0,'+
  1508. tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
  1509. asmList.concat(Tai_stabs.Create(stab_str));
  1510. end;
  1511. {$endif i386}
  1512. end;
  1513. {$endif GDB}
  1514. {****************************************************************************
  1515. TTYPEDCONSTSYM
  1516. *****************************************************************************}
  1517. constructor ttypedconstsym.create(const n : string;p : tdef;writable : boolean);
  1518. begin
  1519. inherited create(n);
  1520. typ:=typedconstsym;
  1521. typedconsttype.setdef(p);
  1522. is_writable:=writable;
  1523. end;
  1524. constructor ttypedconstsym.createtype(const n : string;const tt : ttype;writable : boolean);
  1525. begin
  1526. inherited create(n);
  1527. typ:=typedconstsym;
  1528. typedconsttype:=tt;
  1529. is_writable:=writable;
  1530. end;
  1531. constructor ttypedconstsym.load(ppufile:tcompilerppufile);
  1532. begin
  1533. inherited loadsym(ppufile);
  1534. typ:=typedconstsym;
  1535. ppufile.gettype(typedconsttype);
  1536. is_writable:=boolean(ppufile.getbyte);
  1537. end;
  1538. destructor ttypedconstsym.destroy;
  1539. begin
  1540. inherited destroy;
  1541. end;
  1542. procedure ttypedconstsym.generate_mangledname;
  1543. begin
  1544. _mangledname:=stringdup(mangledname_prefix('TC',owner)+name);
  1545. end;
  1546. function ttypedconstsym.getsize : longint;
  1547. begin
  1548. if assigned(typedconsttype.def) then
  1549. getsize:=typedconsttype.def.size
  1550. else
  1551. getsize:=0;
  1552. end;
  1553. procedure ttypedconstsym.deref;
  1554. begin
  1555. typedconsttype.resolve;
  1556. end;
  1557. procedure ttypedconstsym.write(ppufile:tcompilerppufile);
  1558. begin
  1559. inherited writesym(ppufile);
  1560. ppufile.puttype(typedconsttype);
  1561. ppufile.putbyte(byte(is_writable));
  1562. ppufile.writeentry(ibtypedconstsym);
  1563. end;
  1564. procedure ttypedconstsym.insert_in_data;
  1565. var
  1566. curconstsegment : taasmoutput;
  1567. address,l,varalign : longint;
  1568. storefilepos : tfileposinfo;
  1569. begin
  1570. storefilepos:=aktfilepos;
  1571. aktfilepos:=akttokenpos;
  1572. if is_writable then
  1573. curconstsegment:=datasegment
  1574. else
  1575. curconstsegment:=consts;
  1576. l:=getsize;
  1577. varalign:=size_2_align(l);
  1578. varalign:=used_align(varalign,aktalignment.constalignmin,aktalignment.constalignmax);
  1579. address:=align(owner.datasize,varalign);
  1580. { insert cut for smartlinking or alignment }
  1581. if (cs_create_smart in aktmoduleswitches) then
  1582. curconstSegment.concat(Tai_cut.Create)
  1583. else if (address<>owner.datasize) then
  1584. curconstSegment.concat(Tai_align.create(varalign));
  1585. owner.datasize:=address+l;
  1586. {$ifdef GDB}
  1587. if cs_debuginfo in aktmoduleswitches then
  1588. concatstabto(curconstsegment);
  1589. {$endif GDB}
  1590. if (owner.symtabletype=globalsymtable) then
  1591. begin
  1592. if (owner.unitid=0) then
  1593. curconstSegment.concat(Tai_symbol.Createdataname_global(mangledname,getsize));
  1594. end
  1595. else
  1596. begin
  1597. if (cs_create_smart in aktmoduleswitches) or
  1598. DLLSource then
  1599. curconstSegment.concat(Tai_symbol.Createdataname_global(mangledname,getsize))
  1600. else
  1601. curconstSegment.concat(Tai_symbol.Createdataname(mangledname,getsize));
  1602. end;
  1603. aktfilepos:=storefilepos;
  1604. end;
  1605. {$ifdef GDB}
  1606. function ttypedconstsym.stabstring : pchar;
  1607. var
  1608. st : char;
  1609. begin
  1610. if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then
  1611. st := 'G'
  1612. else
  1613. st := 'S';
  1614. stabstring := strpnew('"'+name+':'+st+
  1615. tstoreddef(typedconsttype.def).numberstring+'",'+tostr(n_STSYM)+',0,'+
  1616. tostr(fileinfo.line)+','+mangledname);
  1617. end;
  1618. {$endif GDB}
  1619. {****************************************************************************
  1620. TCONSTSYM
  1621. ****************************************************************************}
  1622. constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
  1623. begin
  1624. inherited create(n);
  1625. typ:=constsym;
  1626. consttyp:=t;
  1627. valueord:=v;
  1628. valueordptr:=0;
  1629. valueptr:=nil;
  1630. ResStrIndex:=0;
  1631. consttype.reset;
  1632. len:=0;
  1633. end;
  1634. constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
  1635. begin
  1636. inherited create(n);
  1637. typ:=constsym;
  1638. consttyp:=t;
  1639. valueord:=v;
  1640. valueordptr:=0;
  1641. valueptr:=nil;
  1642. ResStrIndex:=0;
  1643. consttype:=tt;
  1644. len:=0;
  1645. end;
  1646. constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
  1647. begin
  1648. inherited create(n);
  1649. typ:=constsym;
  1650. consttyp:=t;
  1651. valueord:=0;
  1652. valueordptr:=v;
  1653. valueptr:=nil;
  1654. ResStrIndex:=0;
  1655. consttype:=tt;
  1656. len:=0;
  1657. end;
  1658. constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
  1659. begin
  1660. inherited create(n);
  1661. typ:=constsym;
  1662. consttyp:=t;
  1663. valueord:=0;
  1664. valueordptr:=0;
  1665. valueptr:=v;
  1666. ResStrIndex:=0;
  1667. consttype.reset;
  1668. len:=0;
  1669. end;
  1670. constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
  1671. begin
  1672. inherited create(n);
  1673. typ:=constsym;
  1674. consttyp:=t;
  1675. valueord:=0;
  1676. valueordptr:=0;
  1677. valueptr:=v;
  1678. ResStrIndex:=0;
  1679. consttype:=tt;
  1680. len:=0;
  1681. end;
  1682. constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
  1683. begin
  1684. inherited create(n);
  1685. typ:=constsym;
  1686. consttyp:=t;
  1687. valueord:=0;
  1688. valueordptr:=0;
  1689. valueptr:=str;
  1690. consttype.reset;
  1691. len:=l;
  1692. if t=constresourcestring then
  1693. ResStrIndex:=ResourceStrings.Register(name,pchar(valueptr),len);
  1694. end;
  1695. constructor tconstsym.load(ppufile:tcompilerppufile);
  1696. var
  1697. pd : pbestreal;
  1698. ps : pnormalset;
  1699. pc : pchar;
  1700. l1,l2 : longint;
  1701. begin
  1702. inherited loadsym(ppufile);
  1703. typ:=constsym;
  1704. consttype.reset;
  1705. consttyp:=tconsttyp(ppufile.getbyte);
  1706. valueord:=0;
  1707. valueordptr:=0;
  1708. valueptr:=nil;
  1709. case consttyp of
  1710. constint:
  1711. if sizeof(tconstexprint)=8 then
  1712. begin
  1713. l1:=ppufile.getlongint;
  1714. l2:=ppufile.getlongint;
  1715. {$ifopt R+}
  1716. {$define Range_check_on}
  1717. {$endif opt R+}
  1718. {$R- needed here }
  1719. valueord:=qword(l1)+(int64(l2) shl 32);
  1720. {$ifdef Range_check_on}
  1721. {$R+}
  1722. {$undef Range_check_on}
  1723. {$endif Range_check_on}
  1724. end
  1725. else
  1726. valueord:=ppufile.getlongint;
  1727. constwchar,
  1728. constbool,
  1729. constchar :
  1730. valueord:=ppufile.getlongint;
  1731. constord :
  1732. begin
  1733. ppufile.gettype(consttype);
  1734. if sizeof(TConstExprInt)=8 then
  1735. begin
  1736. l1:=ppufile.getlongint;
  1737. l2:=ppufile.getlongint;
  1738. {$ifopt R+}
  1739. {$define Range_check_on}
  1740. {$endif opt R+}
  1741. {$R- needed here }
  1742. valueord:=qword(l1)+(int64(l2) shl 32);
  1743. {$ifdef Range_check_on}
  1744. {$R+}
  1745. {$undef Range_check_on}
  1746. {$endif Range_check_on}
  1747. end
  1748. else
  1749. valueord:=ppufile.getlongint;
  1750. end;
  1751. constpointer :
  1752. begin
  1753. ppufile.gettype(consttype);
  1754. if sizeof(TConstPtrUInt)=8 then
  1755. begin
  1756. l1:=ppufile.getlongint;
  1757. l2:=ppufile.getlongint;
  1758. {$ifopt R+}
  1759. {$define Range_check_on}
  1760. {$endif opt R+}
  1761. {$R- needed here }
  1762. valueordptr:=qword(l1)+(int64(l2) shl 32);
  1763. {$ifdef Range_check_on}
  1764. {$R+}
  1765. {$undef Range_check_on}
  1766. {$endif Range_check_on}
  1767. end
  1768. else
  1769. valueordptr:=cardinal(ppufile.getlongint);
  1770. end;
  1771. conststring,
  1772. constresourcestring :
  1773. begin
  1774. len:=ppufile.getlongint;
  1775. getmem(pc,len+1);
  1776. ppufile.getdata(pc^,len);
  1777. if consttyp=constresourcestring then
  1778. ResStrIndex:=ppufile.getlongint;
  1779. valueptr:=pc;
  1780. end;
  1781. constreal :
  1782. begin
  1783. new(pd);
  1784. pd^:=ppufile.getreal;
  1785. valueptr:=pd;
  1786. end;
  1787. constset :
  1788. begin
  1789. ppufile.gettype(consttype);
  1790. new(ps);
  1791. ppufile.getnormalset(ps^);
  1792. valueptr:=ps;
  1793. end;
  1794. constnil : ;
  1795. else
  1796. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1797. end;
  1798. end;
  1799. destructor tconstsym.destroy;
  1800. begin
  1801. case consttyp of
  1802. conststring,
  1803. constresourcestring :
  1804. freemem(pchar(valueptr),len+1);
  1805. constreal :
  1806. dispose(pbestreal(valueptr));
  1807. constset :
  1808. dispose(pnormalset(valueptr));
  1809. end;
  1810. inherited destroy;
  1811. end;
  1812. function tconstsym.mangledname : string;
  1813. begin
  1814. mangledname:=name;
  1815. end;
  1816. procedure tconstsym.deref;
  1817. begin
  1818. if consttyp in [constord,constpointer,constset] then
  1819. consttype.resolve;
  1820. end;
  1821. procedure tconstsym.write(ppufile:tcompilerppufile);
  1822. begin
  1823. inherited writesym(ppufile);
  1824. ppufile.putbyte(byte(consttyp));
  1825. case consttyp of
  1826. constnil : ;
  1827. constint:
  1828. begin
  1829. if sizeof(TConstExprInt)=8 then
  1830. begin
  1831. ppufile.putlongint(longint(lo(valueord)));
  1832. ppufile.putlongint(longint(hi(valueord)));
  1833. end
  1834. else
  1835. ppufile.putlongint(valueord);
  1836. end;
  1837. constbool,
  1838. constchar :
  1839. ppufile.putlongint(valueord);
  1840. constord :
  1841. begin
  1842. ppufile.puttype(consttype);
  1843. if sizeof(TConstExprInt)=8 then
  1844. begin
  1845. ppufile.putlongint(longint(lo(valueord)));
  1846. ppufile.putlongint(longint(hi(valueord)));
  1847. end
  1848. else
  1849. ppufile.putlongint(valueord);
  1850. end;
  1851. constpointer :
  1852. begin
  1853. ppufile.puttype(consttype);
  1854. if sizeof(TConstPtrUInt)=8 then
  1855. begin
  1856. ppufile.putlongint(longint(lo(valueordptr)));
  1857. ppufile.putlongint(longint(hi(valueordptr)));
  1858. end
  1859. else
  1860. ppufile.putlongint(longint(valueordptr));
  1861. end;
  1862. conststring,
  1863. constresourcestring :
  1864. begin
  1865. ppufile.putlongint(len);
  1866. ppufile.putdata(pchar(valueptr)^,len);
  1867. if consttyp=constresourcestring then
  1868. ppufile.putlongint(ResStrIndex);
  1869. end;
  1870. constreal :
  1871. ppufile.putreal(pbestreal(valueptr)^);
  1872. constset :
  1873. begin
  1874. ppufile.puttype(consttype);
  1875. ppufile.putnormalset(valueptr^);
  1876. end;
  1877. else
  1878. internalerror(13);
  1879. end;
  1880. ppufile.writeentry(ibconstsym);
  1881. end;
  1882. {$ifdef GDB}
  1883. function tconstsym.stabstring : pchar;
  1884. var st : string;
  1885. begin
  1886. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  1887. case consttyp of
  1888. conststring : begin
  1889. st := 's'''+strpas(pchar(valueptr))+'''';
  1890. end;
  1891. constbool,
  1892. constint,
  1893. constord,
  1894. constchar : st := 'i'+int64tostr(valueord);
  1895. constpointer :
  1896. st := 'i'+int64tostr(valueordptr);
  1897. constreal : begin
  1898. system.str(pbestreal(valueptr)^,st);
  1899. st := 'r'+st;
  1900. end;
  1901. { if we don't know just put zero !! }
  1902. else st:='i0';
  1903. {***SETCONST}
  1904. {constset:;} {*** I don't know what to do with a set.}
  1905. { sets are not recognized by GDB}
  1906. {***}
  1907. end;
  1908. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  1909. tostr(fileinfo.line)+',0');
  1910. end;
  1911. procedure tconstsym.concatstabto(asmlist : taasmoutput);
  1912. begin
  1913. if consttyp <> conststring then
  1914. inherited concatstabto(asmlist);
  1915. end;
  1916. {$endif GDB}
  1917. {****************************************************************************
  1918. TENUMSYM
  1919. ****************************************************************************}
  1920. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  1921. begin
  1922. inherited create(n);
  1923. typ:=enumsym;
  1924. definition:=def;
  1925. value:=v;
  1926. { check for jumps }
  1927. if v>def.max+1 then
  1928. def.has_jumps:=true;
  1929. { update low and high }
  1930. if def.min>v then
  1931. def.setmin(v);
  1932. if def.max<v then
  1933. def.setmax(v);
  1934. order;
  1935. end;
  1936. constructor tenumsym.load(ppufile:tcompilerppufile);
  1937. begin
  1938. inherited loadsym(ppufile);
  1939. typ:=enumsym;
  1940. definition:=tenumdef(ppufile.getderef);
  1941. value:=ppufile.getlongint;
  1942. nextenum := Nil;
  1943. end;
  1944. procedure tenumsym.deref;
  1945. begin
  1946. resolvedef(pointer(definition));
  1947. order;
  1948. end;
  1949. procedure tenumsym.order;
  1950. var
  1951. sym : tenumsym;
  1952. begin
  1953. sym := tenumsym(definition.firstenum);
  1954. if sym = nil then
  1955. begin
  1956. definition.firstenum := self;
  1957. nextenum := nil;
  1958. exit;
  1959. end;
  1960. { reorder the symbols in increasing value }
  1961. if value < sym.value then
  1962. begin
  1963. nextenum := sym;
  1964. definition.firstenum := self;
  1965. end
  1966. else
  1967. begin
  1968. while (sym.value <= value) and assigned(sym.nextenum) do
  1969. sym := sym.nextenum;
  1970. nextenum := sym.nextenum;
  1971. sym.nextenum := self;
  1972. end;
  1973. end;
  1974. procedure tenumsym.write(ppufile:tcompilerppufile);
  1975. begin
  1976. inherited writesym(ppufile);
  1977. ppufile.putderef(definition);
  1978. ppufile.putlongint(value);
  1979. ppufile.writeentry(ibenumsym);
  1980. end;
  1981. {$ifdef GDB}
  1982. procedure tenumsym.concatstabto(asmlist : taasmoutput);
  1983. begin
  1984. {enum elements have no stab !}
  1985. end;
  1986. {$EndIf GDB}
  1987. {****************************************************************************
  1988. TTYPESYM
  1989. ****************************************************************************}
  1990. constructor ttypesym.create(const n : string;const tt : ttype);
  1991. begin
  1992. inherited create(n);
  1993. typ:=typesym;
  1994. restype:=tt;
  1995. {$ifdef GDB}
  1996. isusedinstab := false;
  1997. {$endif GDB}
  1998. { register the typesym for the definition }
  1999. if assigned(restype.def) and
  2000. (restype.def.deftype<>errordef) and
  2001. not(assigned(restype.def.typesym)) then
  2002. restype.def.typesym:=self;
  2003. end;
  2004. constructor ttypesym.load(ppufile:tcompilerppufile);
  2005. begin
  2006. inherited loadsym(ppufile);
  2007. typ:=typesym;
  2008. {$ifdef GDB}
  2009. isusedinstab := false;
  2010. {$endif GDB}
  2011. ppufile.gettype(restype);
  2012. end;
  2013. function ttypesym.gettypedef:tdef;
  2014. begin
  2015. gettypedef:=restype.def;
  2016. end;
  2017. procedure ttypesym.deref;
  2018. begin
  2019. restype.resolve;
  2020. end;
  2021. procedure ttypesym.write(ppufile:tcompilerppufile);
  2022. begin
  2023. inherited writesym(ppufile);
  2024. ppufile.puttype(restype);
  2025. ppufile.writeentry(ibtypesym);
  2026. end;
  2027. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  2028. begin
  2029. inherited load_references(ppufile,locals);
  2030. if (restype.def.deftype=recorddef) then
  2031. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  2032. if (restype.def.deftype=objectdef) then
  2033. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  2034. end;
  2035. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  2036. begin
  2037. if not inherited write_references(ppufile,locals) then
  2038. begin
  2039. { write address of this symbol if record or object
  2040. even if no real refs are there
  2041. because we need it for the symtable }
  2042. if (restype.def.deftype in [recorddef,objectdef]) then
  2043. begin
  2044. ppufile.putderef(self);
  2045. ppufile.writeentry(ibsymref);
  2046. end;
  2047. end;
  2048. write_references:=true;
  2049. if (restype.def.deftype=recorddef) then
  2050. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  2051. if (restype.def.deftype=objectdef) then
  2052. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  2053. end;
  2054. {$ifdef GDB}
  2055. function ttypesym.stabstring : pchar;
  2056. var
  2057. stabchar : string[2];
  2058. short : string;
  2059. begin
  2060. if restype.def.deftype in tagtypes then
  2061. stabchar := 'Tt'
  2062. else
  2063. stabchar := 't';
  2064. short := '"'+name+':'+stabchar+tstoreddef(restype.def).numberstring
  2065. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  2066. stabstring := strpnew(short);
  2067. end;
  2068. procedure ttypesym.concatstabto(asmlist : taasmoutput);
  2069. begin
  2070. {not stabs for forward defs }
  2071. if assigned(restype.def) then
  2072. if (restype.def.typesym = self) then
  2073. tstoreddef(restype.def).concatstabto(asmlist)
  2074. else
  2075. inherited concatstabto(asmlist);
  2076. end;
  2077. {$endif GDB}
  2078. {****************************************************************************
  2079. TSYSSYM
  2080. ****************************************************************************}
  2081. constructor tsyssym.create(const n : string;l : longint);
  2082. begin
  2083. inherited create(n);
  2084. typ:=syssym;
  2085. number:=l;
  2086. end;
  2087. constructor tsyssym.load(ppufile:tcompilerppufile);
  2088. begin
  2089. inherited loadsym(ppufile);
  2090. typ:=syssym;
  2091. number:=ppufile.getlongint;
  2092. end;
  2093. destructor tsyssym.destroy;
  2094. begin
  2095. inherited destroy;
  2096. end;
  2097. procedure tsyssym.write(ppufile:tcompilerppufile);
  2098. begin
  2099. inherited writesym(ppufile);
  2100. ppufile.putlongint(number);
  2101. ppufile.writeentry(ibsyssym);
  2102. end;
  2103. {$ifdef GDB}
  2104. procedure tsyssym.concatstabto(asmlist : taasmoutput);
  2105. begin
  2106. end;
  2107. {$endif GDB}
  2108. {****************************************************************************
  2109. TRTTISYM
  2110. ****************************************************************************}
  2111. constructor trttisym.create(const n:string;rt:trttitype);
  2112. const
  2113. prefix : array[trttitype] of string[5]=('$rtti','$init');
  2114. begin
  2115. inherited create(prefix[rt]+n);
  2116. typ:=rttisym;
  2117. lab:=nil;
  2118. rttityp:=rt;
  2119. end;
  2120. constructor trttisym.load(ppufile:tcompilerppufile);
  2121. begin
  2122. inherited loadsym(ppufile);
  2123. typ:=rttisym;
  2124. lab:=nil;
  2125. rttityp:=trttitype(ppufile.getbyte);
  2126. end;
  2127. procedure trttisym.write(ppufile:tcompilerppufile);
  2128. begin
  2129. inherited writesym(ppufile);
  2130. ppufile.putbyte(byte(rttityp));
  2131. ppufile.writeentry(ibrttisym);
  2132. end;
  2133. function trttisym.mangledname : string;
  2134. const
  2135. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2136. var
  2137. s : string;
  2138. p : tsymtable;
  2139. begin
  2140. s:='';
  2141. p:=owner;
  2142. while assigned(p) and (p.symtabletype=localsymtable) do
  2143. begin
  2144. s:=s+'_'+p.defowner.name;
  2145. p:=p.defowner.owner;
  2146. end;
  2147. if not(p.symtabletype in [globalsymtable,staticsymtable]) then
  2148. internalerror(200108265);
  2149. mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
  2150. end;
  2151. function trttisym.get_label:tasmsymbol;
  2152. begin
  2153. { the label is always a global label }
  2154. if not assigned(lab) then
  2155. lab:=newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
  2156. get_label:=lab;
  2157. end;
  2158. { persistent rtti generation }
  2159. procedure generate_rtti(p:tsym);
  2160. var
  2161. rsym : trttisym;
  2162. def : tstoreddef;
  2163. begin
  2164. { rtti can only be generated for classes that are always typesyms }
  2165. if not(p.typ=typesym) then
  2166. internalerror(200108261);
  2167. def:=tstoreddef(ttypesym(p).restype.def);
  2168. { only create rtti once for each definition }
  2169. if not(df_has_rttitable in def.defoptions) then
  2170. begin
  2171. { definition should be in the same symtable as the symbol }
  2172. if p.owner<>def.owner then
  2173. internalerror(200108262);
  2174. { create rttisym }
  2175. rsym:=trttisym.create(p.name,fullrtti);
  2176. p.owner.insert(rsym);
  2177. { register rttisym in definition }
  2178. include(def.defoptions,df_has_rttitable);
  2179. def.rttitablesym:=rsym;
  2180. { write rtti data }
  2181. def.write_child_rtti_data(fullrtti);
  2182. if (cs_create_smart in aktmoduleswitches) then
  2183. rttiList.concat(Tai_cut.Create);
  2184. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2185. def.write_rtti_data(fullrtti);
  2186. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2187. end;
  2188. end;
  2189. { persistent init table generation }
  2190. procedure generate_inittable(p:tsym);
  2191. var
  2192. rsym : trttisym;
  2193. def : tstoreddef;
  2194. begin
  2195. { anonymous types are also allowed for records that can be varsym }
  2196. case p.typ of
  2197. typesym :
  2198. def:=tstoreddef(ttypesym(p).restype.def);
  2199. varsym :
  2200. def:=tstoreddef(tvarsym(p).vartype.def);
  2201. else
  2202. internalerror(200108263);
  2203. end;
  2204. { only create inittable once for each definition }
  2205. if not(df_has_inittable in def.defoptions) then
  2206. begin
  2207. { definition should be in the same symtable as the symbol }
  2208. if p.owner<>def.owner then
  2209. internalerror(200108264);
  2210. { create rttisym }
  2211. rsym:=trttisym.create(p.name,initrtti);
  2212. p.owner.insert(rsym);
  2213. { register rttisym in definition }
  2214. include(def.defoptions,df_has_inittable);
  2215. def.inittablesym:=rsym;
  2216. { write inittable data }
  2217. def.write_child_rtti_data(initrtti);
  2218. if (cs_create_smart in aktmoduleswitches) then
  2219. rttiList.concat(Tai_cut.Create);
  2220. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2221. def.write_rtti_data(initrtti);
  2222. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2223. end;
  2224. end;
  2225. end.
  2226. {
  2227. $Log$
  2228. Revision 1.38 2002-05-16 19:46:45 carl
  2229. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2230. + try to fix temp allocation (still in ifdef)
  2231. + generic constructor calls
  2232. + start of tassembler / tmodulebase class cleanup
  2233. Revision 1.36 2002/05/12 16:53:15 peter
  2234. * moved entry and exitcode to ncgutil and cgobj
  2235. * foreach gets extra argument for passing local data to the
  2236. iterator function
  2237. * -CR checks also class typecasts at runtime by changing them
  2238. into as
  2239. * fixed compiler to cycle with the -CR option
  2240. * fixed stabs with elf writer, finally the global variables can
  2241. be watched
  2242. * removed a lot of routines from cga unit and replaced them by
  2243. calls to cgobj
  2244. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2245. u32bit then the other is typecasted also to u32bit without giving
  2246. a rangecheck warning/error.
  2247. * fixed pascal calling method with reversing also the high tree in
  2248. the parast, detected by tcalcst3 test
  2249. Revision 1.35 2002/04/19 15:46:03 peter
  2250. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  2251. in most cases and not written to the ppu
  2252. * add mangeledname_prefix() routine to generate the prefix of
  2253. manglednames depending on the current procedure, object and module
  2254. * removed static procprefix since the mangledname is now build only
  2255. on demand from tprocdef.mangledname
  2256. Revision 1.34 2002/04/16 16:12:47 peter
  2257. * give error when using enums with jumps as array index
  2258. * allow char as enum value
  2259. Revision 1.33 2002/04/15 19:08:22 carl
  2260. + target_info.size_of_pointer -> pointer_size
  2261. + some cleanup of unused types/variables
  2262. Revision 1.32 2002/04/07 13:37:29 carl
  2263. + change unit use
  2264. Revision 1.31 2002/02/03 09:30:04 peter
  2265. * more fixes for protected handling
  2266. Revision 1.30 2001/12/31 16:59:43 peter
  2267. * protected/private symbols parsing fixed
  2268. Revision 1.29 2001/12/03 21:48:42 peter
  2269. * freemem change to value parameter
  2270. * torddef low/high range changed to int64
  2271. Revision 1.28 2001/11/30 16:25:35 jonas
  2272. * fixed web bug 1707:
  2273. * tvarsym.getvaluesize doesn't return 0 anymore for dynarrays (found
  2274. by Florian)
  2275. * in genrtti, some more ppointer(data)^ tricks were necessary
  2276. Revision 1.27 2001/11/18 18:43:16 peter
  2277. * overloading supported in child classes
  2278. * fixed parsing of classes with private and virtual and overloaded
  2279. so it is compatible with delphi
  2280. Revision 1.26 2001/11/02 22:58:08 peter
  2281. * procsym definition rewrite
  2282. Revision 1.25 2001/10/25 21:22:40 peter
  2283. * calling convention rewrite
  2284. Revision 1.24 2001/10/23 21:49:43 peter
  2285. * $calling directive and -Cc commandline patch added
  2286. from Pavel Ozerski
  2287. Revision 1.23 2001/10/20 20:30:21 peter
  2288. * read only typed const support, switch $J-
  2289. Revision 1.22 2001/09/19 11:04:42 michael
  2290. * Smartlinking with interfaces fixed
  2291. * Better smartlinking for rtti and init tables
  2292. Revision 1.21 2001/09/02 21:18:29 peter
  2293. * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
  2294. is used for holding target platform pointer values. As those can be
  2295. bigger than the source platform.
  2296. Revision 1.20 2001/08/30 20:13:54 peter
  2297. * rtti/init table updates
  2298. * rttisym for reusable global rtti/init info
  2299. * support published for interfaces
  2300. Revision 1.19 2001/08/26 13:36:50 florian
  2301. * some cg reorganisation
  2302. * some PPC updates
  2303. Revision 1.18 2001/08/19 09:39:28 peter
  2304. * local browser support fixed
  2305. Revision 1.16 2001/08/12 20:00:26 peter
  2306. * don't write fpuregable for varoptions
  2307. Revision 1.15 2001/08/06 21:40:48 peter
  2308. * funcret moved from tprocinfo to tprocdef
  2309. Revision 1.14 2001/07/01 20:16:17 peter
  2310. * alignmentinfo record added
  2311. * -Oa argument supports more alignment settings that can be specified
  2312. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  2313. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  2314. required alignment and the maximum usefull alignment. The final
  2315. alignment will be choosen per variable size dependent on these
  2316. settings
  2317. Revision 1.13 2001/05/08 21:06:32 florian
  2318. * some more support for widechars commited especially
  2319. regarding type casting and constants
  2320. Revision 1.12 2001/05/06 14:49:17 peter
  2321. * ppu object to class rewrite
  2322. * move ppu read and write stuff to fppu
  2323. Revision 1.11 2001/04/18 22:01:59 peter
  2324. * registration of targets and assemblers
  2325. Revision 1.10 2001/04/13 01:22:16 peter
  2326. * symtable change to classes
  2327. * range check generation and errors fixed, make cycle DEBUG=1 works
  2328. * memory leaks fixed
  2329. Revision 1.9 2001/04/02 21:20:35 peter
  2330. * resulttype rewrite
  2331. Revision 1.8 2001/03/11 22:58:51 peter
  2332. * getsym redesign, removed the globals srsym,srsymtable
  2333. Revision 1.7 2000/12/25 00:07:30 peter
  2334. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  2335. tlinkedlist objects)
  2336. Revision 1.6 2000/11/28 00:25:17 pierre
  2337. + use int64tostr function for integer consts
  2338. Revision 1.5 2000/11/13 14:44:35 jonas
  2339. * fixes so no more range errors with improved range checking code
  2340. Revision 1.4 2000/11/08 23:15:17 florian
  2341. * tprocdef.procsym must be set also when a tprocdef is loaded from a PPU
  2342. Revision 1.3 2000/11/06 23:13:53 peter
  2343. * uppercase manglednames
  2344. Revision 1.2 2000/11/01 23:04:38 peter
  2345. * tprocdef.fullprocname added for better casesensitve writing of
  2346. procedures
  2347. Revision 1.1 2000/10/31 22:02:52 peter
  2348. * symtable splitted, no real code changes
  2349. }