fpc/compiler/symbase.pas
peter 785550d7e3 Merged revisions 2669,2673,2677,2683,2696,2699-2702,2704,2708,2712-2715,2718,2722-2723,2728-2730,2740,2769 via svnmerge from
svn+ssh://peter@www.freepascal.org/FPC/svn/fpc/branches/linker/compiler

........
r2669 | peter | 2006-02-23 09:31:21 +0100 (Thu, 23 Feb 2006) | 2 lines

  * add compiler dir

........
r2673 | peter | 2006-02-23 17:08:56 +0100 (Thu, 23 Feb 2006) | 2 lines

  * enabled more code

........
r2677 | peter | 2006-02-24 17:46:29 +0100 (Fri, 24 Feb 2006) | 2 lines

  * pe stub and headers

........
r2683 | peter | 2006-02-25 23:13:24 +0100 (Sat, 25 Feb 2006) | 2 lines

  * section options cleanup

........
r2696 | peter | 2006-02-26 20:27:41 +0100 (Sun, 26 Feb 2006) | 2 lines

  * fixed typecasts

........
r2699 | peter | 2006-02-26 23:04:32 +0100 (Sun, 26 Feb 2006) | 2 lines

  * simple linking works

........
r2700 | peter | 2006-02-27 09:44:50 +0100 (Mon, 27 Feb 2006) | 2 lines

  * internal linker script

........
r2701 | peter | 2006-02-27 12:05:12 +0100 (Mon, 27 Feb 2006) | 2 lines

  * make elf working again

........
r2702 | peter | 2006-02-27 14:04:43 +0100 (Mon, 27 Feb 2006) | 3 lines

  * disable dwarf for smartlinking with .a
  * fix section start in new .a file

........
r2704 | peter | 2006-02-27 18:30:43 +0100 (Mon, 27 Feb 2006) | 2 lines

  * stab section fixes

........
r2708 | peter | 2006-02-28 19:29:17 +0100 (Tue, 28 Feb 2006) | 2 lines

  * basic work to merge stabs sections

........
r2712 | peter | 2006-02-28 23:17:48 +0100 (Tue, 28 Feb 2006) | 2 lines

  * unload tmodules before linking

........
r2713 | peter | 2006-02-28 23:18:51 +0100 (Tue, 28 Feb 2006) | 2 lines

  * fixed stabs linking

........
r2714 | peter | 2006-02-28 23:19:19 +0100 (Tue, 28 Feb 2006) | 2 lines

  * show code and data size

........
r2715 | peter | 2006-02-28 23:25:35 +0100 (Tue, 28 Feb 2006) | 2 lines

  * unload .stabs from objdata after it is merged

........
r2718 | peter | 2006-03-01 12:24:38 +0100 (Wed, 01 Mar 2006) | 3 lines

  * memsize/datasize cleanup
  * check for exports/resources when adding module to linker

........
r2722 | peter | 2006-03-03 09:12:20 +0100 (Fri, 03 Mar 2006) | 2 lines

  * new TObjSymbol splitted from TAsmSymbol

........
r2723 | peter | 2006-03-03 14:08:55 +0100 (Fri, 03 Mar 2006) | 2 lines

  * coff fixes after recent objsymbol changes

........
r2728 | peter | 2006-03-03 22:43:04 +0100 (Fri, 03 Mar 2006) | 2 lines

  * fixed coff writer

........
r2729 | peter | 2006-03-04 01:10:32 +0100 (Sat, 04 Mar 2006) | 2 lines

  * fix read-only opening

........
r2730 | peter | 2006-03-04 01:11:16 +0100 (Sat, 04 Mar 2006) | 2 lines

  * Read edata from DLLs, basic work

........
r2740 | peter | 2006-03-04 21:13:43 +0100 (Sat, 04 Mar 2006) | 3 lines

  * deletedef added
  * don't remove defs from index when we are already clearing everything

........
r2769 | peter | 2006-03-05 21:42:33 +0100 (Sun, 05 Mar 2006) | 4 lines

  * moved TObj classes to ogbase
  * ObjSection.SymbolRefs and SymbolDefines list
  * DLL importing

........

git-svn-id: trunk@2771 -
2006-03-05 21:10:37 +00:00

347 lines
9.3 KiB
ObjectPascal

