symsym.pas 83 KB

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