symtype.pas 30 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
  4. This unit handles the symbol tables
  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 symtype;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cutils,
  24. {$ifdef MEMDEBUG}
  25. cclasses,
  26. {$endif MEMDEBUG}
  27. { global }
  28. globtype,globals,
  29. { symtable }
  30. symconst,symbase,
  31. { aasm }
  32. aasmbase
  33. ;
  34. type
  35. {************************************************
  36. Required Forwards
  37. ************************************************}
  38. tsym = class;
  39. {************************************************
  40. TRef
  41. ************************************************}
  42. tref = class
  43. nextref : tref;
  44. posinfo : tfileposinfo;
  45. moduleindex : longint;
  46. is_written : boolean;
  47. constructor create(ref:tref;pos:pfileposinfo);
  48. procedure freechain;
  49. destructor destroy;override;
  50. end;
  51. {************************************************
  52. TDef
  53. ************************************************}
  54. tgetsymtable = (gs_none,gs_record,gs_local,gs_para);
  55. tdef = class(tdefentry)
  56. typesym : tsym; { which type the definition was generated this def }
  57. defoptions : tdefoptions;
  58. constructor create;
  59. procedure buildderef;virtual;abstract;
  60. procedure buildderefimpl;virtual;abstract;
  61. procedure deref;virtual;abstract;
  62. procedure derefimpl;virtual;abstract;
  63. function typename:string;
  64. function gettypename:string;virtual;
  65. function mangledparaname:string;
  66. function getmangledparaname:string;virtual;abstract;
  67. function size:longint;virtual;abstract;
  68. function alignment:longint;virtual;abstract;
  69. function getparentdef:tdef;virtual;
  70. function getsymtable(t:tgetsymtable):tsymtable;virtual;
  71. function is_publishable:boolean;virtual;abstract;
  72. function needs_inittable:boolean;virtual;abstract;
  73. end;
  74. {************************************************
  75. TSym
  76. ************************************************}
  77. { this object is the base for all symbol objects }
  78. tsym = class(tsymentry)
  79. _realname : pstring;
  80. fileinfo : tfileposinfo;
  81. symoptions : tsymoptions;
  82. constructor create(const n : string);
  83. destructor destroy;override;
  84. function realname:string;
  85. procedure buildderef;virtual;abstract;
  86. procedure buildderefimpl;virtual;abstract;
  87. procedure deref;virtual;abstract;
  88. procedure derefimpl;virtual;abstract;
  89. function gettypedef:tdef;virtual;
  90. end;
  91. {************************************************
  92. TDeref
  93. ************************************************}
  94. tderef = object
  95. dataidx : longint;
  96. procedure reset;
  97. procedure build(s:tsymtableentry);
  98. function resolve:tsymtableentry;
  99. end;
  100. {************************************************
  101. TType
  102. ************************************************}
  103. ttype = object
  104. def : tdef;
  105. sym : tsym;
  106. deref : tderef;
  107. procedure reset;
  108. procedure setdef(p:tdef);
  109. procedure setsym(p:tsym);
  110. procedure resolve;
  111. procedure buildderef;
  112. end;
  113. {************************************************
  114. TSymList
  115. ************************************************}
  116. psymlistitem = ^tsymlistitem;
  117. tsymlistitem = record
  118. sltype : tsltype;
  119. next : psymlistitem;
  120. case byte of
  121. 0 : (sym : tsym; symderef : tderef);
  122. 1 : (value : longint);
  123. 2 : (tt : ttype);
  124. end;
  125. tsymlist = class
  126. procdef : tdef;
  127. procdefderef : tderef;
  128. firstsym,
  129. lastsym : psymlistitem;
  130. constructor create;
  131. destructor destroy;override;
  132. function empty:boolean;
  133. procedure addsym(slt:tsltype;p:tsym);
  134. procedure addsymderef(slt:tsltype;const d:tderef);
  135. procedure addconst(slt:tsltype;v:longint);
  136. procedure addtype(slt:tsltype;const tt:ttype);
  137. procedure clear;
  138. function getcopy:tsymlist;
  139. procedure resolve;
  140. procedure buildderef;
  141. end;
  142. {$ifdef MEMDEBUG}
  143. var
  144. membrowser,
  145. memrealnames,
  146. memmanglednames,
  147. memprocpara,
  148. memprocparast,
  149. memproclocalst,
  150. memprocnodetree : tmemdebug;
  151. {$endif MEMDEBUG}
  152. implementation
  153. uses
  154. verbose,
  155. fmodule;
  156. {****************************************************************************
  157. Tdef
  158. ****************************************************************************}
  159. constructor tdef.create;
  160. begin
  161. inherited create;
  162. deftype:=abstractdef;
  163. owner := nil;
  164. typesym := nil;
  165. defoptions:=[];
  166. end;
  167. function tdef.typename:string;
  168. begin
  169. if assigned(typesym) and
  170. not(deftype in [procvardef,procdef]) and
  171. assigned(typesym._realname) and
  172. (typesym._realname^[1]<>'$') then
  173. typename:=typesym._realname^
  174. else
  175. typename:=gettypename;
  176. end;
  177. function tdef.gettypename : string;
  178. begin
  179. gettypename:='<unknown type>'
  180. end;
  181. function tdef.mangledparaname:string;
  182. begin
  183. if assigned(typesym) then
  184. mangledparaname:=typesym.name
  185. else
  186. mangledparaname:=getmangledparaname;
  187. end;
  188. function tdef.getparentdef:tdef;
  189. begin
  190. result:=nil;
  191. end;
  192. function tdef.getsymtable(t:tgetsymtable):tsymtable;
  193. begin
  194. getsymtable:=nil;
  195. end;
  196. {****************************************************************************
  197. TSYM (base for all symtypes)
  198. ****************************************************************************}
  199. constructor tsym.create(const n : string);
  200. begin
  201. if n[1]='$' then
  202. inherited createname(copy(n,2,255))
  203. else
  204. inherited createname(upper(n));
  205. _realname:=stringdup(n);
  206. typ:=abstractsym;
  207. symoptions:=[];
  208. end;
  209. destructor tsym.destroy;
  210. begin
  211. {$ifdef MEMDEBUG}
  212. memrealnames.start;
  213. {$endif MEMDEBUG}
  214. stringdispose(_realname);
  215. {$ifdef MEMDEBUG}
  216. memrealnames.stop;
  217. {$endif MEMDEBUG}
  218. inherited destroy;
  219. end;
  220. function tsym.realname : string;
  221. begin
  222. if assigned(_realname) then
  223. realname:=_realname^
  224. else
  225. realname:=name;
  226. end;
  227. function tsym.gettypedef:tdef;
  228. begin
  229. gettypedef:=nil;
  230. end;
  231. {****************************************************************************
  232. TRef
  233. ****************************************************************************}
  234. constructor tref.create(ref :tref;pos : pfileposinfo);
  235. begin
  236. nextref:=nil;
  237. if pos<>nil then
  238. posinfo:=pos^;
  239. if assigned(current_module) then
  240. moduleindex:=current_module.unit_index;
  241. if assigned(ref) then
  242. ref.nextref:=self;
  243. is_written:=false;
  244. end;
  245. procedure tref.freechain;
  246. var
  247. p,q : tref;
  248. begin
  249. p:=nextref;
  250. nextref:=nil;
  251. while assigned(p) do
  252. begin
  253. q:=p.nextref;
  254. p.free;
  255. p:=q;
  256. end;
  257. end;
  258. destructor tref.destroy;
  259. begin
  260. nextref:=nil;
  261. end;
  262. {****************************************************************************
  263. TType
  264. ****************************************************************************}
  265. procedure ttype.reset;
  266. begin
  267. def:=nil;
  268. sym:=nil;
  269. end;
  270. procedure ttype.setdef(p:tdef);
  271. begin
  272. def:=p;
  273. sym:=nil;
  274. end;
  275. procedure ttype.setsym(p:tsym);
  276. begin
  277. sym:=p;
  278. def:=p.gettypedef;
  279. if not assigned(def) then
  280. internalerror(1234005);
  281. end;
  282. procedure ttype.resolve;
  283. var
  284. p : tsymtableentry;
  285. begin
  286. p:=deref.resolve;
  287. if assigned(p) then
  288. begin
  289. if p is tsym then
  290. begin
  291. setsym(tsym(p));
  292. if not assigned(def) then
  293. internalerror(200212272);
  294. end
  295. else
  296. begin
  297. setdef(tdef(p));
  298. end;
  299. end
  300. else
  301. reset;
  302. end;
  303. procedure ttype.buildderef;
  304. begin
  305. { Write symbol references when the symbol is a redefine,
  306. but don't write symbol references for the current unit
  307. and for the system unit }
  308. if assigned(sym) and
  309. (
  310. (sym<>def.typesym) or
  311. ((sym.owner.unitid<>0) and
  312. (sym.owner.unitid<>1))
  313. ) then
  314. deref.build(sym)
  315. else
  316. deref.build(def);
  317. end;
  318. {****************************************************************************
  319. TSymList
  320. ****************************************************************************}
  321. constructor tsymlist.create;
  322. begin
  323. procdef:=nil; { needed for procedures }
  324. firstsym:=nil;
  325. lastsym:=nil;
  326. end;
  327. destructor tsymlist.destroy;
  328. begin
  329. clear;
  330. end;
  331. function tsymlist.empty:boolean;
  332. begin
  333. empty:=(firstsym=nil);
  334. end;
  335. procedure tsymlist.clear;
  336. var
  337. hp : psymlistitem;
  338. begin
  339. while assigned(firstsym) do
  340. begin
  341. hp:=firstsym;
  342. firstsym:=firstsym^.next;
  343. dispose(hp);
  344. end;
  345. firstsym:=nil;
  346. lastsym:=nil;
  347. procdef:=nil;
  348. end;
  349. procedure tsymlist.addsym(slt:tsltype;p:tsym);
  350. var
  351. hp : psymlistitem;
  352. begin
  353. if not assigned(p) then
  354. internalerror(200110203);
  355. new(hp);
  356. fillchar(hp^,sizeof(tsymlistitem),0);
  357. hp^.sltype:=slt;
  358. hp^.sym:=p;
  359. hp^.symderef.reset;
  360. if assigned(lastsym) then
  361. lastsym^.next:=hp
  362. else
  363. firstsym:=hp;
  364. lastsym:=hp;
  365. end;
  366. procedure tsymlist.addsymderef(slt:tsltype;const d:tderef);
  367. var
  368. hp : psymlistitem;
  369. begin
  370. new(hp);
  371. fillchar(hp^,sizeof(tsymlistitem),0);
  372. hp^.sltype:=slt;
  373. hp^.symderef:=d;
  374. if assigned(lastsym) then
  375. lastsym^.next:=hp
  376. else
  377. firstsym:=hp;
  378. lastsym:=hp;
  379. end;
  380. procedure tsymlist.addconst(slt:tsltype;v:longint);
  381. var
  382. hp : psymlistitem;
  383. begin
  384. new(hp);
  385. fillchar(hp^,sizeof(tsymlistitem),0);
  386. hp^.sltype:=slt;
  387. hp^.value:=v;
  388. if assigned(lastsym) then
  389. lastsym^.next:=hp
  390. else
  391. firstsym:=hp;
  392. lastsym:=hp;
  393. end;
  394. procedure tsymlist.addtype(slt:tsltype;const tt:ttype);
  395. var
  396. hp : psymlistitem;
  397. begin
  398. new(hp);
  399. fillchar(hp^,sizeof(tsymlistitem),0);
  400. hp^.sltype:=slt;
  401. hp^.tt:=tt;
  402. if assigned(lastsym) then
  403. lastsym^.next:=hp
  404. else
  405. firstsym:=hp;
  406. lastsym:=hp;
  407. end;
  408. function tsymlist.getcopy:tsymlist;
  409. var
  410. hp : tsymlist;
  411. hp2 : psymlistitem;
  412. hpn : psymlistitem;
  413. begin
  414. hp:=tsymlist.create;
  415. hp.procdef:=procdef;
  416. hp2:=firstsym;
  417. while assigned(hp2) do
  418. begin
  419. new(hpn);
  420. hpn^:=hp2^;
  421. hpn^.next:=nil;
  422. if assigned(hp.lastsym) then
  423. hp.lastsym^.next:=hpn
  424. else
  425. hp.firstsym:=hpn;
  426. hp.lastsym:=hpn;
  427. hp2:=hp2^.next;
  428. end;
  429. getcopy:=hp;
  430. end;
  431. procedure tsymlist.resolve;
  432. var
  433. hp : psymlistitem;
  434. begin
  435. procdef:=tdef(procdefderef.resolve);
  436. hp:=firstsym;
  437. while assigned(hp) do
  438. begin
  439. case hp^.sltype of
  440. sl_call,
  441. sl_load,
  442. sl_subscript :
  443. hp^.sym:=tsym(hp^.symderef.resolve);
  444. sl_typeconv :
  445. hp^.tt.resolve;
  446. sl_vec :
  447. ;
  448. else
  449. internalerror(200110205);
  450. end;
  451. hp:=hp^.next;
  452. end;
  453. end;
  454. procedure tsymlist.buildderef;
  455. var
  456. hp : psymlistitem;
  457. begin
  458. procdefderef.build(procdef);
  459. hp:=firstsym;
  460. while assigned(hp) do
  461. begin
  462. case hp^.sltype of
  463. sl_call,
  464. sl_load,
  465. sl_subscript :
  466. hp^.symderef.build(hp^.sym);
  467. sl_typeconv :
  468. hp^.tt.buildderef;
  469. sl_vec :
  470. ;
  471. else
  472. internalerror(200110205);
  473. end;
  474. hp:=hp^.next;
  475. end;
  476. end;
  477. {****************************************************************************
  478. Tderef
  479. ****************************************************************************}
  480. procedure tderef.reset;
  481. begin
  482. dataidx:=-1;
  483. end;
  484. procedure tderef.build(s:tsymtableentry);
  485. var
  486. len : byte;
  487. data : array[0..255] of byte;
  488. function is_child(currdef,ownerdef:tdef):boolean;
  489. begin
  490. while assigned(currdef) and
  491. (currdef<>ownerdef) do
  492. currdef:=currdef.getparentdef;
  493. result:=assigned(currdef);
  494. end;
  495. procedure addowner(s:tsymtableentry);
  496. begin
  497. if not assigned(s.owner) then
  498. internalerror(200306063);
  499. case s.owner.symtabletype of
  500. globalsymtable :
  501. begin
  502. if s.owner.unitid=0 then
  503. begin
  504. data[len]:=ord(deref_aktglobal);
  505. inc(len);
  506. end
  507. else
  508. begin
  509. { check if the unit is available in the uses
  510. clause, else it's an error }
  511. if s.owner.unitid=$ffff then
  512. internalerror(200306063);
  513. data[len]:=ord(deref_unit);
  514. data[len+1]:=s.owner.unitid shr 8;
  515. data[len+2]:=s.owner.unitid and $ff;
  516. inc(len,3);
  517. end;
  518. end;
  519. staticsymtable :
  520. begin
  521. { only references to the current static symtable are allowed }
  522. if s.owner<>aktstaticsymtable then
  523. internalerror(200306233);
  524. data[len]:=ord(deref_aktstatic);
  525. inc(len);
  526. end;
  527. localsymtable :
  528. begin
  529. addowner(s.owner.defowner);
  530. data[len]:=ord(deref_def);
  531. data[len+1]:=s.owner.defowner.indexnr shr 8;
  532. data[len+2]:=s.owner.defowner.indexnr and $ff;
  533. data[len+3]:=ord(deref_local);
  534. inc(len,4);
  535. end;
  536. parasymtable :
  537. begin
  538. addowner(s.owner.defowner);
  539. data[len]:=ord(deref_def);
  540. data[len+1]:=s.owner.defowner.indexnr shr 8;
  541. data[len+2]:=s.owner.defowner.indexnr and $ff;
  542. data[len+3]:=ord(deref_para);
  543. inc(len,4);
  544. end;
  545. objectsymtable,
  546. recordsymtable :
  547. begin
  548. addowner(s.owner.defowner);
  549. data[len]:=ord(deref_def);
  550. data[len+1]:=s.owner.defowner.indexnr shr 8;
  551. data[len+2]:=s.owner.defowner.indexnr and $ff;
  552. data[len+3]:=ord(deref_record);
  553. inc(len,4);
  554. end;
  555. else
  556. internalerror(200306065);
  557. end;
  558. if len>252 then
  559. internalerror(200306062);
  560. end;
  561. procedure addparentobject(currdef,ownerdef:tdef);
  562. var
  563. nextdef : tdef;
  564. begin
  565. if not assigned(currdef) then
  566. internalerror(200306185);
  567. { Already handled by derefaktrecordindex }
  568. if currdef=ownerdef then
  569. internalerror(200306188);
  570. { Generate a direct reference to the top parent
  571. class available in the current unit, this is required because
  572. the parent class is maybe not resolved yet and therefor
  573. has the childof value not available yet }
  574. while (currdef<>ownerdef) do
  575. begin
  576. nextdef:=currdef.getparentdef;
  577. { objects are only allowed in globalsymtable,staticsymtable this check is
  578. needed because we need the unitid }
  579. if not(nextdef.owner.symtabletype in [globalsymtable,staticsymtable]) then
  580. internalerror(200306187);
  581. { Next parent is in a different unit, then stop }
  582. if nextdef.owner.unitid<>0 then
  583. break;
  584. currdef:=nextdef;
  585. end;
  586. { Add reference where to start the parent lookup }
  587. if currdef=aktrecordsymtable.defowner then
  588. begin
  589. data[len]:=ord(deref_aktrecord);
  590. inc(len);
  591. end
  592. else
  593. begin
  594. if currdef.owner.symtabletype=globalsymtable then
  595. data[len]:=ord(deref_aktglobal)
  596. else
  597. data[len]:=ord(deref_aktstatic);
  598. data[len+1]:=ord(deref_def);
  599. data[len+2]:=currdef.indexnr shr 8;
  600. data[len+3]:=currdef.indexnr and $ff;
  601. data[len+4]:=ord(deref_record);
  602. inc(len,5);
  603. end;
  604. { When the current found parent in this module is not the owner we
  605. add derefs for the parent classes not available in this unit }
  606. while (currdef<>ownerdef) do
  607. begin
  608. data[len]:=ord(deref_parent_object);
  609. inc(len);
  610. currdef:=currdef.getparentdef;
  611. { It should be valid as it is checked by is_child }
  612. if not assigned(currdef) then
  613. internalerror(200306186);
  614. end;
  615. end;
  616. begin
  617. { skip length byte }
  618. len:=1;
  619. if assigned(s) then
  620. begin
  621. { Static symtable of current unit ? }
  622. if (s.owner.symtabletype=staticsymtable) and
  623. (s.owner.unitid=0) then
  624. begin
  625. data[len]:=ord(deref_aktstatic);
  626. inc(len);
  627. end
  628. { Global symtable of current unit ? }
  629. else if (s.owner.symtabletype=globalsymtable) and
  630. (s.owner.unitid=0) then
  631. begin
  632. data[len]:=ord(deref_aktglobal);
  633. inc(len);
  634. end
  635. { Current record/object symtable ? }
  636. else if (s.owner=aktrecordsymtable) then
  637. begin
  638. data[len]:=ord(deref_aktrecord);
  639. inc(len);
  640. end
  641. { Current local symtable ? }
  642. else if (s.owner=aktlocalsymtable) then
  643. begin
  644. data[len]:=ord(deref_aktlocal);
  645. inc(len);
  646. end
  647. { Current para symtable ? }
  648. else if (s.owner=aktparasymtable) then
  649. begin
  650. data[len]:=ord(deref_aktpara);
  651. inc(len);
  652. end
  653. { Parent class? }
  654. else if assigned(aktrecordsymtable) and
  655. (aktrecordsymtable.symtabletype=objectsymtable) and
  656. (s.owner.symtabletype=objectsymtable) and
  657. is_child(tdef(aktrecordsymtable.defowner),tdef(s.owner.defowner)) then
  658. begin
  659. addparentobject(tdef(aktrecordsymtable.defowner),tdef(s.owner.defowner));
  660. end
  661. else
  662. { Default, start by building from unit symtable }
  663. begin
  664. addowner(s);
  665. end;
  666. { Add index of the symbol/def }
  667. if s is tsym then
  668. data[len]:=ord(deref_sym)
  669. else
  670. data[len]:=ord(deref_def);
  671. data[len+1]:=s.indexnr shr 8;
  672. data[len+2]:=s.indexnr and $ff;
  673. inc(len,3);
  674. end
  675. else
  676. begin
  677. { nil pointer }
  678. data[len]:=0;
  679. inc(len);
  680. end;
  681. { store data length in first byte }
  682. data[0]:=len-1;
  683. { store index and write to derefdata }
  684. dataidx:=current_module.derefdata.size;
  685. current_module.derefdata.write(data,len);
  686. end;
  687. function tderef.resolve:tsymtableentry;
  688. var
  689. pd : tdef;
  690. pm : tmodule;
  691. typ : tdereftype;
  692. st : tsymtable;
  693. idx : word;
  694. i : longint;
  695. len : byte;
  696. data : array[0..255] of byte;
  697. begin
  698. result:=nil;
  699. { not initialized }
  700. if dataidx=-1 then
  701. internalerror(200306067);
  702. { read data }
  703. current_module.derefdata.seek(dataidx);
  704. if current_module.derefdata.read(len,1)<>1 then
  705. internalerror(200310221);
  706. if len>0 then
  707. begin
  708. if current_module.derefdata.read(data,len)<>len then
  709. internalerror(200310222);
  710. end;
  711. { process data }
  712. st:=nil;
  713. i:=0;
  714. while (i<len) do
  715. begin
  716. typ:=tdereftype(data[i]);
  717. inc(i);
  718. case typ of
  719. deref_nil :
  720. begin
  721. result:=nil;
  722. { Only allowed when no other deref is available }
  723. if len<>1 then
  724. internalerror(200306232);
  725. end;
  726. deref_sym :
  727. begin
  728. if not assigned(st) then
  729. internalerror(200309141);
  730. idx:=(data[i] shl 8) or data[i+1];
  731. inc(i,2);
  732. result:=st.getsymnr(idx);
  733. end;
  734. deref_def :
  735. begin
  736. if not assigned(st) then
  737. internalerror(200309142);
  738. idx:=(data[i] shl 8) or data[i+1];
  739. inc(i,2);
  740. result:=st.getdefnr(idx);
  741. end;
  742. deref_aktrecord :
  743. st:=aktrecordsymtable;
  744. deref_aktstatic :
  745. st:=aktstaticsymtable;
  746. deref_aktglobal :
  747. st:=aktglobalsymtable;
  748. deref_aktlocal :
  749. st:=aktlocalsymtable;
  750. deref_aktpara :
  751. st:=aktparasymtable;
  752. deref_unit :
  753. begin
  754. idx:=(data[i] shl 8) or data[i+1];
  755. inc(i,2);
  756. if idx>current_module.mapsize then
  757. internalerror(200306231);
  758. pm:=current_module.map[idx].u;
  759. if not assigned(pm) then
  760. internalerror(200212273);
  761. st:=pm.globalsymtable;
  762. end;
  763. deref_local :
  764. begin
  765. if not assigned(result) then
  766. internalerror(200306069);
  767. st:=tdef(result).getsymtable(gs_local);
  768. result:=nil;
  769. if not assigned(st) then
  770. internalerror(200212275);
  771. end;
  772. deref_para :
  773. begin
  774. if not assigned(result) then
  775. internalerror(2003060610);
  776. st:=tdef(result).getsymtable(gs_para);
  777. result:=nil;
  778. if not assigned(st) then
  779. internalerror(200212276);
  780. end;
  781. deref_record :
  782. begin
  783. if not assigned(result) then
  784. internalerror(200306068);
  785. st:=tdef(result).getsymtable(gs_record);
  786. result:=nil;
  787. if not assigned(st) then
  788. internalerror(200212274);
  789. end;
  790. deref_parent_object :
  791. begin
  792. { load current object symtable if no
  793. symtable is available yet }
  794. if st=nil then
  795. begin
  796. st:=aktrecordsymtable;
  797. if not assigned(st) then
  798. internalerror(200306068);
  799. end;
  800. if st.symtabletype<>objectsymtable then
  801. internalerror(200306189);
  802. pd:=tdef(st.defowner).getparentdef;
  803. if not assigned(pd) then
  804. internalerror(200306184);
  805. st:=pd.getsymtable(gs_record);
  806. if not assigned(st) then
  807. internalerror(200212274);
  808. end;
  809. else
  810. internalerror(200212277);
  811. end;
  812. end;
  813. end;
  814. {$ifdef MEMDEBUG}
  815. initialization
  816. membrowser:=TMemDebug.create('BrowserRefs');
  817. membrowser.stop;
  818. memrealnames:=TMemDebug.create('Realnames');
  819. memrealnames.stop;
  820. memmanglednames:=TMemDebug.create('Manglednames');
  821. memmanglednames.stop;
  822. memprocpara:=TMemDebug.create('ProcPara');
  823. memprocpara.stop;
  824. memprocparast:=TMemDebug.create('ProcParaSt');
  825. memprocparast.stop;
  826. memproclocalst:=TMemDebug.create('ProcLocalSt');
  827. memproclocalst.stop;
  828. memprocnodetree:=TMemDebug.create('ProcNodeTree');
  829. memprocnodetree.stop;
  830. finalization
  831. membrowser.free;
  832. memrealnames.free;
  833. memmanglednames.free;
  834. memprocpara.free;
  835. memprocparast.free;
  836. memproclocalst.free;
  837. memprocnodetree.free;
  838. {$endif MEMDEBUG}
  839. end.
  840. {
  841. $Log$
  842. Revision 1.34 2003-11-10 22:02:52 peter
  843. * cross unit inlining fixed
  844. Revision 1.33 2003/10/28 15:36:01 peter
  845. * absolute to object field supported, fixes tb0458
  846. Revision 1.32 2003/10/23 14:44:07 peter
  847. * splitted buildderef and buildderefimpl to fix interface crc
  848. calculation
  849. Revision 1.31 2003/10/22 20:40:00 peter
  850. * write derefdata in a separate ppu entry
  851. Revision 1.30 2003/10/22 15:22:33 peter
  852. * fixed unitsym-globalsymtable relation so the uses of a unit
  853. is counted correctly
  854. Revision 1.29 2003/10/17 14:38:32 peter
  855. * 64k registers supported
  856. * fixed some memory leaks
  857. Revision 1.28 2003/10/07 16:06:30 peter
  858. * tsymlist.def renamed to tsymlist.procdef
  859. * tsymlist.procdef is now only used to store the procdef
  860. Revision 1.27 2003/09/14 12:58:29 peter
  861. * give IE when st is not assigned in deref
  862. Revision 1.26 2003/06/25 18:31:23 peter
  863. * sym,def resolving partly rewritten to support also parent objects
  864. not directly available through the uses clause
  865. Revision 1.25 2003/06/07 20:26:32 peter
  866. * re-resolving added instead of reloading from ppu
  867. * tderef object added to store deref info for resolving
  868. Revision 1.24 2002/12/29 18:26:31 peter
  869. * also use gettypename for procdef always
  870. Revision 1.23 2002/12/29 14:57:50 peter
  871. * unit loading changed to first register units and load them
  872. afterwards. This is needed to support uses xxx in yyy correctly
  873. * unit dependency check fixed
  874. Revision 1.22 2002/09/05 19:29:46 peter
  875. * memdebug enhancements
  876. Revision 1.21 2002/08/18 20:06:28 peter
  877. * inlining is now also allowed in interface
  878. * renamed write/load to ppuwrite/ppuload
  879. * tnode storing in ppu
  880. * nld,ncon,nbas are already updated for storing in ppu
  881. Revision 1.20 2002/08/11 13:24:16 peter
  882. * saving of asmsymbols in ppu supported
  883. * asmsymbollist global is removed and moved into a new class
  884. tasmlibrarydata that will hold the info of a .a file which
  885. corresponds with a single module. Added librarydata to tmodule
  886. to keep the library info stored for the module. In the future the
  887. objectfiles will also be stored to the tasmlibrarydata class
  888. * all getlabel/newasmsymbol and friends are moved to the new class
  889. Revision 1.19 2002/07/01 18:46:29 peter
  890. * internal linker
  891. * reorganized aasm layer
  892. Revision 1.18 2002/05/18 13:34:21 peter
  893. * readded missing revisions
  894. Revision 1.17 2002/05/16 19:46:45 carl
  895. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  896. + try to fix temp allocation (still in ifdef)
  897. + generic constructor calls
  898. + start of tassembler / tmodulebase class cleanup
  899. Revision 1.15 2002/05/12 16:53:15 peter
  900. * moved entry and exitcode to ncgutil and cgobj
  901. * foreach gets extra argument for passing local data to the
  902. iterator function
  903. * -CR checks also class typecasts at runtime by changing them
  904. into as
  905. * fixed compiler to cycle with the -CR option
  906. * fixed stabs with elf writer, finally the global variables can
  907. be watched
  908. * removed a lot of routines from cga unit and replaced them by
  909. calls to cgobj
  910. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  911. u32bit then the other is typecasted also to u32bit without giving
  912. a rangecheck warning/error.
  913. * fixed pascal calling method with reversing also the high tree in
  914. the parast, detected by tcalcst3 test
  915. Revision 1.14 2002/04/19 15:46:04 peter
  916. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  917. in most cases and not written to the ppu
  918. * add mangeledname_prefix() routine to generate the prefix of
  919. manglednames depending on the current procedure, object and module
  920. * removed static procprefix since the mangledname is now build only
  921. on demand from tprocdef.mangledname
  922. }