Fix gotpcrel relocation for TESTQ x86_64 instruction

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49252 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 56 insertions, 1 deletions

diff --git a/compiler/ogelf.pas b/compiler/ogelf.pas
index bb77186427..e21123c8c6 100644
--- a/compiler/ogelf.pas
+++ b/compiler/ogelf.pas
@@ -672,7 +672,10 @@ implementation
         if assigned(objreloc) then
           begin
             objreloc.size:=len;
-            if reltype in [RELOC_RELATIVE{$ifdef x86},RELOC_PLT32{$endif}{$ifdef x86_64},RELOC_TLSGD,RELOC_GOTPCREL{$endif}] then
+            { RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX] need special handling
+              this is done in x86/aasmcpu unit }
+            if reltype in [RELOC_RELATIVE{$ifdef x86},RELOC_PLT32{$endif}
+               {$ifdef x86_64}, RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX,RELOC_TLSGD{$endif}] then
               dec(data,len);
             if ElfTarget.relocs_use_addend then
               begin
diff --git a/compiler/x86/aasmcpu.pas b/compiler/x86/aasmcpu.pas
index 43ed8b4fd2..41f57dad9d 100644
--- a/compiler/x86/aasmcpu.pas
+++ b/compiler/x86/aasmcpu.pas
@@ -3682,6 +3682,16 @@ implementation
              end;
 {$endif i386}
            objdata.writereloc(data,len,p,Reloctype);
+{$ifdef x86_64}
+	   { Computed offset is not yet correct for GOTPC relocation }
+           { RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX need special handling }
+           if assigned(p) and (RelocType in [RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX]) and
+              { These relocations seem to be used only for ELF
+                which always has relocs_use_addend set to true 
+                so that it is the orgsize of the last relocation which needs to be fixed PM  }
+              (insend<>objdata.CurrObjSec.size) then
+             dec(TObjRelocation(objdata.CurrObjSec.ObjRelocations.Last).orgsize,insend-objdata.CurrObjSec.size);
+{$endif}
          end;
 
 
diff --git a/tests/webtbs/tw38353.pp b/tests/webtbs/tw38353.pp
new file mode 100644
index 0000000000..2d57fbe30a
--- /dev/null
+++ b/tests/webtbs/tw38353.pp
@@ -0,0 +1,42 @@
+{ %OPT=-Cg -O2 }
+{ %CPU=x86_64 }
+
+{ -Cg and -O2 options together lead to 
+  the generation of instruction:
+  testq   $15,U_$P$VECTORCALL_HVA_TEST1_$$_HVA@GOTPCREL(%rip)
+  for which the relocation was not correctly generated
+  in the internal assembler }
+
+program tw38353;
+
+{$IFNDEF CPUX86_64}
+  {$FATAL This test program can only be compiled on Windows or Linux 64-bit with an Intel processor }
+{$ENDIF}
+
+{$ASMMODE Intel}
+{$PUSH}
+{$CODEALIGN RECORDMIN=16}
+{$PACKRECORDS C}
+type
+  TM128 = record
+    case Byte of
+      0: (M128_F32: array[0..3] of Single);
+      1: (M128_F64: array[0..1] of Double);
+  end;
+{$POP}
+
+var
+  HVA: TM128;
+
+begin
+{$ifdef verbose}
+  writeln('@HVA=',hexstr(ptruint(@HVA),2*sizeof(ptruint)));
+{$endif verbose}
+  if (PtrUInt(@HVA) and $F) <> 0 then
+  begin
+{$ifdef verbose}
+    WriteLn('FAIL: HVA is not correctly aligned.');
+{$endif verbose}
+    Halt(1);
+  end;
+end.