symtype.pas 29 KB

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