symtype.pas 30 KB

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