symsym.pas 86 KB

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