{
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
This unit handles the symbol tables
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit symbase;
{$i fpcdefs.inc}
interface
uses
{ common }
cutils,cclasses,
{ global }
globtype,globals,
{ symtable }
symconst
;
{************************************************
Some internal constants
************************************************}
const
hasharraysize = 256;
indexgrowsize = 64;
{************************************************
Needed forward pointers
************************************************}
type
tsymtable = class;
{************************************************
TSymtableEntry
************************************************}
tsymtableentry = class(TNamedIndexItem)
owner : tsymtable;
end;
{************************************************
TDefEntry
************************************************}
tdefentry = class(tsymtableentry)
deftype : tdeftype;
end;
{************************************************
TSymEntry
************************************************}
{ this object is the base for all symbol objects }
tsymentry = class(tsymtableentry)
typ : tsymtyp;
end;
{************************************************
TSymtable
************************************************}
tsearchhasharray = array[0..hasharraysize-1] of tsymentry;
psearchhasharray = ^tsearchhasharray;
tsymtable = class
private
clearing : boolean;
{$ifdef EXTDEBUG}
procedure dumpsym(p : TNamedIndexItem;arg:pointer);
{$endif EXTDEBUG}
public
name : pstring;
realname : pstring;
symindex,
defindex : TIndexArray;
symsearch : Tdictionary;
defowner : tdefentry; { for records and objects }
symtabletype : tsymtabletype;
{ level of symtable, used for nested procedures }
symtablelevel : byte;
moduleid : longint;
refcount : integer;
constructor Create(const s:string);
destructor destroy;override;
procedure freeinstance;override;
function getcopy:tsymtable;
procedure clear;virtual;
function rename(const olds,news : stringid):tsymentry;
procedure foreach(proc2call : tnamedindexcallback;arg:pointer);
procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
function checkduplicate(sym : tsymentry):boolean;virtual;
procedure insert(sym : tsymentry);virtual;
procedure delete(sym:tsymentry);
procedure replace(oldsym,newsym:tsymentry);
function search(const s : stringid) : tsymentry;
function speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
procedure insertdef(def:tdefentry);virtual;
procedure deletedef(def:tdefentry);virtual;
function iscurrentunit:boolean;virtual;
{$ifdef EXTDEBUG}
procedure dump;
{$endif EXTDEBUG}
function getdefnr(l : longint) : tdefentry;
function getsymnr(l : longint) : tsymentry;
end;
var
aktrecordsymtable : tsymtable; { current record symtable }
aktparasymtable : tsymtable; { current proc para symtable }
aktlocalsymtable : tsymtable; { current proc local symtable }
initialmacrosymtable: tsymtable; { macros initially defined by the compiler or
given on the command line. Is common
for all files compiled and do not change. }
implementation
uses
verbose;
{****************************************************************************
TSYMTABLE
****************************************************************************}
constructor tsymtable.Create(const s:string);
begin
if s<>'' then
begin
name:=stringdup(upper(s));
realname:=stringdup(s);
end
else
begin
name:=nil;
realname:=nil;
end;
symtabletype:=abstractsymtable;
symtablelevel:=0;
defowner:=nil;
symindex:=tindexarray.create(indexgrowsize);
defindex:=TIndexArray.create(indexgrowsize);
symsearch:=tdictionary.create;
symsearch.noclear:=true;
refcount:=1;
end;
destructor tsymtable.destroy;
begin
{ freeinstance decreases refcount }
if refcount>1 then
exit;
{ symsearch can already be disposed or set to nil for withsymtable }
if assigned(symsearch) then
begin
symsearch.destroy;
symsearch:=nil;
end;
clear;
stringdispose(name);
stringdispose(realname);
end;
procedure tsymtable.freeinstance;
begin
dec(refcount);
if refcount=0 then
inherited freeinstance;
end;
function tsymtable.getcopy:tsymtable;
begin
inc(refcount);
result:=self;
end;
{$ifdef EXTDEBUG}
procedure tsymtable.dumpsym(p : TNamedIndexItem;arg:pointer);
begin
writeln(p.name);
end;
procedure tsymtable.dump;
begin
if assigned(name) then
writeln('Symtable ',name^)
else
writeln('Symtable <not named>');
symsearch.foreach(@dumpsym,nil);
end;
{$endif EXTDEBUG}
function tsymtable.iscurrentunit:boolean;
begin
result:=false;
end;
procedure tsymtable.foreach(proc2call : tnamedindexcallback;arg:pointer);
begin
symindex.foreach(proc2call,arg);
end;
procedure tsymtable.foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
begin
symindex.foreach_static(proc2call,arg);
end;
{***********************************************
Table Access
***********************************************}
procedure tsymtable.clear;
begin
clearing:=true;
symindex.clear;
defindex.clear;
clearing:=false;
end;
function tsymtable.checkduplicate(sym : tsymentry):boolean;
begin
result:=(speedsearch(sym.name,sym.speedvalue)<>nil);
end;
procedure tsymtable.insert(sym:tsymentry);
begin
checkduplicate(sym);
sym.owner:=self;
{ insert in index and search hash }
symindex.insert(sym);
symsearch.insert(sym);
end;
procedure tsymtable.insertdef(def:tdefentry);
begin
def.owner:=self;
defindex.insert(def);
end;
procedure tsymtable.deletedef(def:tdefentry);
begin
{ if we are already clearing everything it will already
be deleted }
if clearing then
exit;
defindex.deleteindex(def);
def.owner:=nil;
end;
procedure tsymtable.delete(sym:tsymentry);
begin
sym.owner:=nil;
{ remove from index and search hash }
symsearch.delete(sym.name);
symindex.delete(sym);
end;
procedure tsymtable.replace(oldsym,newsym:tsymentry);
begin
{ Replace the entry in the dictionary, this checks
the name }
if not symsearch.replace(oldsym,newsym) then
internalerror(200209061);
{ replace in index }
symindex.replace(oldsym,newsym);
{ set owner of new symb }
newsym.owner:=self;
end;
function tsymtable.search(const s : stringid) : tsymentry;
begin
search:=speedsearch(s,getspeedvalue(s));
end;
function tsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
begin
speedsearch:=tsymentry(symsearch.speedsearch(s,speedvalue));
end;
function tsymtable.rename(const olds,news : stringid):tsymentry;
begin
rename:=tsymentry(symsearch.rename(olds,news));
end;
function tsymtable.getsymnr(l : longint) : tsymentry;
var
hp : tsymentry;
begin
hp:=tsymentry(symindex.search(l));
if hp=nil then
internalerror(10999);
getsymnr:=hp;
end;
function tsymtable.getdefnr(l : longint) : tdefentry;
var
hp : tdefentry;
begin
hp:=tdefentry(defindex.search(l));
if hp=nil then
internalerror(10998);
getdefnr:=hp;
end;
end.