From 481b48eecba118a19f6839fe180e6baec600af78 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 3 May 2020 17:39:38 +0000
Subject: [PATCH] --- Merging r45199 into '.': U   
 compiler/powerpc64/cpupara.pas A    tests/webtbs/tw36934.pp --- Recording
 mergeinfo for merge of r45199 into '.':  U   .

git-svn-id: branches/fixes_3_2@45235 -
---
 .gitattributes                 |  1 +
 compiler/powerpc64/cpupara.pas | 36 ++++++++++++++++---
 tests/webtbs/tw36934.pp        | 65 ++++++++++++++++++++++++++++++++++
 3 files changed, 98 insertions(+), 4 deletions(-)
 create mode 100644 tests/webtbs/tw36934.pp

diff --git a/.gitattributes b/.gitattributes
index 01ce3d33bc..d490b6c00d 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -17623,6 +17623,7 @@ tests/webtbs/tw3681.pp svneol=native#text/plain
 tests/webtbs/tw3683.pp svneol=native#text/plain
 tests/webtbs/tw3687.pp svneol=native#text/plain
 tests/webtbs/tw3691.pp svneol=native#text/plain
+tests/webtbs/tw36934.pp svneol=native#text/plain
 tests/webtbs/tw3694.pp svneol=native#text/plain
 tests/webtbs/tw3695.pp svneol=native#text/plain
 tests/webtbs/tw3697.pp svneol=native#text/plain
diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas
index d2c20419f6..5da3edf3fd 100644
--- a/compiler/powerpc64/cpupara.pas
+++ b/compiler/powerpc64/cpupara.pas
@@ -632,6 +632,19 @@ implemented
   { can become < 0 for e.g. 3-byte records }
   while (paralen > 0) do begin
     paraloc := para.add_location;
+    { ELF64v2 a: overflow homogeneous float storage into integer registers
+      if possible (only possible in case of single precision floats, because
+      there are more fprs than gprs for parameter passing) }
+    if assigned(alllocdef) and
+       (tcgsize2size[paracgsize]=4) and
+       (loc=LOC_FPUREGISTER) and
+       (nextfloatreg=RS_F13) and
+       (paralen>4) then
+      begin
+        loc:=LOC_REGISTER;
+        paracgsize:=OS_64;
+        locdef:=u64inttype;
+      end;
     { In case of po_delphi_nested_cc, the parent frame pointer
       is always passed on the stack. }
     if (loc = LOC_REGISTER) and
@@ -691,12 +704,24 @@ implemented
       paraloc^.def := locdef;
       paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE);
       { the PPC64 ABI says that the GPR index is increased for every parameter, no matter
-      which type it is stored in }
-      inc(nextintreg);
+        which type it is stored in
+        -- exception: ELFv2 abi when passing aggregate parts in FPRs, because those are
+           a direct mirror of the memory layout of the aggregate }
+      if not assigned(alllocdef) then
+        begin
+          inc(nextintreg);
+          inc(stack_offset, tcgsize2size[OS_FLOAT]);
+        end
+      else
+        begin
+          if (tcgsize2size[paracgsize]=8) or
+             odd(ord(nextfloatreg)-ord(RS_F1)) then
+            inc(nextintreg);
+          inc(stack_offset, tcgsize2size[paracgsize]);
+        end;
       inc(nextfloatreg);
       dec(paralen, tcgsize2size[paraloc^.size]);
 
-      inc(stack_offset, tcgsize2size[OS_FLOAT]);
     end else if (loc = LOC_MMREGISTER) then begin
       { Altivec not supported }
       internalerror(200510192);
@@ -707,7 +732,10 @@ implemented
       case loc of
         LOC_FPUREGISTER:
           begin
-            paraloc^.size:=int_float_cgsize(paralen);
+            if assigned(alllocdef) then
+              paraloc^.size:=def_cgsize(alllocdef)
+            else
+              paraloc^.size:=int_float_cgsize(paralen);
             case paraloc^.size of
               OS_F32: paraloc^.def:=s32floattype;
               OS_F64: paraloc^.def:=s64floattype;
diff --git a/tests/webtbs/tw36934.pp b/tests/webtbs/tw36934.pp
new file mode 100644
index 0000000000..3b82cde5ac
--- /dev/null
+++ b/tests/webtbs/tw36934.pp
@@ -0,0 +1,65 @@
+type
+  TPointF = record
+    x,y: single;
+  end;
+
+procedure test(pt1, pt2, pt3,
+  pt4: TPointF; texture: tobject; tex1, tex2, tex3, tex4: TPointF);
+begin
+  if pt1.x<>1.0 then
+    halt(1);
+  if pt1.y<>2.0 then
+    halt(2);
+  if pt2.x<>3.0 then
+    halt(3);
+  if pt2.y<>4.0 then
+    halt(4);
+  if pt3.x<>5.0 then
+    halt(5);
+  if pt3.y<>6.0 then
+    halt(6);
+  if pt4.x<>7.0 then
+    halt(7);
+  if pt4.y<>8.0 then
+    halt(8);
+  if texture<>nil then
+    halt(9);
+  if tex1.x<>9.0 then
+    halt(9);
+  if tex1.y<>10.0 then
+    halt(10);
+  if tex2.x<>11.0 then
+    halt(11);
+  if tex2.y<>12.0 then
+    halt(12);
+  if tex3.x<>13.0 then
+    halt(13);
+  if tex3.y<>14.0 then
+    halt(14);
+  if tex4.x<>15.0 then
+    halt(15);
+  if tex4.y<>16.0 then
+    halt(16);
+end;
+
+var
+  p1,p2,p3,p4,t1,t2,t3,t4: tpointf;
+begin
+  p1.x:=1.0;
+  p1.y:=2.0;
+  p2.x:=3.0;
+  p2.y:=4.0;
+  p3.x:=5.0;
+  p3.y:=6.0;
+  p4.x:=7.0;
+  p4.y:=8.0;
+  t1.x:=9.0;
+  t1.y:=10.0;
+  t2.x:=11.0;
+  t2.y:=12.0;
+  t3.x:=13.0;
+  t3.y:=14.0;
+  t4.x:=15.0;
+  t4.y:=16.0;
+  test(p1,p2,p3,p4,nil,t1,t2,t3,t4);
+end.