* fixed loading spilled registers from offsets outside the smallint

    range for ppc32 and ppc64 (mantis #8633)

git-svn-id: trunk@7142 -

.gitattributes

@@ -317,7 +317,6 @@ compiler/powerpc/nppccnv.pas svneol=native#text/plain
 compiler/powerpc/nppcmat.pas svneol=native#text/plain
 compiler/powerpc/rappc.pas svneol=native#text/plain
 compiler/powerpc/rappcgas.pas svneol=native#text/plain
-compiler/powerpc/rgcpu.pas svneol=native#text/plain
 compiler/powerpc/rppccon.inc svneol=native#text/plain
 compiler/powerpc/rppcdwrf.inc svneol=native#text/plain
 compiler/powerpc/rppcgas.inc svneol=native#text/plain
@@ -353,7 +352,6 @@ compiler/powerpc64/ppcins.dat -text
 compiler/powerpc64/ppcreg.dat -text
 compiler/powerpc64/rappc.pas svneol=native#text/plain
 compiler/powerpc64/rappcgas.pas svneol=native#text/plain
-compiler/powerpc64/rgcpu.pas svneol=native#text/plain
 compiler/powerpc64/rppccon.inc svneol=native#text/plain
 compiler/powerpc64/rppcdwrf.inc svneol=native#text/plain
 compiler/powerpc64/rppcgas.inc svneol=native#text/plain
@@ -382,6 +380,7 @@ compiler/ppcgen/ngppcadd.pas svneol=native#text/plain
 compiler/ppcgen/ngppccnv.pas svneol=native#text/plain
 compiler/ppcgen/ngppcinl.pas svneol=native#text/plain
 compiler/ppcgen/ngppcset.pas svneol=native#text/plain
+compiler/ppcgen/rgcpu.pas svneol=native#text/plain
 compiler/ppcppc.lpi svneol=native#text/plain
 compiler/ppcsparc.lpi svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
@@ -8160,6 +8159,7 @@ tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8525.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
 tests/webtbs/tw8615.pp svneol=native#text/plain
+tests/webtbs/tw8633.pp svneol=native#text/plain
 tests/webtbs/tw8660.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain

compiler/powerpc/rgcpu.pas

@@ -1,130 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements the powerpc specific class for the register
-    allocator
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-unit rgcpu;
-
-{$i fpcdefs.inc}
-
-  interface
-
-     uses
-       aasmbase,aasmtai,aasmdata,
-       cpubase,
-       rgobj;
-
-     type
-       trgcpu = class(trgobj)
-{
-         function getcpuregisterint(list: TAsmList; reg: Tnewregister): tregister; override;
-         procedure ungetregisterint(list: TAsmList; reg: tregister); override;
-         function getcpuregisterfpu(list : TAsmList; r : Toldregister) : tregister;override;
-         procedure ungetregisterfpu(list: TAsmList; r : tregister; size:TCGsize);override;
-         procedure cleartempgen; override;
-        private
-         usedpararegs: Tsupregset;
-         usedparafpuregs: tregisterset;
-}
-       end;
-
-  implementation
-
-    uses
-      cgobj, verbose, cutils;
-
-(*
-    function trgcpu.getcpuregisterint(list: TAsmList; reg: Tnewregister): tregister;
-
-      begin
-        if ((reg shr 8) in [RS_R0]) and
-           not((reg shr 8) in is_reg_var_int) then
-          begin
-            if (reg shr 8) in usedpararegs then
-              internalerror(2003060701);
-{              comment(v_warning,'Double allocation of register '+tostr((reg shr 8)-1));}
-            include(usedpararegs,reg shr 8);
-            result.enum:=R_INTREGISTER;
-            result.number:=reg;
-            cg.a_reg_alloc(list,result);
-          end
-        else result := inherited getcpuregisterint(list,reg);
-      end;
-
-
-    procedure trgcpu.ungetregisterint(list: TAsmList; reg: tregister);
-
-      begin
-        if ((reg.number shr 8) in [RS_R0]) and
-            not((reg.number shr 8) in is_reg_var_int) then
-          begin
-            if not((reg.number shr 8) in usedpararegs) then
-              internalerror(2003060702);
-{               comment(v_warning,'Double free of register '+tostr((reg.number shr 8)-1));}
-            exclude(usedpararegs,reg.number shr 8);
-            cg.a_reg_dealloc(list,reg);
-          end
-        else
-          inherited ungetregisterint(list,reg);
-      end;
-
-
-    function trgcpu.getcpuregisterfpu(list : TAsmList; r : Toldregister) : tregister;
-      begin
-        if (r in [R_F1..R_F13]) and
-           not is_reg_var_other[r] then
-          begin
-            if r in usedparafpuregs then
-              internalerror(2003060902);
-            include(usedparafpuregs,r);
-            result.enum := r;
-            cg.a_reg_alloc(list,result);
-          end
-        else
-          result := inherited getcpuregisterfpu(list,r);
-      end;
-
-
-    procedure trgcpu.ungetregisterfpu(list: TAsmList; r : tregister; size:TCGsize);
-      begin
-        if (r.enum in [R_F1..R_F13]) and
-           not is_reg_var_other[r.enum] then
-          begin
-            if not(r.enum in usedparafpuregs) then
-              internalerror(2003060903);
-            exclude(usedparafpuregs,r.enum);
-            cg.a_reg_dealloc(list,r);
-          end
-        else
-          inherited ungetregisterfpu(list,r,size);
-      end;
-
-
-    procedure trgcpu.cleartempgen;
-
-      begin
-        inherited cleartempgen;
-        usedpararegs := [];
-        usedparafpuregs := [];
-      end;
-*)
-
-end.

compiler/powerpc64/rgcpu.pas

@@ -1,46 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements the powerpc specific class for the register
-    allocator
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-unit rgcpu;
-
-{$I fpcdefs.inc}
-
-interface
-
-uses
-  aasmbase, aasmtai,aasmdata,
-  cpubase,
-  rgobj;
-
-type
-  trgcpu = class(trgobj)
-  end;
-
-implementation
-
-uses
-  cgobj, verbose, cutils;
-
-
-end.
-

compiler/ppcgen/rgcpu.pas

@@ -0,0 +1,127 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the powerpc specific class for the register
+    allocator
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit rgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+     uses
+       aasmbase,aasmtai,aasmdata,aasmcpu,
+       cgbase,cgutils,
+       cpubase,
+       rgobj;
+
+     type
+       trgcpu = class(trgobj)
+         procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+         procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+       end;
+
+  implementation
+
+    uses
+      verbose, cutils,
+      cgobj,
+      procinfo;
+
+
+    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        tmpref : treference;
+        helplist : TAsmList;
+        l : tasmlabel;
+        hreg : tregister;
+      begin
+        if (spilltemp.offset<low(smallint)) or
+           (spilltemp.offset>high(smallint)) then
+          begin
+            helplist:=TAsmList.create;
+
+            if (spilltemp.index<>NR_NO) then
+              internalerror(200704201);
+
+            if getregtype(tempreg)=R_INTREGISTER then
+              hreg:=getregisterinline(helplist,R_SUBWHOLE)
+            else
+              hreg:=cg.getintregister(helplist,OS_ADDR);
+            reference_reset(tmpref);
+            tmpref.offset:=spilltemp.offset;
+            tmpref.refaddr:=addr_hi;
+            helplist.concat(taicpu.op_reg_reg_ref(A_ADDIS,hreg,spilltemp.base,tmpref));
+            tmpref:=spilltemp;
+            tmpref.refaddr:=addr_lo;
+            tmpref.base:=hreg;
+            helplist.concat(spilling_create_load(tmpref,tempreg));
+
+            if getregtype(tempreg)=R_INTREGISTER then
+              ungetregisterinline(helplist,hreg);
+
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else
+          inherited do_spill_read(list,pos,spilltemp,tempreg);
+      end;
+
+
+    procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+      var
+        tmpref : treference;
+        helplist : TAsmList;
+        l : tasmlabel;
+        hreg : tregister;
+      begin
+        if (spilltemp.offset<low(smallint)) or
+           (spilltemp.offset>high(smallint)) then
+          begin
+            helplist:=TAsmList.create;
+
+            if (spilltemp.index<>NR_NO) then
+              internalerror(200704201);
+
+            if getregtype(tempreg)=R_INTREGISTER then
+              hreg:=getregisterinline(helplist,R_SUBWHOLE)
+            else
+              hreg:=cg.getintregister(helplist,OS_ADDR);
+            reference_reset(tmpref);
+            tmpref.offset:=spilltemp.offset;
+            tmpref.refaddr:=addr_hi;
+            helplist.concat(taicpu.op_reg_reg_ref(A_ADDIS,hreg,spilltemp.base,tmpref));
+            tmpref:=spilltemp;
+            tmpref.refaddr:=addr_lo;
+            tmpref.base:=hreg;
+            helplist.concat(spilling_create_store(tempreg,tmpref));
+
+            if getregtype(tempreg)=R_INTREGISTER then
+              ungetregisterinline(helplist,hreg);
+
+            list.insertlistafter(pos,helplist);
+            helplist.free;
+          end
+        else
+          inherited do_spill_written(list,pos,spilltemp,tempreg);
+      end;
+
+end.

tests/webtbs/tw8633.pp

@@ -0,0 +1,46 @@
+{ %norun }
+
+{$MODE objfpc}
+unit tw8633;
+interface
+
+function dorm2r_(var side: Char; var trans: Char; var m: Integer; var n: Integer; var k: Integer; var a: Double; var lda: Integer; var tau: Double; var c__: Double; var ldc: Integer; var work: Double; var info: Integer; side_len: Integer; trans_len: Integer): Integer; cdecl; external;
+function dormqr_(var side: Char; var trans: Char; var m: Integer; var n: Integer; var k: Integer; var a: Double; var lda: Integer; var tau: Double; var c__: Double; var ldc: Integer; var work: Double; var lwork: Integer; var info: Integer; side_len: Integer; trans_len: Integer): Integer; cdecl;
+
+implementation
+
+uses SysUtils, Math;
+
+function ILAENV(ispec: Integer; name__: string; opts: string;
+                 n1: Integer; n2: Integer; n3: Integer; n4: Integer): Integer;
+begin
+  Result := 0; 
+end;
+
+function dormqr_(var side: Char; var trans: Char; var m: Integer; var n: Integer; var k: Integer; var a: Double; var lda: Integer; var tau: Double; var c__: Double; var ldc: Integer; var work: Double; var lwork: Integer; var info: Integer; side_len: Integer; trans_len: Integer): Integer; cdecl;
+var
+  iinfo, iws, ldwork,
+  lwkopt, nb, nbmin, nw: Integer;
+  T: array [1..65*64] of Double;
+begin
+
+      NBMIN := 2;
+      LDWORK := NW;
+      IF ( NB > 1 ) and ( NB < K ) THEN BEGIN
+         IWS := NW*NB;
+         IF LWORK < IWS THEN BEGIN
+            NB := LWORK div LDWORK;
+            NBMIN := MAX( 2, ILAENV( 2, 'DORMQR', SIDE + TRANS, M, N, K,-1 ) );
+         END;
+      END ELSE
+         IWS := NW;
+
+      IF( NB < NBMIN ) or  ( NB >= K ) THEN
+       dorm2r_( SIDE, TRANS, M, N, K, A, LDA, TAU, c__, LDC, WORK, IINFO, side_len, trans_len );
+      WORK := LWKOPT;
+end;
+
+end.
+
+
+