paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-16 05:50:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Reverted r17556 and replaced it with more generic handling of 'rela'-styled relocations. Resolves #19416.

Browse Source 
+ Test case added to existing test/ulib2a.pp.

git-svn-id: trunk@17580 -
This commit is contained in:
sergei 2011-05-27 18:19:08 +00:00
parent 954293f30b
commit e3050439a8
2 changed files with 53 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
compiler/ogelf.pas
View File

@ -295,8 +295,8 @@ implementation
end;
telf64reloc=packed record
address : qword;
info : qword; { bit 0-7: type, 8-31: symbol }
addend : qword;
info : qword; { bit 0-31: type, 32-63: symbol }
addend : int64; { signed! }
end;
telf64symbol=packed record
st_name : longint;
@ -768,12 +768,8 @@ implementation
inc(data,symaddr-len-CurrObjSec.Size)
else
begin
{$ifndef x86_64}
CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype);
inc(data,symaddr);
{$else x86_64}
CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype);
{$endif}
end;
end
else
@ -814,6 +810,8 @@ implementation
relsym,
reltyp : longint;
relocsect : TObjSection;
tmp: aint;
asize: longint;
begin
with elf32data do
begin
@ -865,7 +863,7 @@ implementation
begin
reltyp:=R_X86_64_PC32;
{ length of the relocated location is handled here }
rel.addend:=qword(-4);
rel.addend:=-4;
end;
RELOC_ABSOLUTE :
reltyp:=R_X86_64_64;
@ -875,39 +873,51 @@ implementation
begin
reltyp:=R_X86_64_GOTPCREL;
{ length of the relocated location is handled here }
rel.addend:=qword(-4);
rel.addend:=-4;
end;
RELOC_PLT32 :
begin
reltyp:=R_X86_64_PLT32;
{ length of the relocated location is handled here }
rel.addend:=qword(-4);
rel.addend:=-4;
end;
{$endif x86_64}
else
internalerror(200602261);
end;
{ This handles ELF 'rela'-styled relocations, which are currently used only for x86_64,
but can be used other targets, too. }
{$ifdef x86_64}
s.Data.Seek(objreloc.dataoffset);
if objreloc.typ=RELOC_ABSOLUTE then
begin
asize:=8;
s.Data.Read(tmp,8);
rel.addend:=rel.addend+tmp;
end
else
begin
asize:=4;
s.Data.Read(tmp,4);
rel.addend:=rel.addend+longint(tmp);
end;
{ and zero the data member out }
tmp:=0;
s.Data.Seek(objreloc.dataoffset);
s.Data.Write(tmp,asize);
{$endif}
{ Symbol }
if assigned(objreloc.symbol) then
begin
{$ifdef x86_64}
if (objreloc.symbol.bind=AB_LOCAL) and
(objreloc.typ in [RELOC_RELATIVE,RELOC_ABSOLUTE,RELOC_ABSOLUTE32]) then
if objreloc.symbol.symidx=-1 then
begin
inc(rel.addend,objreloc.symbol.address);
relsym:=objreloc.symbol.objsection.secsymidx;
end
else
{$endif}
begin
if objreloc.symbol.symidx=-1 then
begin
writeln(objreloc.symbol.Name);
internalerror(200603012);
end;
relsym:=objreloc.symbol.symidx;
end
writeln(objreloc.symbol.Name);
internalerror(200603012);
end;
relsym:=objreloc.symbol.symidx;
end
else
begin

18
tests/test/ulib2a.pp
View File

@ -9,6 +9,14 @@ type
ITest=interface(IInterface)['{1C37883B-2909-4A74-A10B-D929D0443B1F}']
procedure DoSomething;
end;
resourcestring
STest = 'A test resourcestring';
const
// a resourcestring consists of 3 strings (name,current value,default value)
// Pointer to it actually points to symbol+sizeof(pointer); this offset must not be lost (bug #19416)
pTest:PAnsiString = @STest;
implementation
@ -26,6 +34,15 @@ begin
halt(1);
end;
procedure test_resourcestring;
begin
if (pTest<>@STest) or (pTest^<>'A test resourcestring') then
begin
writeln('resourcestring relocation error');
Halt(2);
end;
end;
procedure TObj.DoSomething;
begin
writeln('correct method called');
@ -34,6 +51,7 @@ end;
var t: ITest;
initialization
test_resourcestring;
t := TObj.Create;
t.DoSomething;
end.