arm64-subsetreg-32

This patch is based on the commit detailed below with paths adjusted
to match the Debian fpc package --plugwash
commit 3683d8b018c6acbce468e8db6478328e38b87fcf
Author: Jonas Maebe <jonas.maebe@elis.ugent.be>
Date:   Sun Dec 9 14:46:52 2018 +0000

      * when optimising subsetreg moves for aarch64, take into account the fact
        that the subsetreg itself can be 32 or 64 bit (mantis #33607)

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

Gbp-Pq: Name arm64-subsetreg-32.patch

diff --git a/fpcsrc/compiler/aarch64/hlcgcpu.pas b/fpcsrc/compiler/aarch64/hlcgcpu.pas
index 1238d451376bea65695b96292019f22e153bb7f1..a33483c988056ed10a84f45c76c5d97544536a20 100644 (file)
--- a/fpcsrc/compiler/aarch64/hlcgcpu.pas
+++ b/fpcsrc/compiler/aarch64/hlcgcpu.pas
@@ -59,7 +59,10 @@ implementation
     begin
       tocgsize:=def_cgsize(tosize);
       if (sreg.startbit<>0) or
-         not(sreg.bitlen in [32,64]) then
+         not((sreg.subsetregsize in [OS_32,OS_S32]) and
+             (sreg.bitlen=32)) or
+         not((sreg.subsetregsize in [OS_64,OS_S64]) and
+             (sreg.bitlen=64)) then
         begin
           if is_signed(subsetsize) then
             op:=A_SBFX

diff --git a/fpcsrc/tests/webtbs/tw33607.pp b/fpcsrc/tests/webtbs/tw33607.pp
new file mode 100644 (file)
index 0000000..7e9d6ac
--- /dev/null
+++ b/fpcsrc/tests/webtbs/tw33607.pp
@@ -0,0 +1,51 @@
+{$mode objfpc}{$H+}
+{$modeSwitch advancedRecords}
+
+type
+   TRectangle = record
+                  public
+                  Left, Bottom: Integer;
+                  Width, Height: Cardinal;
+
+               function ScaleAround0(const Factor: Single): TRectangle;
+               end;
+
+function TRectangle.ScaleAround0(const Factor: Single): TRectangle;
+begin
+   if Width <= 0 then
+   begin
+      Result.Width  := Width;
+      Result.Left   := Left;
+   end else
+      halt(3);
+
+   Result.Height := Height;
+   Result.Bottom := Bottom;
+end;
+
+function Rectangle(const Left, Bottom: Integer;
+                  const Width, Height: Cardinal): TRectangle;
+begin
+   Rectangle.Left := Left;
+   Rectangle.Bottom := Bottom;
+   Rectangle.Width := Width;
+   Rectangle.Height := Height;
+end;
+
+procedure test(c: qword);
+begin
+  if c<>0 then
+    halt(2);
+end;
+
+var
+   R, S        :  TRectangle;
+begin
+   R := Rectangle(10, 20, 0, 50);
+   S := R.ScaleAround0(2);
+   if s.width<>0 then
+     halt(1);
+
+  test(R.ScaleAround0(2).Width);
+end.
+