symsym.pas 84 KB

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