Browse Source

Fix gotpcrel relocation for TESTQ x86_64 instruction

git-svn-id: trunk@49252 -
pierre 4 years ago
parent
commit
17e3c31b7e
4 changed files with 57 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 4 1
      compiler/ogelf.pas
  3. 10 0
      compiler/x86/aasmcpu.pas
  4. 42 0
      tests/webtbs/tw38353.pp

+ 1 - 0
.gitattributes

@@ -18803,6 +18803,7 @@ tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw38337.pp svneol=native#text/plain
 tests/webtbs/tw38339.pp svneol=native#text/plain
 tests/webtbs/tw38351.pp -text svneol=native#text/pascal
+tests/webtbs/tw38353.pp svneol=native#text/pascal
 tests/webtbs/tw38385.pp svneol=native#text/pascal
 tests/webtbs/tw38390.pp svneol=native#text/pascal
 tests/webtbs/tw3840.pp svneol=native#text/plain

+ 4 - 1
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

+ 10 - 0
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;
 
 

+ 42 - 0
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.