paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 19:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 3090-3113 via svnmerge from

Browse Source 
svn+ssh://peter@www.freepascal.org/FPC/svn/fpc/branches/linker/compiler

r3090 | peter | 2006-03-30 15:10:15 +0100 (Thu, 30 Mar 2006) | 2 lines

  * infrastructure for .vtable directives

r3094 | peter | 2006-03-31 10:01:48 +0100 (Fri, 31 Mar 2006) | 2 lines

  * vtable directive fixes

r3113 | peter | 2006-04-01 22:49:57 +0100 (Sat, 01 Apr 2006) | 2 lines

  * Smart VTable linking using Symbols

git-svn-id: trunk@3115 -
This commit is contained in:
peter 2006-04-02 00:11:17 +00:00
parent 5e51aa7968
commit be88cd47b2
7 changed files with 634 additions and 311 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/aasmdata.pas
View File

@ -122,6 +122,7 @@ interface
public public
name, name,
realname : string[80]; realname : string[80];
NextVTEntryNr : longint;
{ Assembler lists } { Assembler lists }
AsmLists : array[TAsmListType] of TAsmList; AsmLists : array[TAsmListType] of TAsmList;
CurrAsmList : TAsmList; CurrAsmList : TAsmList;

4
compiler/assemble.pas
View File

@ -1013,8 +1013,6 @@ Implementation
if assigned(Tai_stab(hp).str) then if assigned(Tai_stab(hp).str) then
convertstab(Tai_stab(hp).str); convertstab(Tai_stab(hp).str);
end; end;
ait_function_name,
ait_force_line : ;
ait_symbol : ait_symbol :
ObjData.SymbolDefine(Tai_symbol(hp).sym); ObjData.SymbolDefine(Tai_symbol(hp).sym);
ait_symbol_end : ait_symbol_end :
@ -1051,7 +1049,9 @@ Implementation
{$ifdef x86} {$ifdef x86}
co : comp; co : comp;
{$endif x86} {$endif x86}
hs : string;
objsym, objsym,
objsymparent,
objsymend : TObjSymbol; objsymend : TObjSymbol;
leblen : byte; leblen : byte;
lebbuf : array[0..63] of byte; lebbuf : array[0..63] of byte;

12
compiler/ncgcal.pas
View File

@ -819,6 +819,7 @@ implementation
regs_to_save_mm : Tcpuregisterset; regs_to_save_mm : Tcpuregisterset;
href : treference; href : treference;
pop_size : longint; pop_size : longint;
vmtoffset : aint;
pvreg, pvreg,
vmtreg : tregister; vmtreg : tregister;
oldaktcallnode : tcallnode; oldaktcallnode : tcallnode;
@ -903,9 +904,16 @@ implementation
not(is_cppclass(tprocdef(procdefinition)._class)) then not(is_cppclass(tprocdef(procdefinition)._class)) then
cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tprocdef(procdefinition)._class); cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tprocdef(procdefinition)._class);
{ Call through VMT, generate a VTREF symbol to notify the linker }
vmtoffset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
if not is_interface(tprocdef(procdefinition)._class) then
begin
inc(current_asmdata.NextVTEntryNr);
current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition)._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(aint)),AT_FUNCTION,0));
end;
pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
reference_reset_base(href,vmtreg, reference_reset_base(href,vmtreg,vmtoffset);
tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,pvreg); cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,pvreg);
{ Load parameters that are in temporary registers in the { Load parameters that are in temporary registers in the

31
compiler/nobj.pas
View File

@ -1209,6 +1209,8 @@ implementation
vmtentry : pvmtentry; vmtentry : pvmtentry;
procdefcoll : pprocdefcoll; procdefcoll : pprocdefcoll;
i : longint; i : longint;
procname,
hs : string;
begin begin
{ walk trough all numbers for virtual methods and search } { walk trough all numbers for virtual methods and search }
{ the method } { the method }
@ -1224,18 +1226,17 @@ implementation
begin begin
{ writes the addresses to the VMT } { writes the addresses to the VMT }
{ but only this which are declared as virtual } { but only this which are declared as virtual }
if procdefcoll^.data.extnumber=i then if (procdefcoll^.data.extnumber=i) and
(po_virtualmethod in procdefcoll^.data.procoptions) then
begin begin
if (po_virtualmethod in procdefcoll^.data.procoptions) then if (po_abstractmethod in procdefcoll^.data.procoptions) then
begin procname:='FPC_ABSTRACTERROR'
{ if a method is abstract, then is also the } else
{ class abstract and it's not allow to } procname:=procdefcoll^.data.mangledname;
{ generates an instance } List.concat(Tai_const.createname(procname,0));
if (po_abstractmethod in procdefcoll^.data.procoptions) then hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(aint));
List.concat(Tai_const.Createname('FPC_ABSTRACTERROR',0)) current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0));
else break;
List.concat(Tai_const.createname(procdefcoll^.data.mangledname,0));
end;
end; end;
procdefcoll:=procdefcoll^.next; procdefcoll:=procdefcoll^.next;
end; end;
@ -1255,6 +1256,7 @@ implementation
dmtlabel : tasmlabel; dmtlabel : tasmlabel;
{$endif WITHDMT} {$endif WITHDMT}
interfacetable : tasmlabel; interfacetable : tasmlabel;
hs : string;
begin begin
{$ifdef WITHDMT} {$ifdef WITHDMT}
dmtlabel:=gendmt; dmtlabel:=gendmt;
@ -1356,6 +1358,13 @@ implementation
current_asmdata.asmlists[al_globals].concat(Tai_const.create(aitconst_ptr,0)); current_asmdata.asmlists[al_globals].concat(Tai_const.create(aitconst_ptr,0));
{ write the size of the VMT } { write the size of the VMT }
current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname)); current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname));
{ write vtinherit symbol to notify the linker of the class inheritance tree }
hs:='VTINHERIT'+'_'+_class.vmt_mangledname+'$$';
if assigned(_class.childof) then
hs:=hs+_class.childof.vmt_mangledname
else
hs:=hs+_class.vmt_mangledname;
current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0));
end; end;

435
compiler/ogbase.pas
View File

