Răsfoiți Sursa

* When relocating local symbols on x86_64, put symbol address into addend field of the relocation, resolves #13671.
+ test

git-svn-id: trunk@17556 -

sergei 14 ani în urmă
părinte
comite
9c27a802a0
5 a modificat fișierele cu 91 adăugiri și 5 ștergeri
  1. 3 0
      .gitattributes
  2. 20 5
      compiler/ogelf.pas
  3. 10 0
      tests/test/tlib2a.pp
  4. 20 0
      tests/test/tlib2b.pp
  5. 38 0
      tests/test/ulib2a.pp

+ 3 - 0
.gitattributes

@@ -9944,6 +9944,8 @@ tests/test/tisogoto3.pp svneol=native#text/pascal
 tests/test/tisogoto4.pp svneol=native#text/pascal
 tests/test/tlib1a.pp svneol=native#text/plain
 tests/test/tlib1b.pp svneol=native#text/plain
+tests/test/tlib2a.pp svneol=native#text/plain
+tests/test/tlib2b.pp svneol=native#text/plain
 tests/test/tlibrary1.pp svneol=native#text/plain
 tests/test/tlibrary2.pp svneol=native#text/plain
 tests/test/tlibrary3.pp svneol=native#text/plain
@@ -10336,6 +10338,7 @@ tests/test/uimpluni1.pp svneol=native#text/plain
 tests/test/uimpluni2.pp svneol=native#text/plain
 tests/test/uinline4a.pp svneol=native#text/plain
 tests/test/uinline4b.pp svneol=native#text/plain
+tests/test/ulib2a.pp svneol=native#text/plain
 tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
 tests/test/umacpas1.pp svneol=native#text/plain
 tests/test/umainnam.pp svneol=native#text/plain

+ 20 - 5
compiler/ogelf.pas

@@ -768,8 +768,12 @@ 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
@@ -887,12 +891,23 @@ implementation
                { Symbol }
                if assigned(objreloc.symbol) then
                  begin
-                   if objreloc.symbol.symidx=-1 then
+{$ifdef x86_64}
+                   if (objreloc.symbol.bind=AB_LOCAL) and
+                     (objreloc.typ in [RELOC_RELATIVE,RELOC_ABSOLUTE,RELOC_ABSOLUTE32]) then
+                     begin
+                       inc(rel.addend,objreloc.symbol.address);
+                       relsym:=objreloc.symbol.objsection.secsymidx;
+                     end
+                   else
+{$endif}
                      begin
-                       writeln(objreloc.symbol.Name);
-                       internalerror(200603012);
-                     end;
-                   relsym:=objreloc.symbol.symidx;
+                       if objreloc.symbol.symidx=-1 then
+                         begin
+                           writeln(objreloc.symbol.Name);
+                           internalerror(200603012);
+                         end;
+                       relsym:=objreloc.symbol.symidx;
+                     end
                  end
                else
                  begin

+ 10 - 0
tests/test/tlib2a.pp

@@ -0,0 +1,10 @@
+{ %target=linux }
+{ %norun }
+
+library lib2a;
+
+uses ulib2a;
+
+begin
+end.
+

+ 20 - 0
tests/test/tlib2b.pp

@@ -0,0 +1,20 @@
+{ %target=linux }
+{ %needlibrary }
+
+uses dl;
+
+var
+   hdl : Pointer;
+
+begin
+   WriteLn('dlopen');
+   hdl := dlopen('./libtlib2a.so', RTLD_LAZY);
+   if hdl = nil then
+      WriteLn(dlerror())
+   else
+   begin
+      WriteLn('dlclose');
+      dlclose(hdl);
+   end;
+   WriteLn('exit');
+end.

+ 38 - 0
tests/test/ulib2a.pp

@@ -0,0 +1,38 @@
+
+{$mode objfpc}
+unit ulib2a;
+
+interface
+
+type
+  ITest=interface(IInterface)['{1C37883B-2909-4A74-A10B-D929D0443B1F}']
+    procedure DoSomething;
+  end;
+  
+implementation
+
+// must be declared in implementation, so DoSomething is not global
+type
+  TObj=class(TInterfacedObject,ITest)
+    procedure DoSomething;
+  end;
+
+// this is located at the start of .text section. If relocation offset is lost,
+// calling DoSomething will likely transfer control here.  
+procedure DoSomethingElse;
+begin
+  writeln('wrong!!!');
+  halt(1);
+end;
+
+procedure TObj.DoSomething;
+begin
+  writeln('correct method called');
+end;
+
+var t: ITest;
+
+initialization
+  t := TObj.Create;
+  t.DoSomething;
+end.