symsym.pas 86 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771
  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 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. { 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 load(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 write(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 load(ppufile:tcompilerppufile);
  134. procedure write(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 load(ppufile:tcompilerppufile);
  156. destructor destroy;override;
  157. procedure write(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 load(ppufile:tcompilerppufile);
  183. function getsize : longint;
  184. procedure write(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 load(ppufile:tcompilerppufile);
  199. destructor destroy;override;
  200. procedure write(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 load(ppufile:tcompilerppufile);
  214. procedure deref;override;
  215. function mangledname : string;
  216. procedure write(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 load(ppufile:tcompilerppufile);
  228. destructor destroy;override;
  229. procedure generate_mangledname;override;
  230. procedure write(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 load(ppufile:tcompilerppufile);
  253. destructor destroy;override;
  254. function mangledname : string;
  255. procedure deref;override;
  256. procedure write(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 load(ppufile:tcompilerppufile);
  268. procedure write(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 load(ppufile:tcompilerppufile);
  279. destructor destroy;override;
  280. procedure write(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 load(ppufile:tcompilerppufile);
  291. procedure write(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. const
  317. current_object_option : tsymoptions = [sp_public];
  318. { rtti and init/final }
  319. procedure generate_rtti(p:tsym);
  320. procedure generate_inittable(p:tsym);
  321. implementation
  322. uses
  323. {$ifdef Delphi}
  324. sysutils,
  325. {$else Delphi}
  326. strings,
  327. {$endif Delphi}
  328. { global }
  329. globtype,verbose,
  330. { target }
  331. systems,
  332. { symtable }
  333. symtable,defbase,
  334. {$ifdef GDB}
  335. gdb,
  336. {$endif GDB}
  337. { tree }
  338. node,
  339. { aasm }
  340. aasmcpu,
  341. { module }
  342. fmodule,
  343. { codegen }
  344. paramgr,cgbase,cresstr
  345. ;
  346. {****************************************************************************
  347. Helpers
  348. ****************************************************************************}
  349. {****************************************************************************
  350. TSYM (base for all symtypes)
  351. ****************************************************************************}
  352. constructor tstoredsym.create(const n : string);
  353. begin
  354. inherited create(n);
  355. symoptions:=current_object_option;
  356. {$ifdef GDB}
  357. isstabwritten := false;
  358. {$endif GDB}
  359. fileinfo:=akttokenpos;
  360. defref:=nil;
  361. refs:=0;
  362. lastwritten:=nil;
  363. refcount:=0;
  364. if (cs_browser in aktmoduleswitches) and make_ref then
  365. begin
  366. defref:=tref.create(defref,@akttokenpos);
  367. inc(refcount);
  368. end;
  369. lastref:=defref;
  370. _mangledname:=nil;
  371. end;
  372. constructor tstoredsym.loadsym(ppufile:tcompilerppufile);
  373. var
  374. s : string;
  375. nr : word;
  376. begin
  377. nr:=ppufile.getword;
  378. s:=ppufile.getstring;
  379. inherited create(s);
  380. { force the correct indexnr. must be after create! }
  381. indexnr:=nr;
  382. ppufile.getsmallset(symoptions);
  383. ppufile.getposinfo(fileinfo);
  384. lastref:=nil;
  385. defref:=nil;
  386. refs:=0;
  387. lastwritten:=nil;
  388. refcount:=0;
  389. _mangledname:=nil;
  390. {$ifdef GDB}
  391. isstabwritten := false;
  392. {$endif GDB}
  393. end;
  394. procedure tstoredsym.deref;
  395. begin
  396. end;
  397. procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
  398. var
  399. pos : tfileposinfo;
  400. move_last : boolean;
  401. begin
  402. move_last:=lastwritten=lastref;
  403. while (not ppufile.endofentry) do
  404. begin
  405. ppufile.getposinfo(pos);
  406. inc(refcount);
  407. lastref:=tref.create(lastref,@pos);
  408. lastref.is_written:=true;
  409. if refcount=1 then
  410. defref:=lastref;
  411. end;
  412. if move_last then
  413. lastwritten:=lastref;
  414. end;
  415. { big problem here :
  416. wrong refs were written because of
  417. interface parsing of other units PM
  418. moduleindex must be checked !! }
  419. function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  420. var
  421. ref : tref;
  422. symref_written,move_last : boolean;
  423. begin
  424. write_references:=false;
  425. if lastwritten=lastref then
  426. exit;
  427. { should we update lastref }
  428. move_last:=true;
  429. symref_written:=false;
  430. { write symbol refs }
  431. if assigned(lastwritten) then
  432. ref:=lastwritten
  433. else
  434. ref:=defref;
  435. while assigned(ref) do
  436. begin
  437. if ref.moduleindex=current_module.unit_index then
  438. begin
  439. { write address to this symbol }
  440. if not symref_written then
  441. begin
  442. ppufile.putderef(self);
  443. symref_written:=true;
  444. end;
  445. ppufile.putposinfo(ref.posinfo);
  446. ref.is_written:=true;
  447. if move_last then
  448. lastwritten:=ref;
  449. end
  450. else if not ref.is_written then
  451. move_last:=false
  452. else if move_last then
  453. lastwritten:=ref;
  454. ref:=ref.nextref;
  455. end;
  456. if symref_written then
  457. ppufile.writeentry(ibsymref);
  458. write_references:=symref_written;
  459. end;
  460. destructor tstoredsym.destroy;
  461. begin
  462. if assigned(_mangledname) then
  463. stringdispose(_mangledname);
  464. if assigned(defref) then
  465. begin
  466. defref.freechain;
  467. defref.free;
  468. end;
  469. inherited destroy;
  470. end;
  471. procedure tstoredsym.writesym(ppufile:tcompilerppufile);
  472. begin
  473. ppufile.putword(indexnr);
  474. ppufile.putstring(_realname^);
  475. ppufile.putsmallset(symoptions);
  476. ppufile.putposinfo(fileinfo);
  477. end;
  478. { for most symbol types there is nothing to do at all }
  479. procedure tstoredsym.insert_in_data;
  480. begin
  481. end;
  482. {$ifdef GDB}
  483. function tstoredsym.stabstring : pchar;
  484. begin
  485. stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
  486. tostr(fileinfo.line)+',0');
  487. end;
  488. procedure tstoredsym.concatstabto(asmlist : taasmoutput);
  489. var
  490. stab_str : pchar;
  491. begin
  492. if not isstabwritten then
  493. begin
  494. stab_str := stabstring;
  495. { count_dbx(stab_str); moved to GDB.PAS }
  496. asmList.concat(Tai_stabs.Create(stab_str));
  497. isstabwritten:=true;
  498. end;
  499. end;
  500. {$endif GDB}
  501. function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
  502. begin
  503. is_visible_for_proc:=false;
  504. { private symbols are allowed when we are in the same
  505. module as they are defined }
  506. if (sp_private in symoptions) and
  507. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  508. (owner.defowner.owner.unitid<>0) then
  509. exit;
  510. { protected symbols are vissible in the module that defines them and
  511. also visible to related objects }
  512. if (sp_protected in symoptions) and
  513. (
  514. (
  515. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  516. (owner.defowner.owner.unitid<>0)
  517. ) and
  518. not(
  519. assigned(currprocdef) and
  520. assigned(currprocdef._class) and
  521. currprocdef._class.is_related(tobjectdef(owner.defowner))
  522. )
  523. ) then
  524. exit;
  525. is_visible_for_proc:=true;
  526. end;
  527. function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
  528. begin
  529. is_visible_for_object:=false;
  530. { private symbols are allowed when we are in the same
  531. module as they are defined }
  532. if (sp_private in symoptions) and
  533. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  534. (owner.defowner.owner.unitid<>0) then
  535. exit;
  536. { protected symbols are vissible in the module that defines them and
  537. also visible to related objects }
  538. if (sp_protected in symoptions) and
  539. (
  540. (
  541. (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
  542. (owner.defowner.owner.unitid<>0)
  543. ) and
  544. not(
  545. assigned(currobjdef) and
  546. currobjdef.is_related(tobjectdef(owner.defowner))
  547. )
  548. ) then
  549. exit;
  550. is_visible_for_object:=true;
  551. end;
  552. function tstoredsym.mangledname : string;
  553. begin
  554. if not assigned(_mangledname) then
  555. begin
  556. generate_mangledname;
  557. if not assigned(_mangledname) then
  558. internalerror(200204171);
  559. end;
  560. mangledname:=_mangledname^
  561. end;
  562. {****************************************************************************
  563. TLABELSYM
  564. ****************************************************************************}
  565. constructor tlabelsym.create(const n : string; l : tasmlabel);
  566. begin
  567. inherited create(n);
  568. typ:=labelsym;
  569. lab:=l;
  570. used:=false;
  571. defined:=false;
  572. code:=nil;
  573. end;
  574. constructor tlabelsym.load(ppufile:tcompilerppufile);
  575. begin
  576. inherited loadsym(ppufile);
  577. typ:=labelsym;
  578. { this is all dummy
  579. it is only used for local browsing }
  580. lab:=nil;
  581. code:=nil;
  582. used:=false;
  583. defined:=true;
  584. end;
  585. destructor tlabelsym.destroy;
  586. begin
  587. inherited destroy;
  588. end;
  589. procedure tlabelsym.generate_mangledname;
  590. begin
  591. _mangledname:=stringdup(lab.name);
  592. end;
  593. procedure tlabelsym.write(ppufile:tcompilerppufile);
  594. begin
  595. if owner.symtabletype=globalsymtable then
  596. Message(sym_e_ill_label_decl)
  597. else
  598. begin
  599. inherited writesym(ppufile);
  600. ppufile.writeentry(iblabelsym);
  601. end;
  602. end;
  603. {****************************************************************************
  604. TUNITSYM
  605. ****************************************************************************}
  606. constructor tunitsym.create(const n : string;ref : tsymtable);
  607. var
  608. old_make_ref : boolean;
  609. begin
  610. old_make_ref:=make_ref;
  611. make_ref:=false;
  612. inherited create(n);
  613. make_ref:=old_make_ref;
  614. typ:=unitsym;
  615. unitsymtable:=ref;
  616. if assigned(ref) and
  617. (ref.symtabletype=globalsymtable) then
  618. begin
  619. prevsym:=tglobalsymtable(ref).unitsym;
  620. tglobalsymtable(ref).unitsym:=self;
  621. end;
  622. end;
  623. constructor tunitsym.load(ppufile:tcompilerppufile);
  624. begin
  625. inherited loadsym(ppufile);
  626. typ:=unitsym;
  627. unitsymtable:=nil;
  628. prevsym:=nil;
  629. refs:=0;
  630. end;
  631. { we need to remove it from the prevsym chain ! }
  632. procedure tunitsym.restoreunitsym;
  633. var pus,ppus : tunitsym;
  634. begin
  635. if assigned(unitsymtable) and
  636. (unitsymtable.symtabletype=globalsymtable) then
  637. begin
  638. ppus:=nil;
  639. pus:=tglobalsymtable(unitsymtable).unitsym;
  640. if pus=self then
  641. tglobalsymtable(unitsymtable).unitsym:=prevsym
  642. else while assigned(pus) do
  643. begin
  644. if pus=self then
  645. begin
  646. ppus.prevsym:=prevsym;
  647. break;
  648. end
  649. else
  650. begin
  651. ppus:=pus;
  652. pus:=ppus.prevsym;
  653. end;
  654. end;
  655. end;
  656. unitsymtable:=nil;
  657. prevsym:=nil;
  658. end;
  659. destructor tunitsym.destroy;
  660. begin
  661. restoreunitsym;
  662. inherited destroy;
  663. end;
  664. procedure tunitsym.write(ppufile:tcompilerppufile);
  665. begin
  666. inherited writesym(ppufile);
  667. ppufile.writeentry(ibunitsym);
  668. end;
  669. {$ifdef GDB}
  670. procedure tunitsym.concatstabto(asmlist : taasmoutput);
  671. begin
  672. {Nothing to write to stabs !}
  673. end;
  674. {$endif GDB}
  675. {****************************************************************************
  676. TPROCSYM
  677. ****************************************************************************}
  678. constructor tprocsym.create(const n : string);
  679. begin
  680. inherited create(n);
  681. typ:=procsym;
  682. defs:=nil;
  683. owner:=nil;
  684. is_global:=false;
  685. overloadchecked:=false;
  686. overloadcount:=0;
  687. end;
  688. constructor tprocsym.load(ppufile:tcompilerppufile);
  689. var
  690. pd : tprocdef;
  691. begin
  692. inherited loadsym(ppufile);
  693. typ:=procsym;
  694. defs:=nil;
  695. repeat
  696. pd:=tprocdef(ppufile.getderef);
  697. if pd=nil then
  698. break;
  699. addprocdef(pd);
  700. until false;
  701. is_global:=false;
  702. overloadchecked:=false;
  703. overloadcount:=-1; { invalid, not used anymore }
  704. end;
  705. destructor tprocsym.destroy;
  706. var
  707. hp,p : pprocdeflist;
  708. begin
  709. p:=defs;
  710. while assigned(p) do
  711. begin
  712. hp:=p^.next;
  713. dispose(p);
  714. p:=hp;
  715. end;
  716. inherited destroy;
  717. end;
  718. procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
  719. var
  720. p : pprocdeflist;
  721. begin
  722. p:=defs;
  723. while assigned(p) do
  724. begin
  725. if p^.def<>skipdef then
  726. MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
  727. p:=p^.next;
  728. end;
  729. end;
  730. procedure tprocsym.check_forward;
  731. var
  732. p : pprocdeflist;
  733. begin
  734. p:=defs;
  735. while assigned(p) do
  736. begin
  737. if (p^.def.procsym=self) and
  738. (p^.def.forwarddef) then
  739. begin
  740. MessagePos1(fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
  741. { Turn futher error messages off }
  742. p^.def.forwarddef:=false;
  743. end;
  744. p:=p^.next;
  745. end;
  746. end;
  747. procedure tprocsym.deref;
  748. var
  749. p : pprocdeflist;
  750. begin
  751. p:=defs;
  752. while assigned(p) do
  753. begin
  754. resolvedef(pointer(p^.def));
  755. p:=p^.next;
  756. end;
  757. end;
  758. procedure tprocsym.addprocdef(p:tprocdef);
  759. var
  760. pd : pprocdeflist;
  761. begin
  762. new(pd);
  763. pd^.def:=p;
  764. pd^.next:=defs;
  765. defs:=pd;
  766. end;
  767. procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
  768. var pd:Pprocdeflist;
  769. begin
  770. pd:=defs;
  771. while assigned(defs) do
  772. begin
  773. s.addprocdef(pd^.def);
  774. pd:=pd^.next;
  775. end;
  776. end;
  777. function Tprocsym.first_procdef:Tprocdef;
  778. begin
  779. first_procdef:=defs^.def;
  780. end;
  781. function Tprocsym.last_procdef:Tprocdef;
  782. var pd:Pprocdeflist;
  783. begin
  784. pd:=defs;
  785. while assigned(pd) do
  786. begin
  787. last_procdef:=pd^.def;
  788. pd:=pd^.next;
  789. end;
  790. end;
  791. function Tprocsym.search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
  792. var p:Pprocdeflist;
  793. begin
  794. search_procdef_bytype:=nil;
  795. p:=defs;
  796. while p<>nil do
  797. begin
  798. if p^.def.proctypeoption=pt then
  799. begin
  800. search_procdef_bytype:=p^.def;
  801. break;
  802. end;
  803. p:=p^.next;
  804. end;
  805. end;
  806. function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
  807. var pd:Pprocdeflist;
  808. begin
  809. {This function will return the pprocdef of pprocsym that
  810. is the best match for procvardef. When there are multiple
  811. matches it returns nil.}
  812. {Try to find an exact match first.}
  813. search_procdef_byprocvardef:=nil;
  814. pd:=defs;
  815. while assigned(pd) do
  816. begin
  817. if proc_to_procvar_equal(pd^.def,d,true) then
  818. begin
  819. { already found a match ? Then stop and return nil }
  820. if assigned(search_procdef_byprocvardef) then
  821. begin
  822. search_procdef_byprocvardef:=nil;
  823. break;
  824. end;
  825. search_procdef_byprocvardef:=pd^.def;
  826. end;
  827. pd:=pd^.next;
  828. end;
  829. {Try a convertable match, if no exact match was found.}
  830. if not assigned(search_procdef_byprocvardef) and not assigned(pd) then
  831. begin
  832. pd:=defs;
  833. while assigned(pd) do
  834. begin
  835. if proc_to_procvar_equal(pd^.def,d,false) then
  836. begin
  837. { already found a match ? Then stop and return nil }
  838. if assigned(search_procdef_byprocvardef) then
  839. begin
  840. search_procdef_byprocvardef:=nil;
  841. break;
  842. end;
  843. search_procdef_byprocvardef:=pd^.def;
  844. end;
  845. pd:=pd^.next;
  846. end;
  847. end;
  848. end;
  849. function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
  850. matchtype:Tdefmatch):Tprocdef;
  851. var pd:Pprocdeflist;
  852. convtyp:Tconverttype;
  853. a,b:boolean;
  854. begin
  855. search_procdef_byretdef_by1paradef:=nil;
  856. pd:=defs;
  857. while assigned(pd) do
  858. begin
  859. a:=is_equal(retdef,pd^.def.rettype.def);
  860. {Alert alert alert alert alert alert alert!!!
  861. Make sure you never call isconvertable when a=false. You get
  862. endless recursion then. Originally a and b were placed in a
  863. single if statement. There was only one reason that it worked:
  864. short circuit boolean eval.}
  865. if a then
  866. case matchtype of
  867. dm_exact:
  868. b:=TParaItem(pd^.def.para.first).paratype.def=firstpara;
  869. dm_equal:
  870. b:=is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara);
  871. dm_convertl1:
  872. b:=isconvertable(firstpara,Tparaitem(pd^.def.para.first).paratype.def,
  873. convtyp,ordconstn,false)=1;
  874. end;
  875. if a and b then
  876. begin
  877. search_procdef_byretdef_by1paradef:=pd^.def;
  878. break;
  879. end;
  880. pd:=pd^.next;
  881. end;
  882. end;
  883. procedure tprocsym.write(ppufile:tcompilerppufile);
  884. var
  885. p : pprocdeflist;
  886. begin
  887. inherited writesym(ppufile);
  888. p:=defs;
  889. while assigned(p) do
  890. begin
  891. { only write the proc definitions that belong
  892. to this procsym }
  893. if (p^.def.procsym=self) then
  894. ppufile.putderef(p^.def);
  895. p:=p^.next;
  896. end;
  897. ppufile.putderef(nil);
  898. ppufile.writeentry(ibprocsym);
  899. end;
  900. function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
  901. var
  902. p : pprocdeflist;
  903. begin
  904. write_references:=false;
  905. if not inherited write_references(ppufile,locals) then
  906. exit;
  907. write_references:=true;
  908. p:=defs;
  909. while assigned(p) do
  910. begin
  911. if (p^.def.procsym=self) then
  912. p^.def.write_references(ppufile,locals);
  913. p:=p^.next;
  914. end;
  915. end;
  916. procedure tprocsym.unchain_overload;
  917. var
  918. p,hp,
  919. first,
  920. last : pprocdeflist;
  921. begin
  922. { remove all overloaded procdefs from the
  923. procdeflist that are not in the current symtable }
  924. first:=nil;
  925. last:=nil;
  926. p:=defs;
  927. while assigned(p) do
  928. begin
  929. hp:=p^.next;
  930. if (p^.def.procsym=self) then
  931. begin
  932. { keep in list }
  933. if not assigned(first) then
  934. begin
  935. first:=p;
  936. last:=p;
  937. end
  938. else
  939. last^.next:=p;
  940. last:=p;
  941. p^.next:=nil;
  942. end
  943. else
  944. begin
  945. { remove }
  946. dispose(p);
  947. end;
  948. p:=hp;
  949. end;
  950. defs:=first;
  951. end;
  952. {$ifdef GDB}
  953. function tprocsym.stabstring : pchar;
  954. begin
  955. internalerror(200111171);
  956. stabstring:=nil;
  957. end;
  958. procedure tprocsym.concatstabto(asmlist : taasmoutput);
  959. begin
  960. internalerror(200111172);
  961. end;
  962. {$endif GDB}
  963. {****************************************************************************
  964. TERRORSYM
  965. ****************************************************************************}
  966. constructor terrorsym.create;
  967. begin
  968. inherited create('');
  969. typ:=errorsym;
  970. end;
  971. {****************************************************************************
  972. TPROPERTYSYM
  973. ****************************************************************************}
  974. constructor tpropertysym.create(const n : string);
  975. begin
  976. inherited create(n);
  977. typ:=propertysym;
  978. propoptions:=[];
  979. index:=0;
  980. default:=0;
  981. proptype.reset;
  982. indextype.reset;
  983. readaccess:=tsymlist.create;
  984. writeaccess:=tsymlist.create;
  985. storedaccess:=tsymlist.create;
  986. end;
  987. constructor tpropertysym.load(ppufile:tcompilerppufile);
  988. begin
  989. inherited loadsym(ppufile);
  990. typ:=propertysym;
  991. ppufile.getsmallset(propoptions);
  992. if (ppo_is_override in propoptions) then
  993. begin
  994. propoverriden:=tpropertysym(ppufile.getderef);
  995. { we need to have these objects initialized }
  996. readaccess:=tsymlist.create;
  997. writeaccess:=tsymlist.create;
  998. storedaccess:=tsymlist.create;
  999. end
  1000. else
  1001. begin
  1002. ppufile.gettype(proptype);
  1003. index:=ppufile.getlongint;
  1004. default:=ppufile.getlongint;
  1005. ppufile.gettype(indextype);
  1006. readaccess:=ppufile.getsymlist;
  1007. writeaccess:=ppufile.getsymlist;
  1008. storedaccess:=ppufile.getsymlist;
  1009. end;
  1010. end;
  1011. destructor tpropertysym.destroy;
  1012. begin
  1013. readaccess.free;
  1014. writeaccess.free;
  1015. storedaccess.free;
  1016. inherited destroy;
  1017. end;
  1018. function tpropertysym.gettypedef:tdef;
  1019. begin
  1020. gettypedef:=proptype.def;
  1021. end;
  1022. procedure tpropertysym.deref;
  1023. begin
  1024. if (ppo_is_override in propoptions) then
  1025. begin
  1026. resolvesym(pointer(propoverriden));
  1027. dooverride(propoverriden);
  1028. end
  1029. else
  1030. begin
  1031. proptype.resolve;
  1032. indextype.resolve;
  1033. readaccess.resolve;
  1034. writeaccess.resolve;
  1035. storedaccess.resolve;
  1036. end;
  1037. end;
  1038. function tpropertysym.getsize : longint;
  1039. begin
  1040. getsize:=0;
  1041. end;
  1042. procedure tpropertysym.write(ppufile:tcompilerppufile);
  1043. begin
  1044. inherited writesym(ppufile);
  1045. ppufile.putsmallset(propoptions);
  1046. if (ppo_is_override in propoptions) then
  1047. ppufile.putderef(propoverriden)
  1048. else
  1049. begin
  1050. ppufile.puttype(proptype);
  1051. ppufile.putlongint(index);
  1052. ppufile.putlongint(default);
  1053. ppufile.puttype(indextype);
  1054. ppufile.putsymlist(readaccess);
  1055. ppufile.putsymlist(writeaccess);
  1056. ppufile.putsymlist(storedaccess);
  1057. end;
  1058. ppufile.writeentry(ibpropertysym);
  1059. end;
  1060. procedure tpropertysym.dooverride(overriden:tpropertysym);
  1061. begin
  1062. propoverriden:=overriden;
  1063. proptype:=overriden.proptype;
  1064. propoptions:=overriden.propoptions+[ppo_is_override];
  1065. index:=overriden.index;
  1066. default:=overriden.default;
  1067. indextype:=overriden.indextype;
  1068. readaccess.free;
  1069. readaccess:=overriden.readaccess.getcopy;
  1070. writeaccess.free;
  1071. writeaccess:=overriden.writeaccess.getcopy;
  1072. storedaccess.free;
  1073. storedaccess:=overriden.storedaccess.getcopy;
  1074. end;
  1075. {$ifdef GDB}
  1076. function tpropertysym.stabstring : pchar;
  1077. begin
  1078. { !!!! don't know how to handle }
  1079. stabstring:=strpnew('');
  1080. end;
  1081. procedure tpropertysym.concatstabto(asmlist : taasmoutput);
  1082. begin
  1083. { !!!! don't know how to handle }
  1084. end;
  1085. {$endif GDB}
  1086. {****************************************************************************
  1087. TFUNCRETSYM
  1088. ****************************************************************************}
  1089. constructor tfuncretsym.create(const n : string;const tt:ttype);
  1090. begin
  1091. inherited create(n);
  1092. typ:=funcretsym;
  1093. returntype:=tt;
  1094. funcretstate:=vs_declared;
  1095. { address valid for ret in param only }
  1096. { otherwise set by insert }
  1097. address:=pprocinfo(procinfo)^.return_offset;
  1098. end;
  1099. constructor tfuncretsym.load(ppufile:tcompilerppufile);
  1100. begin
  1101. inherited loadsym(ppufile);
  1102. ppufile.gettype(returntype);
  1103. address:=ppufile.getlongint;
  1104. typ:=funcretsym;
  1105. end;
  1106. destructor tfuncretsym.destroy;
  1107. begin
  1108. inherited destroy;
  1109. end;
  1110. procedure tfuncretsym.write(ppufile:tcompilerppufile);
  1111. begin
  1112. inherited writesym(ppufile);
  1113. ppufile.puttype(returntype);
  1114. ppufile.putlongint(address);
  1115. ppufile.writeentry(ibfuncretsym);
  1116. funcretstate:=vs_used;
  1117. end;
  1118. procedure tfuncretsym.deref;
  1119. begin
  1120. returntype.resolve;
  1121. end;
  1122. {$ifdef GDB}
  1123. procedure tfuncretsym.concatstabto(asmlist : taasmoutput);
  1124. begin
  1125. { Nothing to do here, it is done in genexitcode }
  1126. end;
  1127. {$endif GDB}
  1128. procedure tfuncretsym.insert_in_data;
  1129. var
  1130. varalign,l : longint;
  1131. begin
  1132. { if retoffset is already set then reuse it, this is needed
  1133. when inserting the result variable }
  1134. if procinfo^.return_offset<>0 then
  1135. address:=procinfo^.return_offset
  1136. else
  1137. begin
  1138. { allocate space in local if ret in acc or in fpu }
  1139. if paramanager.ret_in_acc(returntype.def) or
  1140. (returntype.def.deftype=floatdef) 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.load(ppufile:tcompilerppufile);
  1160. begin
  1161. { Note: This needs to load everything of tvarsym.write }
  1162. inherited load(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.write(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.load(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.write(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.load(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.write(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.load(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. if sizeof(tconstexprint)=8 then
  1849. begin
  1850. l1:=ppufile.getlongint;
  1851. l2:=ppufile.getlongint;
  1852. {$ifopt R+}
  1853. {$define Range_check_on}
  1854. {$endif opt R+}
  1855. {$R- needed here }
  1856. valueord:=qword(l1)+(int64(l2) shl 32);
  1857. {$ifdef Range_check_on}
  1858. {$R+}
  1859. {$undef Range_check_on}
  1860. {$endif Range_check_on}
  1861. end
  1862. else
  1863. valueord:=ppufile.getlongint;
  1864. constwchar,
  1865. constbool,
  1866. constchar :
  1867. valueord:=ppufile.getlongint;
  1868. constord :
  1869. begin
  1870. ppufile.gettype(consttype);
  1871. if sizeof(TConstExprInt)=8 then
  1872. begin
  1873. l1:=ppufile.getlongint;
  1874. l2:=ppufile.getlongint;
  1875. {$ifopt R+}
  1876. {$define Range_check_on}
  1877. {$endif opt R+}
  1878. {$R- needed here }
  1879. valueord:=qword(l1)+(int64(l2) shl 32);
  1880. {$ifdef Range_check_on}
  1881. {$R+}
  1882. {$undef Range_check_on}
  1883. {$endif Range_check_on}
  1884. end
  1885. else
  1886. valueord:=ppufile.getlongint;
  1887. end;
  1888. constpointer :
  1889. begin
  1890. ppufile.gettype(consttype);
  1891. if sizeof(TConstPtrUInt)=8 then
  1892. begin
  1893. l1:=ppufile.getlongint;
  1894. l2:=ppufile.getlongint;
  1895. {$ifopt R+}
  1896. {$define Range_check_on}
  1897. {$endif opt R+}
  1898. {$R- needed here }
  1899. valueordptr:=qword(l1)+(int64(l2) shl 32);
  1900. {$ifdef Range_check_on}
  1901. {$R+}
  1902. {$undef Range_check_on}
  1903. {$endif Range_check_on}
  1904. end
  1905. else
  1906. valueordptr:=cardinal(ppufile.getlongint);
  1907. end;
  1908. conststring,
  1909. constresourcestring :
  1910. begin
  1911. len:=ppufile.getlongint;
  1912. getmem(pc,len+1);
  1913. ppufile.getdata(pc^,len);
  1914. if consttyp=constresourcestring then
  1915. ResStrIndex:=ppufile.getlongint;
  1916. valueptr:=pc;
  1917. end;
  1918. constreal :
  1919. begin
  1920. new(pd);
  1921. pd^:=ppufile.getreal;
  1922. valueptr:=pd;
  1923. end;
  1924. constset :
  1925. begin
  1926. ppufile.gettype(consttype);
  1927. new(ps);
  1928. ppufile.getnormalset(ps^);
  1929. valueptr:=ps;
  1930. end;
  1931. constnil : ;
  1932. else
  1933. Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
  1934. end;
  1935. end;
  1936. destructor tconstsym.destroy;
  1937. begin
  1938. case consttyp of
  1939. conststring,
  1940. constresourcestring :
  1941. freemem(pchar(valueptr),len+1);
  1942. constreal :
  1943. dispose(pbestreal(valueptr));
  1944. constset :
  1945. dispose(pnormalset(valueptr));
  1946. end;
  1947. inherited destroy;
  1948. end;
  1949. function tconstsym.mangledname : string;
  1950. begin
  1951. mangledname:=name;
  1952. end;
  1953. procedure tconstsym.deref;
  1954. begin
  1955. if consttyp in [constord,constpointer,constset] then
  1956. consttype.resolve;
  1957. end;
  1958. procedure tconstsym.write(ppufile:tcompilerppufile);
  1959. begin
  1960. inherited writesym(ppufile);
  1961. ppufile.putbyte(byte(consttyp));
  1962. case consttyp of
  1963. constnil : ;
  1964. constint:
  1965. begin
  1966. if sizeof(TConstExprInt)=8 then
  1967. begin
  1968. ppufile.putlongint(longint(lo(valueord)));
  1969. ppufile.putlongint(longint(hi(valueord)));
  1970. end
  1971. else
  1972. ppufile.putlongint(valueord);
  1973. end;
  1974. constbool,
  1975. constchar :
  1976. ppufile.putlongint(valueord);
  1977. constord :
  1978. begin
  1979. ppufile.puttype(consttype);
  1980. if sizeof(TConstExprInt)=8 then
  1981. begin
  1982. ppufile.putlongint(longint(lo(valueord)));
  1983. ppufile.putlongint(longint(hi(valueord)));
  1984. end
  1985. else
  1986. ppufile.putlongint(valueord);
  1987. end;
  1988. constpointer :
  1989. begin
  1990. ppufile.puttype(consttype);
  1991. if sizeof(TConstPtrUInt)=8 then
  1992. begin
  1993. ppufile.putlongint(longint(lo(valueordptr)));
  1994. ppufile.putlongint(longint(hi(valueordptr)));
  1995. end
  1996. else
  1997. ppufile.putlongint(longint(valueordptr));
  1998. end;
  1999. conststring,
  2000. constresourcestring :
  2001. begin
  2002. ppufile.putlongint(len);
  2003. ppufile.putdata(pchar(valueptr)^,len);
  2004. if consttyp=constresourcestring then
  2005. ppufile.putlongint(ResStrIndex);
  2006. end;
  2007. constreal :
  2008. ppufile.putreal(pbestreal(valueptr)^);
  2009. constset :
  2010. begin
  2011. ppufile.puttype(consttype);
  2012. ppufile.putnormalset(valueptr^);
  2013. end;
  2014. else
  2015. internalerror(13);
  2016. end;
  2017. ppufile.writeentry(ibconstsym);
  2018. end;
  2019. {$ifdef GDB}
  2020. function tconstsym.stabstring : pchar;
  2021. var st : string;
  2022. begin
  2023. {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  2024. case consttyp of
  2025. conststring : begin
  2026. st := 's'''+strpas(pchar(valueptr))+'''';
  2027. end;
  2028. constbool,
  2029. constint,
  2030. constord,
  2031. constchar : st := 'i'+int64tostr(valueord);
  2032. constpointer :
  2033. st := 'i'+int64tostr(valueordptr);
  2034. constreal : begin
  2035. system.str(pbestreal(valueptr)^,st);
  2036. st := 'r'+st;
  2037. end;
  2038. { if we don't know just put zero !! }
  2039. else st:='i0';
  2040. {***SETCONST}
  2041. {constset:;} {*** I don't know what to do with a set.}
  2042. { sets are not recognized by GDB}
  2043. {***}
  2044. end;
  2045. stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
  2046. tostr(fileinfo.line)+',0');
  2047. end;
  2048. procedure tconstsym.concatstabto(asmlist : taasmoutput);
  2049. begin
  2050. if consttyp <> conststring then
  2051. inherited concatstabto(asmlist);
  2052. end;
  2053. {$endif GDB}
  2054. {****************************************************************************
  2055. TENUMSYM
  2056. ****************************************************************************}
  2057. constructor tenumsym.create(const n : string;def : tenumdef;v : longint);
  2058. begin
  2059. inherited create(n);
  2060. typ:=enumsym;
  2061. definition:=def;
  2062. value:=v;
  2063. { check for jumps }
  2064. if v>def.max+1 then
  2065. def.has_jumps:=true;
  2066. { update low and high }
  2067. if def.min>v then
  2068. def.setmin(v);
  2069. if def.max<v then
  2070. def.setmax(v);
  2071. order;
  2072. end;
  2073. constructor tenumsym.load(ppufile:tcompilerppufile);
  2074. begin
  2075. inherited loadsym(ppufile);
  2076. typ:=enumsym;
  2077. definition:=tenumdef(ppufile.getderef);
  2078. value:=ppufile.getlongint;
  2079. nextenum := Nil;
  2080. end;
  2081. procedure tenumsym.deref;
  2082. begin
  2083. resolvedef(pointer(definition));
  2084. order;
  2085. end;
  2086. procedure tenumsym.order;
  2087. var
  2088. sym : tenumsym;
  2089. begin
  2090. sym := tenumsym(definition.firstenum);
  2091. if sym = nil then
  2092. begin
  2093. definition.firstenum := self;
  2094. nextenum := nil;
  2095. exit;
  2096. end;
  2097. { reorder the symbols in increasing value }
  2098. if value < sym.value then
  2099. begin
  2100. nextenum := sym;
  2101. definition.firstenum := self;
  2102. end
  2103. else
  2104. begin
  2105. while (sym.value <= value) and assigned(sym.nextenum) do
  2106. sym := sym.nextenum;
  2107. nextenum := sym.nextenum;
  2108. sym.nextenum := self;
  2109. end;
  2110. end;
  2111. procedure tenumsym.write(ppufile:tcompilerppufile);
  2112. begin
  2113. inherited writesym(ppufile);
  2114. ppufile.putderef(definition);
  2115. ppufile.putlongint(value);
  2116. ppufile.writeentry(ibenumsym);
  2117. end;
  2118. {$ifdef GDB}
  2119. procedure tenumsym.concatstabto(asmlist : taasmoutput);
  2120. begin
  2121. {enum elements have no stab !}
  2122. end;
  2123. {$EndIf GDB}
  2124. {****************************************************************************
  2125. TTYPESYM
  2126. ****************************************************************************}
  2127. constructor ttypesym.create(const n : string;const tt : ttype);
  2128. begin
  2129. inherited create(n);
  2130. typ:=typesym;
  2131. restype:=tt;
  2132. {$ifdef GDB}
  2133. isusedinstab := false;
  2134. {$endif GDB}
  2135. { register the typesym for the definition }
  2136. if assigned(restype.def) and
  2137. (restype.def.deftype<>errordef) and
  2138. not(assigned(restype.def.typesym)) then
  2139. restype.def.typesym:=self;
  2140. end;
  2141. constructor ttypesym.load(ppufile:tcompilerppufile);
  2142. begin
  2143. inherited loadsym(ppufile);
  2144. typ:=typesym;
  2145. {$ifdef GDB}
  2146. isusedinstab := false;
  2147. {$endif GDB}
  2148. ppufile.gettype(restype);
  2149. end;
  2150. function ttypesym.gettypedef:tdef;
  2151. begin
  2152. gettypedef:=restype.def;
  2153. end;
  2154. procedure ttypesym.deref;
  2155. begin
  2156. restype.resolve;
  2157. end;
  2158. procedure ttypesym.write(ppufile:tcompilerppufile);
  2159. begin
  2160. inherited writesym(ppufile);
  2161. ppufile.puttype(restype);
  2162. ppufile.writeentry(ibtypesym);
  2163. end;
  2164. procedure ttypesym.load_references(ppufile:tcompilerppufile;locals:boolean);
  2165. begin
  2166. inherited load_references(ppufile,locals);
  2167. if (restype.def.deftype=recorddef) then
  2168. tstoredsymtable(trecorddef(restype.def).symtable).load_references(ppufile,locals);
  2169. if (restype.def.deftype=objectdef) then
  2170. tstoredsymtable(tobjectdef(restype.def).symtable).load_references(ppufile,locals);
  2171. end;
  2172. function ttypesym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
  2173. begin
  2174. if not inherited write_references(ppufile,locals) then
  2175. begin
  2176. { write address of this symbol if record or object
  2177. even if no real refs are there
  2178. because we need it for the symtable }
  2179. if (restype.def.deftype in [recorddef,objectdef]) then
  2180. begin
  2181. ppufile.putderef(self);
  2182. ppufile.writeentry(ibsymref);
  2183. end;
  2184. end;
  2185. write_references:=true;
  2186. if (restype.def.deftype=recorddef) then
  2187. tstoredsymtable(trecorddef(restype.def).symtable).write_references(ppufile,locals);
  2188. if (restype.def.deftype=objectdef) then
  2189. tstoredsymtable(tobjectdef(restype.def).symtable).write_references(ppufile,locals);
  2190. end;
  2191. {$ifdef GDB}
  2192. function ttypesym.stabstring : pchar;
  2193. var
  2194. stabchar : string[2];
  2195. short : string;
  2196. begin
  2197. if restype.def.deftype in tagtypes then
  2198. stabchar := 'Tt'
  2199. else
  2200. stabchar := 't';
  2201. short := '"'+name+':'+stabchar+tstoreddef(restype.def).numberstring
  2202. +'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
  2203. stabstring := strpnew(short);
  2204. end;
  2205. procedure ttypesym.concatstabto(asmlist : taasmoutput);
  2206. begin
  2207. {not stabs for forward defs }
  2208. if assigned(restype.def) then
  2209. if (restype.def.typesym = self) then
  2210. tstoreddef(restype.def).concatstabto(asmlist)
  2211. else
  2212. inherited concatstabto(asmlist);
  2213. end;
  2214. {$endif GDB}
  2215. {****************************************************************************
  2216. TSYSSYM
  2217. ****************************************************************************}
  2218. constructor tsyssym.create(const n : string;l : longint);
  2219. begin
  2220. inherited create(n);
  2221. typ:=syssym;
  2222. number:=l;
  2223. end;
  2224. constructor tsyssym.load(ppufile:tcompilerppufile);
  2225. begin
  2226. inherited loadsym(ppufile);
  2227. typ:=syssym;
  2228. number:=ppufile.getlongint;
  2229. end;
  2230. destructor tsyssym.destroy;
  2231. begin
  2232. inherited destroy;
  2233. end;
  2234. procedure tsyssym.write(ppufile:tcompilerppufile);
  2235. begin
  2236. inherited writesym(ppufile);
  2237. ppufile.putlongint(number);
  2238. ppufile.writeentry(ibsyssym);
  2239. end;
  2240. {$ifdef GDB}
  2241. procedure tsyssym.concatstabto(asmlist : taasmoutput);
  2242. begin
  2243. end;
  2244. {$endif GDB}
  2245. {****************************************************************************
  2246. TRTTISYM
  2247. ****************************************************************************}
  2248. constructor trttisym.create(const n:string;rt:trttitype);
  2249. const
  2250. prefix : array[trttitype] of string[5]=('$rtti','$init');
  2251. begin
  2252. inherited create(prefix[rt]+n);
  2253. typ:=rttisym;
  2254. lab:=nil;
  2255. rttityp:=rt;
  2256. end;
  2257. constructor trttisym.load(ppufile:tcompilerppufile);
  2258. begin
  2259. inherited loadsym(ppufile);
  2260. typ:=rttisym;
  2261. lab:=nil;
  2262. rttityp:=trttitype(ppufile.getbyte);
  2263. end;
  2264. procedure trttisym.write(ppufile:tcompilerppufile);
  2265. begin
  2266. inherited writesym(ppufile);
  2267. ppufile.putbyte(byte(rttityp));
  2268. ppufile.writeentry(ibrttisym);
  2269. end;
  2270. function trttisym.mangledname : string;
  2271. const
  2272. prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
  2273. var
  2274. s : string;
  2275. p : tsymtable;
  2276. begin
  2277. s:='';
  2278. p:=owner;
  2279. while assigned(p) and (p.symtabletype=localsymtable) do
  2280. begin
  2281. s:=s+'_'+p.defowner.name;
  2282. p:=p.defowner.owner;
  2283. end;
  2284. if not(p.symtabletype in [globalsymtable,staticsymtable]) then
  2285. internalerror(200108265);
  2286. mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
  2287. end;
  2288. function trttisym.get_label:tasmsymbol;
  2289. begin
  2290. { the label is always a global label }
  2291. if not assigned(lab) then
  2292. lab:=objectlibrary.newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
  2293. get_label:=lab;
  2294. end;
  2295. { persistent rtti generation }
  2296. procedure generate_rtti(p:tsym);
  2297. var
  2298. rsym : trttisym;
  2299. def : tstoreddef;
  2300. begin
  2301. { rtti can only be generated for classes that are always typesyms }
  2302. if not(p.typ=typesym) then
  2303. internalerror(200108261);
  2304. def:=tstoreddef(ttypesym(p).restype.def);
  2305. { only create rtti once for each definition }
  2306. if not(df_has_rttitable in def.defoptions) then
  2307. begin
  2308. { definition should be in the same symtable as the symbol }
  2309. if p.owner<>def.owner then
  2310. internalerror(200108262);
  2311. { create rttisym }
  2312. rsym:=trttisym.create(p.name,fullrtti);
  2313. p.owner.insert(rsym);
  2314. { register rttisym in definition }
  2315. include(def.defoptions,df_has_rttitable);
  2316. def.rttitablesym:=rsym;
  2317. { write rtti data }
  2318. def.write_child_rtti_data(fullrtti);
  2319. if (cs_create_smart in aktmoduleswitches) then
  2320. rttiList.concat(Tai_cut.Create);
  2321. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2322. def.write_rtti_data(fullrtti);
  2323. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2324. end;
  2325. end;
  2326. { persistent init table generation }
  2327. procedure generate_inittable(p:tsym);
  2328. var
  2329. rsym : trttisym;
  2330. def : tstoreddef;
  2331. begin
  2332. { anonymous types are also allowed for records that can be varsym }
  2333. case p.typ of
  2334. typesym :
  2335. def:=tstoreddef(ttypesym(p).restype.def);
  2336. varsym :
  2337. def:=tstoreddef(tvarsym(p).vartype.def);
  2338. else
  2339. internalerror(200108263);
  2340. end;
  2341. { only create inittable once for each definition }
  2342. if not(df_has_inittable in def.defoptions) then
  2343. begin
  2344. { definition should be in the same symtable as the symbol }
  2345. if p.owner<>def.owner then
  2346. internalerror(200108264);
  2347. { create rttisym }
  2348. rsym:=trttisym.create(p.name,initrtti);
  2349. p.owner.insert(rsym);
  2350. { register rttisym in definition }
  2351. include(def.defoptions,df_has_inittable);
  2352. def.inittablesym:=rsym;
  2353. { write inittable data }
  2354. def.write_child_rtti_data(initrtti);
  2355. if (cs_create_smart in aktmoduleswitches) then
  2356. rttiList.concat(Tai_cut.Create);
  2357. rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
  2358. def.write_rtti_data(initrtti);
  2359. rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
  2360. end;
  2361. end;
  2362. end.
  2363. {
  2364. $Log$
  2365. Revision 1.50 2002-08-13 21:40:57 florian
  2366. * more fixes for ppc calling conventions
  2367. Revision 1.49 2002/08/12 15:08:40 carl
  2368. + stab register indexes for powerpc (moved from gdb to cpubase)
  2369. + tprocessor enumeration moved to cpuinfo
  2370. + linker in target_info is now a class
  2371. * many many updates for m68k (will soon start to compile)
  2372. - removed some ifdef or correct them for correct cpu
  2373. Revision 1.48 2002/08/11 14:32:28 peter
  2374. * renamed current_library to objectlibrary
  2375. Revision 1.47 2002/08/11 13:24:14 peter
  2376. * saving of asmsymbols in ppu supported
  2377. * asmsymbollist global is removed and moved into a new class
  2378. tasmlibrarydata that will hold the info of a .a file which
  2379. corresponds with a single module. Added librarydata to tmodule
  2380. to keep the library info stored for the module. In the future the
  2381. objectfiles will also be stored to the tasmlibrarydata class
  2382. * all getlabel/newasmsymbol and friends are moved to the new class
  2383. Revision 1.46 2002/07/23 10:13:23 daniel
  2384. * Added important comment
  2385. Revision 1.45 2002/07/23 09:51:26 daniel
  2386. * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
  2387. are worth comitting.
  2388. Revision 1.44 2002/07/20 17:45:29 daniel
  2389. * Register variables are now possible for global variables too. This is
  2390. important for small programs without procedures.
  2391. Revision 1.43 2002/07/20 11:57:58 florian
  2392. * types.pas renamed to defbase.pas because D6 contains a types
  2393. unit so this would conflicts if D6 programms are compiled
  2394. + Willamette/SSE2 instructions to assembler added
  2395. Revision 1.42 2002/07/11 14:41:31 florian
  2396. * start of the new generic parameter handling
  2397. Revision 1.41 2002/07/10 07:24:40 jonas
  2398. * memory leak fixes from Sergey Korshunoff
  2399. Revision 1.40 2002/07/01 18:46:27 peter
  2400. * internal linker
  2401. * reorganized aasm layer
  2402. Revision 1.39 2002/05/18 13:34:18 peter
  2403. * readded missing revisions
  2404. Revision 1.38 2002/05/16 19:46:45 carl
  2405. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2406. + try to fix temp allocation (still in ifdef)
  2407. + generic constructor calls
  2408. + start of tassembler / tmodulebase class cleanup
  2409. Revision 1.36 2002/05/12 16:53:15 peter
  2410. * moved entry and exitcode to ncgutil and cgobj
  2411. * foreach gets extra argument for passing local data to the
  2412. iterator function
  2413. * -CR checks also class typecasts at runtime by changing them
  2414. into as
  2415. * fixed compiler to cycle with the -CR option
  2416. * fixed stabs with elf writer, finally the global variables can
  2417. be watched
  2418. * removed a lot of routines from cga unit and replaced them by
  2419. calls to cgobj
  2420. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2421. u32bit then the other is typecasted also to u32bit without giving
  2422. a rangecheck warning/error.
  2423. * fixed pascal calling method with reversing also the high tree in
  2424. the parast, detected by tcalcst3 test
  2425. Revision 1.35 2002/04/19 15:46:03 peter
  2426. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  2427. in most cases and not written to the ppu
  2428. * add mangeledname_prefix() routine to generate the prefix of
  2429. manglednames depending on the current procedure, object and module
  2430. * removed static procprefix since the mangledname is now build only
  2431. on demand from tprocdef.mangledname
  2432. Revision 1.34 2002/04/16 16:12:47 peter
  2433. * give error when using enums with jumps as array index
  2434. * allow char as enum value
  2435. Revision 1.33 2002/04/15 19:08:22 carl
  2436. + target_info.size_of_pointer -> pointer_size
  2437. + some cleanup of unused types/variables
  2438. Revision 1.32 2002/04/07 13:37:29 carl
  2439. + change unit use
  2440. Revision 1.31 2002/02/03 09:30:04 peter
  2441. * more fixes for protected handling
  2442. }