@ -42,12 +42,28 @@ interface
TExeSection = class; TExeSection = class;
TExeSymbol = class; TExeSymbol = class;
TObjRelocationType = (Reloc_ABSOLUTE,Reloc_RELATIVE,Reloc_RVA TObjRelocationType = (
{ Relocation to absolute address }
RELOC_ABSOLUTE,
{$ifdef x86_64} {$ifdef x86_64}
,Reloc_ABSOLUTE32 { 32bit Relocation to absolute address }
RELOC_ABSOLUTE32,
{$endif x86_64} {$endif x86_64}
{ Relative relocation }
RELOC_RELATIVE,
{ PECoff (Windows) RVA relocation }
RELOC_RVA,
{ Generate a 0 value at the place of the relocation,
this is used to remove unused vtable entries }
RELOC_ZERO
); );
{$ifdef i386}
const
RELOC_ABSOLUTE32 = RELOC_ABSOLUTE;
{$endif i386}
type
TObjSectionOption = ( TObjSectionOption = (
{ Has Data available in the file } { Has Data available in the file }
oso_Data, oso_Data,
@ -100,7 +116,7 @@ interface
end; end;
PObjStabEntry=^TObjStabEntry; PObjStabEntry=^TObjStabEntry;
TObjRelocation = class(TLinkedListItem) TObjRelocation = class
DataOffset, DataOffset,
orgsize : aint; { original size of the symbol to Relocate, required for COFF } orgsize : aint; { original size of the symbol to Relocate, required for COFF }
symbol : TObjSymbol; symbol : TObjSymbol;
@ -125,14 +141,14 @@ interface
DataPos, DataPos,
MemPos : aint; MemPos : aint;
DataAlignBytes : shortint; DataAlignBytes : shortint;
{ Relocation } { Relocations (=references) to other sections }
Relocations : TLinkedList; ObjRelocations : TFPObjectList;
{ Symbols this section references and defines } { Symbols this defines }
ObjSymbolRefs : TFPObjectList; ObjSymbolDefines : TFPObjectList;
ObjSymbolDefines : TFPObjectList;
{ executable linking } { executable linking }
ExeSection : TExeSection; ExeSection : TExeSection;
Used : boolean; Used : boolean;
VTRefList : TFPObjectList;
constructor create(const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual; constructor create(const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
destructor destroy;override; destructor destroy;override;
function write(const d;l:aint):aint; function write(const d;l:aint):aint;
@ -144,7 +160,6 @@ interface
procedure addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType); procedure addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
procedure addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType); procedure addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
procedure AddSymbolDefine(p:TObjSymbol); procedure AddSymbolDefine(p:TObjSymbol);
procedure AddSymbolRef(p:TObjSymbol);
procedure FixupRelocs;virtual; procedure FixupRelocs;virtual;
procedure ReleaseData; procedure ReleaseData;
function FullName:string; function FullName:string;
@ -253,9 +268,36 @@ interface
end; end;
TObjInputClass=class of TObjInput; TObjInputClass=class of TObjInput;
TVTableEntry=record
ObjRelocation : TObjRelocation;
orgreloctype : TObjRelocationType;
Enabled,
Used : Boolean;
end;
PVTableEntry=^TVTableEntry;
TExeVTable = class
private
procedure CheckIdx(VTableIdx:longint);
public
ExeSymbol : TExeSymbol;
EntryCnt : Longint;
EntryArray : PVTableEntry;
Consolidated : Boolean;
ChildList : TFPObjectList;
constructor Create(AExeSymbol:TExeSymbol);
destructor Destroy;override;
procedure AddChild(vt:TExeVTable);
procedure AddEntry(VTableIdx:Longint);
procedure SetVTableSize(ASize:longint);
function VTableRef(VTableIdx:Longint):TObjRelocation;
end;
TExeSymbol = class(TNamedIndexItem) TExeSymbol = class(TNamedIndexItem)
ObjSymbol : TObjSymbol; ObjSymbol : TObjSymbol;
ExeSection : TExeSection; ExeSection : TExeSection;
{ Used for vmt references optimization }
VTable : TExeVTable;
constructor create(sym:TObjSymbol); constructor create(sym:TObjSymbol);
end; end;
@ -293,6 +335,7 @@ interface
FExternalObjSymbols, FExternalObjSymbols,
FCommonObjSymbols : TFPObjectList; FCommonObjSymbols : TFPObjectList;
FEntryName : string; FEntryName : string;
FExeVTableList : TFPObjectList;
{ Objects } { Objects }
FObjDataList : TFPObjectList; FObjDataList : TFPObjectList;
{ Position calculation } { Position calculation }
@ -331,6 +374,7 @@ interface
procedure CalcPos_Header;virtual; procedure CalcPos_Header;virtual;
procedure CalcPos_Start;virtual; procedure CalcPos_Start;virtual;
procedure CalcPos_Symbols;virtual; procedure CalcPos_Symbols;virtual;
procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
procedure ResolveSymbols; procedure ResolveSymbols;
procedure PrintMemoryMap; procedure PrintMemoryMap;
procedure FixupSymbols; procedure FixupSymbols;
@ -348,6 +392,7 @@ interface
property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols; property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols; property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols;
property CommonObjSymbols:TFPObjectList read FCommonObjSymbols; property CommonObjSymbols:TFPObjectList read FCommonObjSymbols;
property ExeVTableList:TFPObjectList read FExeVTableList;
property EntryName:string read FEntryName write FEntryName; property EntryName:string read FEntryName write FEntryName;
property ImageBase:aint read FImageBase write FImageBase; property ImageBase:aint read FImageBase write FImageBase;
property CurrExeSec:TExeSection read FCurrExeSec; property CurrExeSec:TExeSection read FCurrExeSec;
@ -356,11 +401,6 @@ interface
end; end;
TExeOutputClass=class of TExeOutput; TExeOutputClass=class of TExeOutput;
{$ifdef i386}
const
Reloc_ABSOLUTE32 = Reloc_ABSOLUTE;
{$endif i386}
var var
exeoutput : TExeOutput; exeoutput : TExeOutput;
@ -481,10 +521,10 @@ implementation
secoptions:=Aoptions; secoptions:=Aoptions;
secalign:=Aalign; secalign:=Aalign;
secsymidx:=0; secsymidx:=0;
{ Relocation } { relocation }
Relocations:=TLinkedList.Create; ObjRelocations:=TFPObjectList.Create(false);
ObjSymbolRefs:=TFPObjectList.Create(false);
ObjSymbolDefines:=TFPObjectList.Create(false); ObjSymbolDefines:=TFPObjectList.Create(false);
VTRefList:=TFPObjectList.Create(false);
end; end;
@ -492,9 +532,9 @@ implementation
begin begin
if assigned(Data) then if assigned(Data) then
Data.Free; Data.Free;
Relocations.free; ObjRelocations.Free;
ObjSymbolRefs.Free;
ObjSymbolDefines.Free; ObjSymbolDefines.Free;
VTRefList.Free;
inherited destroy; inherited destroy;
end; end;
@ -576,13 +616,13 @@ implementation
procedure TObjSection.addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType); procedure TObjSection.addsymReloc(ofs:aint;p:TObjSymbol;Reloctype:TObjRelocationType);
begin begin
Relocations.concat(TObjRelocation.CreateSymbol(ofs,p,Reloctype)); ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype));
end; end;
procedure TObjSection.addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType); procedure TObjSection.addsectionReloc(ofs:aint;aobjsec:TObjSection;Reloctype:TObjRelocationType);
begin begin
Relocations.concat(TObjRelocation.CreateSection(ofs,aobjsec,Reloctype)); ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype));
end; end;
@ -594,14 +634,6 @@ implementation
end; end;
procedure TObjSection.AddSymbolRef(p:TObjSymbol);
begin
{ Register all references, also the local references between the
ObjSections in an ObjData }
ObjSymbolRefs.Add(p);
end;
procedure TObjSection.FixupRelocs; procedure TObjSection.FixupRelocs;
begin begin
end; end;
@ -614,10 +646,8 @@ implementation
FData.free; FData.free;
FData:=nil; FData:=nil;
end; end;
Relocations.free; ObjRelocations.free;
Relocations:=nil; ObjRelocations:=nil;
ObjSymbolRefs.Free;
ObjSymbolRefs:=nil;
ObjSymbolDefines.Free; ObjSymbolDefines.Free;
ObjSymbolDefines:=nil; ObjSymbolDefines:=nil;
end; end;
@ -846,11 +876,7 @@ implementation
FCachedAsmSymbolList.add(asmsym); FCachedAsmSymbolList.add(asmsym);
end end
else else
begin result:=TObjSymbol(asmsym.cachedObjSymbol);
result:=TObjSymbol(asmsym.cachedObjSymbol);
{ Register also in TObjSection }
CurrObjSec.AddSymbolRef(result);
end;
end end
else else
result:=nil; result:=nil;
@ -862,8 +888,6 @@ implementation
if not assigned(CurrObjSec) then if not assigned(CurrObjSec) then
internalerror(200603052); internalerror(200603052);
result:=CreateSymbol(aname); result:=CreateSymbol(aname);
{ Register also in TObjSection }
CurrObjSec.AddSymbolRef(result);
end; end;
@ -1057,6 +1081,99 @@ implementation
end; end;
{****************************************************************************
TExeVTable
****************************************************************************}
constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
begin
ExeSymbol:=AExeSymbol;
if not assigned(ExeSymbol.ObjSymbol) then
internalerror(200604012);
ChildList:=TFPObjectList.Create(false);
end;
destructor TExeVTable.Destroy;
begin
ChildList.Free;
if assigned(EntryArray) then
Freemem(EntryArray);
end;
procedure TExeVTable.CheckIdx(VTableIdx:longint);
var
OldEntryCnt : longint;
begin
if VTableIdx>=EntryCnt then
begin
OldEntryCnt:=EntryCnt;
EntryCnt:=VTableIdx+1;
ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry));
FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0);
end;
end;
procedure TExeVTable.AddChild(vt:TExeVTable);
begin
ChildList.Add(vt);
writeln(ExeSymbol.Name,'-',vt.ExeSymbol.Name);
end;
procedure TExeVTable.AddEntry(VTableIdx:Longint);
var
i : longint;
objreloc : TObjRelocation;
vtblentryoffset : aint;
begin
CheckIdx(VTableIdx);
vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+VTableIdx*sizeof(aint);
{ Find and disable relocation }
for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do
begin
objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]);
if objreloc.dataoffset=vtblentryoffset then
begin
EntryArray[VTableIdx].ObjRelocation:=objreloc;
EntryArray[VTableIdx].OrgRelocType:=objreloc.typ;
objreloc.typ:=RELOC_ZERO;
break;
end;
end;
if not assigned(EntryArray[VTableIdx].ObjRelocation) then
internalerror(200604011);
end;
procedure TExeVTable.SetVTableSize(ASize:longint);
begin
if EntryCnt<>0 then
internalerror(200603313);
EntryCnt:=ASize div sizeof(aint);
EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry));
end;
function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation;
begin
result:=nil;
CheckIdx(VTableIdx);
if EntryArray[VTableIdx].Used then
exit;
writeln(ExeSymbol.Name,'(',VTableIdx,')');
{ Restore relocation if available }
if assigned(EntryArray[VTableIdx].ObjRelocation) then
begin
EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType;
result:=EntryArray[VTableIdx].ObjRelocation;
end;
EntryArray[VTableIdx].Used:=true;
end;
{**************************************************************************** {****************************************************************************
TExeSymbol TExeSymbol
****************************************************************************} ****************************************************************************}
@ -1128,6 +1245,7 @@ implementation
FUnresolvedExeSymbols:=TFPObjectList.Create(false); FUnresolvedExeSymbols:=TFPObjectList.Create(false);
FExternalObjSymbols:=TFPObjectList.Create(false); FExternalObjSymbols:=TFPObjectList.Create(false);
FCommonObjSymbols:=TFPObjectList.Create(false); FCommonObjSymbols:=TFPObjectList.Create(false);
FExeVTableList:=TFPObjectList.Create(false);
FEntryName:='start'; FEntryName:='start';
{ sections } { sections }
FExeSectionDict:=TDictionary.create; FExeSectionDict:=TDictionary.create;
@ -1148,6 +1266,7 @@ implementation
UnresolvedExeSymbols.free; UnresolvedExeSymbols.free;
ExternalObjSymbols.free; ExternalObjSymbols.free;
CommonObjSymbols.free; CommonObjSymbols.free;
ExeVTableList.free;
FExeSectionDict.free; FExeSectionDict.free;
FExeSectionList.free; FExeSectionList.free;
ObjDatalist.free; ObjDatalist.free;
@ -1383,6 +1502,68 @@ implementation
end; end;
procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
var
hs : string;
code : integer;
i,k,
vtableidx : longint;
vtableexesym,
childexesym,
parentexesym : TExeSymbol;
objsym : TObjSymbol;
begin
{ Build inheritance tree from VTINHERIT }
for i:=0 to VTInheritList.Count-1 do
begin
objsym:=TObjSymbol(VTInheritList[i]);
hs:=objsym.name;
{ VTINHERIT_<ChildVMTName>$$<ParentVMTName> }
Delete(hs,1,Pos('_',hs));
k:=Pos('$$',hs);
if k=0 then
internalerror(200603311);
childexesym:=texesymbol(FExeSymbolDict.search(Copy(hs,1,k-1)));
parentexesym:=texesymbol(FExeSymbolDict.search(Copy(hs,k+2,length(hs)-k-1)));
if not assigned(childexesym) or
not assigned(parentexesym)then
internalerror(200603312);
if not assigned(childexesym.vtable) then
begin
childexesym.vtable:=TExeVTable.Create(childexesym);
ExeVTableList.Add(childexesym.vtable);
end;
if not assigned(parentexesym.vtable) then
begin
parentexesym.vtable:=TExeVTable.Create(parentexesym);
ExeVTableList.Add(parentexesym.vtable);
end;
childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size);
if parentexesym<>childexesym then
parentexesym.vtable.AddChild(childexesym.vtable);
end;
{ Find VTable entries from VTENTRY }
for i:=0 to VTEntryList.Count-1 do
begin
objsym:=TObjSymbol(VTEntryList[i]);
hs:=objsym.name;
{ VTENTRY_<VTableName>$$<Index> }
Delete(hs,1,Pos('_',hs));
k:=Pos('$$',hs);
if k=0 then
internalerror(200603319);
vtableexesym:=texesymbol(FExeSymbolDict.search(Copy(hs,1,k-1)));
val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
if (code<>0) then
internalerror(200603318);
if not assigned(vtableexesym) then
internalerror(2006033110);
vtableexesym.vtable.AddEntry(vtableidx);
end;
end;
procedure TExeOutput.ResolveSymbols; procedure TExeOutput.ResolveSymbols;
var var
ObjData : TObjData; ObjData : TObjData;
@ -1391,7 +1572,13 @@ implementation
commonsym : TObjSymbol; commonsym : TObjSymbol;
firstcommon : boolean; firstcommon : boolean;
i,j : longint; i,j : longint;
hs : string;
VTEntryList,
VTInheritList : TFPObjectList;
begin begin
VTEntryList:=TFPObjectList.Create(false);
VTInheritList:=TFPObjectList.Create(false);
{ {
The symbol calculation is done in 3 steps: The symbol calculation is done in 3 steps:
1. register globals 1. register globals
@ -1409,9 +1596,27 @@ implementation
for j:=0 to ObjData.ObjSymbolList.Count-1 do for j:=0 to ObjData.ObjSymbolList.Count-1 do
begin begin
objsym:=TObjSymbol(ObjData.ObjSymbolList[j]); objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
{ Skip local symbols } { From the local symbols we are only interressed in the
VTENTRY and VTINHERIT symbols }
if objsym.bind=AB_LOCAL then if objsym.bind=AB_LOCAL then
continue; begin
hs:=objsym.name;
if (hs[1]='V') then
begin
if Copy(hs,1,5)='VTREF' then
begin
if not assigned(objsym.ObjSection.VTRefList) then
objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
objsym.ObjSection.VTRefList.Add(objsym);
end
else if Copy(hs,1,7)='VTENTRY' then
VTEntryList.Add(objsym)
else if Copy(hs,1,9)='VTINHERIT' then
VTInheritList.Add(objsym);
end;
continue;
end;
{ Search for existing exesymbol }
exesym:=texesymbol(FExeSymbolDict.search(objsym.name)); exesym:=texesymbol(FExeSymbolDict.search(objsym.name));
if not assigned(exesym) then if not assigned(exesym) then
begin begin
@ -1490,6 +1695,11 @@ implementation
end end
else else
Comment(V_Error,'Entrypoint '+EntryName+' not defined'); Comment(V_Error,'Entrypoint '+EntryName+' not defined');
{ Generate VTable tree }
BuildVTableTree(VTInheritList,VTEntryList);
VTInheritList.Free;
VTEntryList.Free;
end; end;
@ -1588,13 +1798,14 @@ implementation
mergedstabsec, mergedstabsec,
mergedstabstrsec : TObjSection; mergedstabstrsec : TObjSection;
hstabreloc, hstabreloc,
currstabReloc : TObjRelocation; currstabreloc : TObjRelocation;
currstabrelocidx,
i,j, i,j,
mergestabcnt, mergestabcnt,
stabcnt : longint; stabcnt : longint;
skipstab : boolean; skipstab : boolean;
hstab : TObjStabEntry; hstab : TObjStabEntry;
stabRelocofs : longint; stabrelocofs : longint;
buf : array[0..1023] of byte; buf : array[0..1023] of byte;
bufend, bufend,
bufsize : longint; bufsize : longint;
@ -1628,7 +1839,7 @@ implementation
begin begin
stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry); stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry);
currstabsec.Data.seek(0); currstabsec.Data.seek(0);
currstabReloc:=TObjRelocation(currstabsec.Relocations.first); currstabrelocidx:=0;
for j:=0 to stabcnt-1 do for j:=0 to stabcnt-1 do
begin begin
hstabreloc:=nil; hstabreloc:=nil;
@ -1640,15 +1851,22 @@ implementation
if not skipstab then if not skipstab then
begin begin
{ Find corresponding Relocation } { Find corresponding Relocation }
while assigned(currstabReloc) and currstabreloc:=nil;
(currstabReloc.Dataoffset<j*sizeof(TObjStabEntry)+stabRelocofs) do while (currstabrelocidx<currstabsec.ObjRelocations.Count) do
currstabReloc:=TObjRelocation(currstabReloc.next); begin
if assigned(currstabReloc) and currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]);
(currstabReloc.Dataoffset=j*sizeof(TObjStabEntry)+stabRelocofs) then if assigned(currstabreloc) and
(currstabreloc.dataoffset>=j*sizeof(TObjStabEntry)+stabrelocofs) then
break;
inc(currstabrelocidx);
end;
if assigned(currstabreloc) and
(currstabreloc.dataoffset=j*sizeof(TObjStabEntry)+stabrelocofs) then
begin begin
hstabReloc:=currstabReloc; hstabReloc:=currstabReloc;
currstabReloc:=TObjRelocation(currstabReloc.next); inc(currstabrelocidx);
end; end;
{ Check if the stab is refering to a removed section } { Check if the stab is refering to a removed section }
if assigned(hstabreloc) then if assigned(hstabreloc) then
begin begin
@ -1686,8 +1904,8 @@ implementation
if assigned(hstabreloc) then if assigned(hstabreloc) then
begin begin
hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs; hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs;
currstabsec.Relocations.remove(hstabreloc); currstabsec.ObjRelocations[currstabrelocidx-1]:=nil;
mergedstabsec.Relocations.concat(hstabreloc); mergedstabsec.ObjRelocations.Add(hstabreloc);
end; end;
{ Write updated stab } { Write updated stab }
mergedstabsec.write(hstab,sizeof(hstab)); mergedstabsec.write(hstab,sizeof(hstab));
@ -1765,13 +1983,70 @@ implementation
end; end;
end; end;
procedure DoReloc(objreloc:TObjRelocation);
var
objsym : TObjSymbol;
refobjsec : TObjSection;
begin
{ Disabled Relocation to 0 }
if objreloc.typ=RELOC_ZERO then
exit;
if assigned(objreloc.symbol) then
begin
objsym:=objreloc.symbol;
if objsym.bind<>AB_LOCAL then
begin
if not(assigned(objsym.exesymbol) and
assigned(objsym.exesymbol.objsymbol)) then
internalerror(200603063);
objsym:=objsym.exesymbol.objsymbol;
end;
if not assigned(objsym.objsection) then
internalerror(200603062);
refobjsec:=objsym.objsection;
end
else
if assigned(objreloc.objsection) then
refobjsec:=objreloc.objsection
else
internalerror(200603316);
if assigned(exemap) then
exemap.Add(' References '+refobjsec.fullname);
AddToObjSectionWorkList(refobjsec);
end;
procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint);
var
i : longint;
objreloc : TObjRelocation;
begin
objreloc:=vtable.VTableRef(VTableIdx);
if assigned(objreloc) then
begin
{ Process the relocation now if the ObjSection is
already processed and marked as used. Otherwise we leave it
unprocessed. It'll then be resolved when the ObjSection is
changed to Used }
if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then
DoReloc(objreloc);
end;
{ This recursive walking is done here instead of
in TExeVTable.VTableRef because we can now process
all needed relocations }
for i:=0 to vtable.ChildList.Count-1 do
DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx);
end;
var var
i,j : longint; hs : string;
exesec : TExeSection; i,j,k : longint;
ObjData : TObjData; exesec : TExeSection;
refobjsec, objdata : TObjData;
objsec : TObjSection; objsec : TObjSection;
objsym : TObjSymbol; objsym : TObjSymbol;
code : integer;
vtableidx : longint;
vtableexesym : TExeSymbol;
begin begin
ObjSectionWorkList:=TFPObjectList.Create(false); ObjSectionWorkList:=TFPObjectList.Create(false);
@ -1802,27 +2077,31 @@ implementation
begin begin
objsec:=TObjSection(ObjSectionWorkList.Last); objsec:=TObjSection(ObjSectionWorkList.Last);
if assigned(exemap) then if assigned(exemap) then
exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjSymbolRefs.Count)+' references'); exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references');
ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1); ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1);
for i:=0 to objsec.ObjSymbolRefs.count-1 do
{ Process Relocations }
for i:=0 to objsec.ObjRelocations.count-1 do
DoReloc(TObjRelocation(objsec.ObjRelocations[i]));
{ Process Virtual Entry calls }
for i:=0 to objsec.VTRefList.count-1 do
begin begin
objsym:=TObjSymbol(objsec.ObjSymbolRefs[i]); objsym:=TObjSymbol(objsec.VTRefList[i]);
if objsym.bind=AB_LOCAL then hs:=objsym.name;
begin Delete(hs,1,Pos('_',hs));
if not assigned(objsym.objsection) then k:=Pos('$$',hs);
internalerror(200603062); if k=0 then
refobjsec:=objsym.objsection internalerror(200603314);
end vtableexesym:=texesymbol(FExeSymbolDict.search(Copy(hs,1,k-1)));
else val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code);
begin if (code<>0) then
if not(assigned(objsym.exesymbol) and internalerror(200603317);
assigned(objsym.exesymbol.objsymbol)) then if not assigned(vtableexesym) then
internalerror(200603063); internalerror(200603315);
refobjsec:=objsym.exesymbol.objsymbol.objsection; if not assigned(vtableexesym.vtable) then
end; internalerror(200603316);
if assigned(exemap) then DoVTableRef(vtableexesym.vtable,vtableidx);
exemap.Add(' References '+refobjsec.fullname);
AddToObjSectionWorkList(refobjsec);
end; end;
end; end;
ObjSectionWorkList.Free; ObjSectionWorkList.Free;

174
compiler/ogcoff.pas
View File

@ -327,6 +327,7 @@ implementation
PE_DATADIR_IMPORTADDRESSTABLE = 12; PE_DATADIR_IMPORTADDRESSTABLE = 12;
PE_DATADIR_DELAYIMPORT = 13; PE_DATADIR_DELAYIMPORT = 13;
{$ifdef x86_64}
IMAGE_REL_AMD64_ABSOLUTE = $0000; { Reference is absolute, no relocation is necessary } IMAGE_REL_AMD64_ABSOLUTE = $0000; { Reference is absolute, no relocation is necessary }
IMAGE_REL_AMD64_ADDR64 = $0001; { 64-bit address (VA). } IMAGE_REL_AMD64_ADDR64 = $0001; { 64-bit address (VA). }
IMAGE_REL_AMD64_ADDR32 = $0002; { 32-bit address (VA). } IMAGE_REL_AMD64_ADDR32 = $0002; { 32-bit address (VA). }
@ -344,8 +345,13 @@ implementation
IMAGE_REL_AMD64_SREL32 = $000E; { 32 bit signed span-dependent value emitted into object } IMAGE_REL_AMD64_SREL32 = $000E; { 32 bit signed span-dependent value emitted into object }
IMAGE_REL_AMD64_PAIR = $000F; IMAGE_REL_AMD64_PAIR = $000F;
IMAGE_REL_AMD64_SSPAN32 = $0010; { 32 bit signed span-dependent value applied at link time } IMAGE_REL_AMD64_SSPAN32 = $0010; { 32 bit signed span-dependent value applied at link time }
{$endif x86_64}
type R_DIR32 = 6;
R_IMAGEBASE = 7;
R_PCRLONG = 20;
type
{ Structures which are written directly to the output file } { Structures which are written directly to the output file }
coffheader=packed record coffheader=packed record
mach : word; mach : word;
@ -723,35 +729,42 @@ const win32stub : array[0..131] of byte=(
procedure TCoffObjSection.addsymsizereloc(ofs:aint;p:TObjSymbol;symsize:aint;reloctype:TObjRelocationType); procedure TCoffObjSection.addsymsizereloc(ofs:aint;p:TObjSymbol;symsize:aint;reloctype:TObjRelocationType);
begin begin
relocations.concat(TObjRelocation.createsymbolsize(ofs,p,symsize,reloctype)); ObjRelocations.Add(TObjRelocation.createsymbolsize(ofs,p,symsize,reloctype));
end; end;
procedure TCoffObjSection.fixuprelocs; procedure TCoffObjSection.fixuprelocs;
var var
r : TObjRelocation; i : longint;
objreloc : TObjRelocation;
address, address,
relocval : aint; relocval : aint;
relocsec : TObjSection; relocsec : TObjSection;
begin begin
r:=TObjRelocation(relocations.first); if (ObjRelocations.Count>0) and
if assigned(r) and not assigned(data) then
(not assigned(data)) then
internalerror(200205183); internalerror(200205183);
while assigned(r) do for i:=0 to ObjRelocations.Count-1 do
begin begin
data.Seek(r.dataoffset); objreloc:=TObjRelocation(ObjRelocations[i]);
data.Read(address,4); if objreloc.typ=RELOC_ZERO then
if assigned(r.symbol) then
begin begin
relocsec:=r.symbol.objsection; data.Seek(objreloc.dataoffset);
relocval:=r.symbol.address; data.Write(0,4);
continue;
end;
data.Seek(objreloc.dataoffset);
data.Read(address,4);
if assigned(objreloc.symbol) then
begin
relocsec:=objreloc.symbol.objsection;
relocval:=objreloc.symbol.address;
end end
else else
if assigned(r.objsection) then if assigned(objreloc.objsection) then
begin begin
relocsec:=r.objsection; relocsec:=objreloc.objsection;
relocval:=r.objsection.mempos relocval:=objreloc.objsection.mempos
end end
else else
internalerror(200205183); internalerror(200205183);
@ -759,12 +772,12 @@ const win32stub : array[0..131] of byte=(
if not relocsec.used and if not relocsec.used and
not(oso_debug in secoptions) then not(oso_debug in secoptions) then
internalerror(200603061); internalerror(200603061);
case r.typ of case objreloc.typ of
RELOC_RELATIVE : RELOC_RELATIVE :
begin begin
address:=address-mempos+relocval; address:=address-mempos+relocval;
if TCoffObjData(objdata).win32 then if TCoffObjData(objdata).win32 then
dec(address,r.dataoffset+4); dec(address,objreloc.dataoffset+4);
end; end;
RELOC_RVA : RELOC_RVA :
begin begin
@ -779,7 +792,7 @@ const win32stub : array[0..131] of byte=(
RELOC_ABSOLUTE : RELOC_ABSOLUTE :
begin begin
if oso_common in relocsec.secoptions then if oso_common in relocsec.secoptions then
dec(address,r.orgsize) dec(address,objreloc.orgsize)
else else
begin begin
{ fixup address when the symbol was known in defined object } { fixup address when the symbol was known in defined object }
@ -792,10 +805,8 @@ const win32stub : array[0..131] of byte=(
else else
internalerror(200604014); internalerror(200604014);
end; end;
data.Seek(r.dataoffset); data.Seek(objreloc.dataoffset);
data.Write(address,4); data.Write(address,4);
{ goto next reloc }
r:=TObjRelocation(r.next);
end; end;
end; end;
@ -1099,7 +1110,7 @@ const win32stub : array[0..131] of byte=(
{ AUX } { AUX }
fillchar(secrec,sizeof(secrec),0); fillchar(secrec,sizeof(secrec),0);
secrec.len:=Size; secrec.len:=Size;
secrec.nrelocs:=relocations.count; secrec.nrelocs:=ObjRelocations.count;
inc(symidx); inc(symidx);
FCoffSyms.write(secrec,sizeof(secrec)); FCoffSyms.write(secrec,sizeof(secrec));
end; end;
@ -1108,60 +1119,60 @@ const win32stub : array[0..131] of byte=(
procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer); procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer);
var var
i : longint;
rel : coffreloc; rel : coffreloc;
r : TObjRelocation; objreloc : TObjRelocation;
begin begin
r:=TObjRelocation(TObjSection(p).relocations.first); for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
while assigned(r) do begin
begin objreloc:=TObjRelocation(TObjSection(p).ObjRelocations[i]);
rel.address:=r.dataoffset; rel.address:=objreloc.dataoffset;
if assigned(r.symbol) then if assigned(objreloc.symbol) then
begin begin
if (r.symbol.bind=AB_LOCAL) then if (objreloc.symbol.bind=AB_LOCAL) then
rel.sym:=r.symbol.objsection.secsymidx rel.sym:=objreloc.symbol.objsection.secsymidx
else else
begin begin
if r.symbol.symidx=-1 then if objreloc.symbol.symidx=-1 then
internalerror(200602233); internalerror(200602233);
rel.sym:=r.symbol.symidx; rel.sym:=objreloc.symbol.symidx;
end; end;
end end
else else
begin begin
if r.objsection<>nil then if objreloc.objsection<>nil then
rel.sym:=r.objsection.secsymidx rel.sym:=objreloc.objsection.secsymidx
else else
rel.sym:=0; rel.sym:=0;
end; end;
case objreloc.typ of
{$ifdef arm}
RELOC_ABSOLUTE :
;
{$endif arm}
{$ifdef i386} {$ifdef i386}
case r.typ of RELOC_RELATIVE :
RELOC_RELATIVE : rel.reloctype:=R_PCRLONG;
rel.reloctype:=$14; RELOC_ABSOLUTE :
RELOC_ABSOLUTE : rel.reloctype:=R_DIR32;
rel.reloctype:=$6; RELOC_RVA :
RELOC_RVA : rel.reloctype:=R_IMAGEBASE;
rel.reloctype:=$7;
else
internalerror(200604011);
end;
{$endif i386} {$endif i386}
{$ifdef x86_64} {$ifdef x86_64}
case r.typ of RELOC_RELATIVE :
RELOC_RELATIVE : rel.reloctype:=IMAGE_REL_AMD64_REL32;
rel.reloctype:=IMAGE_REL_AMD64_REL32; RELOC_ABSOLUTE32 :
RELOC_ABSOLUTE32 : rel.reloctype:=IMAGE_REL_AMD64_ADDR32;
rel.reloctype:=IMAGE_REL_AMD64_ADDR32; RELOC_ABSOLUTE :
RELOC_ABSOLUTE : rel.reloctype:=IMAGE_REL_AMD64_ADDR64;
rel.reloctype:=IMAGE_REL_AMD64_ADDR64; RELOC_RVA :
RELOC_RVA : rel.reloctype:=IMAGE_REL_AMD64_ADDR32NB;
rel.reloctype:=IMAGE_REL_AMD64_ADDR32NB;
else
internalerror(200604012);
end;
{$endif x86_64} {$endif x86_64}
FWriter.write(rel,sizeof(rel)); else
r:=TObjRelocation(r.next); internalerror(200603311);
end; end;
FWriter.write(rel,sizeof(rel));
end;
end; end;
@ -1226,7 +1237,7 @@ const win32stub : array[0..131] of byte=(
procedure TCoffObjOutput.section_set_reloc_datapos(p:TObject;arg:pointer); procedure TCoffObjOutput.section_set_reloc_datapos(p:TObject;arg:pointer);
begin begin
TCoffObjSection(p).coffrelocpos:=paint(arg)^; TCoffObjSection(p).coffrelocpos:=paint(arg)^;
inc(paint(arg)^,sizeof(coffreloc)*TObjSection(p).relocations.count); inc(paint(arg)^,sizeof(coffreloc)*TObjSection(p).ObjRelocations.count);
end; end;
@ -1262,7 +1273,7 @@ const win32stub : array[0..131] of byte=(
if (Size>0) and if (Size>0) and
(oso_data in secoptions) then (oso_data in secoptions) then
sechdr.datapos:=datapos; sechdr.datapos:=datapos;
sechdr.nrelocs:=relocations.count; sechdr.nrelocs:=ObjRelocations.count;
sechdr.relocpos:=coffrelocpos; sechdr.relocpos:=coffrelocpos;
if win32 then if win32 then
sechdr.flags:=peencodesechdrflags(secoptions,secalign) sechdr.flags:=peencodesechdrflags(secoptions,secalign)
@ -1432,10 +1443,17 @@ const win32stub : array[0..131] of byte=(
begin begin
FReader.read(rel,sizeof(rel)); FReader.read(rel,sizeof(rel));
case rel.reloctype of case rel.reloctype of
{$ifdef arm}
R_IMAGEBASE :
;
{$endif arm}
{$ifdef i386} {$ifdef i386}
$14 : rel_type:=RELOC_RELATIVE; R_PCRLONG :
$06 : rel_type:=RELOC_ABSOLUTE; rel_type:=RELOC_RELATIVE;
$07 : rel_type:=RELOC_RVA; R_DIR32 :
rel_type:=RELOC_ABSOLUTE;
R_IMAGEBASE :
rel_type:=RELOC_RVA;
{$endif i386} {$endif i386}
{$ifdef x86_64} {$ifdef x86_64}
IMAGE_REL_AMD64_REL32: IMAGE_REL_AMD64_REL32:
@ -1456,11 +1474,7 @@ const win32stub : array[0..131] of byte=(
p:=FSymTbl^[rel.sym].sym; p:=FSymTbl^[rel.sym].sym;
if assigned(p) then if assigned(p) then
begin s.addsymsizereloc(rel.address-s.mempos,p,FSymTbl^[rel.sym].orgsize,rel_type)
s.addsymsizereloc(rel.address-s.mempos,p,FSymTbl^[rel.sym].orgsize,rel_type);
{ Register symbol reference in TObjSection }
s.AddSymbolRef(p);
end
else else
begin begin
InputError('Failed reading coff file, can''t resolve symbol of relocation'); InputError('Failed reading coff file, can''t resolve symbol of relocation');

288
compiler/ogelf.pas
View File

@ -63,7 +63,6 @@ interface
goTSect, goTSect,
plTSect, plTSect,
symsect : TElfObjSection; symsect : TElfObjSection;
syms : Tdynamicarray;
constructor create(const n:string);override; constructor create(const n:string);override;
destructor destroy;override; destructor destroy;override;
function sectionname(atype:TAsmSectiontype;const aname:string):string;override; function sectionname(atype:TAsmSectiontype;const aname:string):string;override;
@ -114,19 +113,26 @@ implementation
symbolresize = 200*18; symbolresize = 200*18;
const const
{ Relocation types }
{$ifdef i386}
R_386_32 = 1; { ordinary absolute relocation } R_386_32 = 1; { ordinary absolute relocation }
R_386_PC32 = 2; { PC-relative relocation } R_386_PC32 = 2; { PC-relative relocation }
R_386_GOT32 = 3; { an offset into GOT } R_386_GOT32 = 3; { an offset into GOT }
R_386_PLT32 = 4; { a PC-relative offset into PLT } R_386_PLT32 = 4; { a PC-relative offset into PLT }
R_386_GOTOFF = 9; { an offset from GOT base } R_386_GOTOFF = 9; { an offset from GOT base }
R_386_GOTPC = 10; { a PC-relative offset _to_ GOT } R_386_GOTPC = 10; { a PC-relative offset _to_ GOT }
R_386_GNU_VTINHERIT = 250;
R_386_GNU_VTENTRY = 251;
{$endif i386}
{$ifdef sparc}
R_SPARC_32 = 3; R_SPARC_32 = 3;
R_SPARC_WDISP30 = 7; R_SPARC_WDISP30 = 7;
R_SPARC_HI22 = 9; R_SPARC_HI22 = 9;
R_SPARC_LO10 = 12; R_SPARC_LO10 = 12;
R_SPARC_GNU_VTINHERIT = 250;
{ AMD64 relocations } R_SPARC_GNU_VTENTRY = 251;
{$endif sparc}
{$ifdef x86_64}
R_X86_64_NONE = 0; R_X86_64_NONE = 0;
{ Direct 64 bit } { Direct 64 bit }
R_X86_64_64 = 1; R_X86_64_64 = 1;
@ -174,7 +180,11 @@ implementation
R_X86_64_GOTTPOFF = 22; R_X86_64_GOTTPOFF = 22;
{ Offset in initial TLS block } { Offset in initial TLS block }
R_X86_64_TPOFF32 = 23; R_X86_64_TPOFF32 = 23;
R_X86_64_NUM = 24; { GNU extension to record C++ vtable hierarchy }
R_X86_64_GNU_VTINHERIT = 24;
{ GNU extension to record C++ vtable member usage }
R_X86_64_GNU_VTENTRY = 25;
{$endif x86_64}
SHN_UNDEF = 0; SHN_UNDEF = 0;
SHN_ABS = $fff1; SHN_ABS = $fff1;
@ -554,8 +564,6 @@ implementation
begin begin
inherited create(n); inherited create(n);
CObjSection:=TElfObjSection; CObjSection:=TElfObjSection;
{ reset }
Syms:=TDynamicArray.Create(symbolresize);
{ default sections } { default sections }
symtabsect:=TElfObjSection.create_ext('.symtab',SHT_SYMTAB,0,0,0,4,sizeof(telfsymbol)); symtabsect:=TElfObjSection.create_ext('.symtab',SHT_SYMTAB,0,0,0,4,sizeof(telfsymbol));
strtabsect:=TElfObjSection.create_ext('.strtab',SHT_STRTAB,0,0,0,1,0); strtabsect:=TElfObjSection.create_ext('.strtab',SHT_STRTAB,0,0,0,1,0);
@ -577,7 +585,6 @@ implementation
destructor TElfObjData.destroy; destructor TElfObjData.destroy;
begin begin
Syms.Free;
symtabsect.free; symtabsect.free;
strtabsect.free; strtabsect.free;
shstrtabsect.free; shstrtabsect.free;
@ -696,12 +703,14 @@ implementation
procedure TElfObjectOutput.createrelocsection(s:TElfObjSection); procedure TElfObjectOutput.createrelocsection(s:TElfObjSection);
var var
i : longint;
{$ifdef ver2_0_0} {$ifdef ver2_0_0}
relnative, relnative,
{$endif ver2_0_0} {$endif ver2_0_0}
rel : telfreloc; rel : telfreloc;
r : TObjRelocation; objreloc : TObjRelocation;
relsym,reltyp : longint; relsym,
reltyp : longint;
begin begin
with elf32data do with elf32data do
begin begin
@ -721,85 +730,71 @@ implementation
s.relocsect:=TElfObjSection.create_ext('.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc)); s.relocsect:=TElfObjSection.create_ext('.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc));
{$endif i386} {$endif i386}
{ add the relocations } { add the relocations }
r:=TObjRelocation(s.relocations.first); for i:=0 to s.Objrelocations.count-1 do
while assigned(r) do begin
begin objreloc:=TObjRelocation(s.Objrelocations[i]);
rel.address:=r.dataoffset; fillchar(rel,sizeof(rel),0);
if assigned(r.symbol) then rel.address:=objreloc.dataoffset;
begin if assigned(objreloc.symbol) then
if (r.symbol.bind=AB_LOCAL) then begin
relsym:=r.symbol.objsection.secsymidx if (objreloc.symbol.bind=AB_LOCAL) then
else relsym:=objreloc.symbol.objsection.secsymidx
begin else
if r.symbol.symidx=-1 then begin
internalerror(200603012); if objreloc.symbol.symidx=-1 then
relsym:=r.symbol.symidx; internalerror(200603012);
end; relsym:=objreloc.symbol.symidx;
end end;
else end
if r.objsection<>nil then
relsym:=r.objsection.secsymidx
else else
relsym:=SHN_UNDEF; begin
if objreloc.objsection<>nil then
relsym:=objreloc.objsection.secsymidx
else
relsym:=SHN_UNDEF;
end;
{ when things settle down, we can create processor specific { when things settle down, we can create processor specific
derived classes derived classes }
} case objreloc.typ of
{$ifdef i386} {$ifdef i386}
case r.typ of RELOC_RELATIVE :
RELOC_RELATIVE : reltyp:=R_386_PC32;
reltyp:=R_386_PC32; RELOC_ABSOLUTE :
RELOC_ABSOLUTE : reltyp:=R_386_32;
reltyp:=R_386_32;
end;
{$endif i386} {$endif i386}
{$ifdef sparc} {$ifdef sparc}
case r.typ of RELOC_ABSOLUTE :
{ RELOC_RELATIVE : reltyp:=R_SPARC_32;
reltyp:=R_386_PC32;
}
RELOC_ABSOLUTE :
reltyp:=R_SPARC_32;
else
internalerror(200410201);
end;
{$endif sparc} {$endif sparc}
{$ifdef x86_64} {$ifdef x86_64}
case r.typ of RELOC_RELATIVE :
RELOC_RELATIVE : begin
begin reltyp:=R_X86_64_PC32;
reltyp:=R_X86_64_PC32; { length of the relocated location is handled here }
{ length of the relocated location is handled here } rel.addend:=qword(-4);
rel.addend:=qword(-4); end;
end; RELOC_ABSOLUTE :
RELOC_ABSOLUTE : reltyp:=R_X86_64_64;
begin RELOC_ABSOLUTE32 :
reltyp:=R_X86_64_64; reltyp:=R_X86_64_32S;
rel.addend:=0;
end;
RELOC_ABSOLUTE32 :
begin
reltyp:=R_X86_64_32S;
rel.addend:=0;
end;
else
internalerror(200602261);
end;
{$endif x86_64} {$endif x86_64}
else
internalerror(200602261);
end;
{$ifdef cpu64bit} {$ifdef cpu64bit}
rel.info:=(qword(relsym) shl 32) or reltyp; rel.info:=(qword(relsym) shl 32) or reltyp;
{$else cpu64bit} {$else cpu64bit}
rel.info:=(relsym shl 8) or reltyp; rel.info:=(relsym shl 8) or reltyp;
{$endif cpu64bit} {$endif cpu64bit}
{ write reloc } { write reloc }
{$ifdef ver2_0_0} {$ifdef ver2_0_0}
relnative:=MaybeSwapElfReloc(rel); relnative:=MaybeSwapElfReloc(rel);
s.relocsect.write(relnative,sizeof(rel)); s.relocsect.write(relnative,sizeof(rel));
{$else} {$else}
s.relocsect.write(MaybeSwapElfReloc(rel),sizeof(rel)); s.relocsect.write(MaybeSwapElfReloc(rel),sizeof(rel));
{$endif ver2_0_0} {$endif ver2_0_0}
r:=TObjRelocation(r.next); end;
end;
end; end;
end; end;
@ -834,11 +829,74 @@ implementation
procedure TElfObjectOutput.createsymtab; procedure TElfObjectOutput.createsymtab;
var
procedure WriteSym(objsym:TObjSymbol);
var
{$ifdef ver2_0_0} {$ifdef ver2_0_0}
elfsymnative, elfsymnative,
{$endif} {$endif}
elfsym : telfsymbol; elfsym : telfsymbol;
begin
with elf32data do
begin
fillchar(elfsym,sizeof(elfsym),0);
{ symbolname, write the #0 separate to overcome 255+1 char not possible }
elfsym.st_name:=strtabsect.Size;
strtabsect.writestr(objsym.name);
strtabsect.writestr(#0);
elfsym.st_size:=objsym.size;
case objsym.bind of
AB_LOCAL :
begin
elfsym.st_value:=objsym.address;
elfsym.st_info:=STB_LOCAL shl 4;
inc(localsyms);
end;
AB_COMMON :
begin
elfsym.st_value:=$10;
elfsym.st_info:=STB_GLOBAL shl 4;
end;
AB_EXTERNAL :
elfsym.st_info:=STB_GLOBAL shl 4;
AB_GLOBAL :
begin
elfsym.st_value:=objsym.address;
elfsym.st_info:=STB_GLOBAL shl 4;
end;
end;
if (objsym.bind<>AB_EXTERNAL) {and
not(assigned(objsym.objsection) and
not(oso_data in objsym.objsection.secoptions))} then
begin
case objsym.typ of
AT_FUNCTION :
elfsym.st_info:=elfsym.st_info or STT_FUNC;
AT_DATA :
elfsym.st_info:=elfsym.st_info or STT_OBJECT;
end;
end;
if objsym.bind=AB_COMMON then
elfsym.st_shndx:=SHN_COMMON
else
begin
if assigned(objsym.objsection) then
elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx
else
elfsym.st_shndx:=SHN_UNDEF;
end;
objsym.symidx:=symidx;
inc(symidx);
{$ifdef ver2_0_0}
elfsymnative:=MaybeSwapElfSymbol(elfsym);
symtabsect.write(elfsymnative,sizeof(elfsym));
{$else}
symtabsect.write(MaybeSwapElfSymbol(elfsym),sizeof(elfsym));
{$endif ver2_0_0}
end;
end;
var
i : longint; i : longint;
objsym : TObjSymbol; objsym : TObjSymbol;
begin begin
@ -852,67 +910,21 @@ implementation
write_internal_symbol(1,STT_FILE,SHN_ABS); write_internal_symbol(1,STT_FILE,SHN_ABS);
{ section } { section }
ObjSectionList.ForEachCall(@section_write_symbol,nil); ObjSectionList.ForEachCall(@section_write_symbol,nil);
{ ObjSymbols } { First the Local Symbols, this is required by ELF. The localsyms
count stored in shinfo is used to skip the local symbols
when traversing the symtab }
for i:=0 to ObjSymbolList.Count-1 do for i:=0 to ObjSymbolList.Count-1 do
begin begin
objsym:=TObjSymbol(ObjSymbolList[i]); objsym:=TObjSymbol(ObjSymbolList[i]);
if objsym.bind<>AB_LOCAL then if (objsym.bind=AB_LOCAL) and (objsym.typ<>AT_LABEL) then
begin WriteSym(objsym);
fillchar(elfsym,sizeof(elfsym),0); end;
{ symbolname, write the #0 separate to overcome 255+1 char not possible } { Global Symbols }
elfsym.st_name:=strtabsect.Size; for i:=0 to ObjSymbolList.Count-1 do
strtabsect.writestr(objsym.name); begin
strtabsect.writestr(#0); objsym:=TObjSymbol(ObjSymbolList[i]);
elfsym.st_size:=objsym.size; if (objsym.bind<>AB_LOCAL) then
case objsym.bind of WriteSym(objsym);
AB_LOCAL :
begin
elfsym.st_value:=objsym.address;
elfsym.st_info:=STB_LOCAL shl 4;
inc(localsyms);
end;
AB_COMMON :
begin
elfsym.st_value:=$10;
elfsym.st_info:=STB_GLOBAL shl 4;
end;
AB_EXTERNAL :
elfsym.st_info:=STB_GLOBAL shl 4;
AB_GLOBAL :
begin
elfsym.st_value:=objsym.address;
elfsym.st_info:=STB_GLOBAL shl 4;
end;
end;
if (objsym.bind<>AB_EXTERNAL) and
not(assigned(objsym.objsection) and
not(oso_data in objsym.objsection.secoptions)) then
begin
case objsym.typ of
AT_FUNCTION :
elfsym.st_info:=elfsym.st_info or STT_FUNC;
AT_DATA :
elfsym.st_info:=elfsym.st_info or STT_OBJECT;
end;
end;
if objsym.bind=AB_COMMON then
elfsym.st_shndx:=SHN_COMMON
else
begin
if assigned(objsym.objsection) then
elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx
else
elfsym.st_shndx:=SHN_UNDEF;
end;
objsym.symidx:=symidx;
inc(symidx);
{$ifdef ver2_0_0}
elfsymnative:=MaybeSwapElfSymbol(elfsym);
symtabsect.write(elfsymnative,sizeof(elfsym));
{$else}
symtabsect.write(MaybeSwapElfSymbol(elfsym),sizeof(elfsym));
{$endif ver2_0_0}
end;
end; end;
{ update the .symtab section header } { update the .symtab section header }
symtabsect.shlink:=strtabsect.secshidx; symtabsect.shlink:=strtabsect.secshidx;
@ -982,14 +994,14 @@ implementation
begin begin
TElfObjSection(p).secshidx:=pword(arg)^; TElfObjSection(p).secshidx:=pword(arg)^;
inc(pword(arg)^); inc(pword(arg)^);
if TElfObjSection(p).relocations.count>0 then if TElfObjSection(p).ObjRelocations.count>0 then
inc(pword(arg)^); inc(pword(arg)^);
end; end;
procedure TElfObjectOutput.section_create_relocsec(p:TObject;arg:pointer); procedure TElfObjectOutput.section_create_relocsec(p:TObject;arg:pointer);
begin begin
if (TElfObjSection(p).relocations.count>0) then if (TElfObjSection(p).ObjRelocations.count>0) then
createrelocsection(TElfObjSection(p)); createrelocsection(TElfObjSection(p));
end; end;