mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 23:49:05 +02:00
* fixed loading spilled registers from offsets outside the smallint
range for ppc32 and ppc64 (mantis #8633) git-svn-id: trunk@7142 -
This commit is contained in:
Jonas Maebe
parent
e98fc7e396
commit
8077765f13
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -317,7 +317,6 @@ compiler/powerpc/nppccnv.pas svneol=native#text/plain
|
|||||||
compiler/powerpc/nppcmat.pas svneol=native#text/plain
|
compiler/powerpc/nppcmat.pas svneol=native#text/plain
|
||||||
compiler/powerpc/rappc.pas svneol=native#text/plain
|
compiler/powerpc/rappc.pas svneol=native#text/plain
|
||||||
compiler/powerpc/rappcgas.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/rppccon.inc svneol=native#text/plain
|
||||||
compiler/powerpc/rppcdwrf.inc svneol=native#text/plain
|
compiler/powerpc/rppcdwrf.inc svneol=native#text/plain
|
||||||
compiler/powerpc/rppcgas.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/ppcreg.dat -text
|
||||||
compiler/powerpc64/rappc.pas svneol=native#text/plain
|
compiler/powerpc64/rappc.pas svneol=native#text/plain
|
||||||
compiler/powerpc64/rappcgas.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/rppccon.inc svneol=native#text/plain
|
||||||
compiler/powerpc64/rppcdwrf.inc svneol=native#text/plain
|
compiler/powerpc64/rppcdwrf.inc svneol=native#text/plain
|
||||||
compiler/powerpc64/rppcgas.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/ngppccnv.pas svneol=native#text/plain
|
||||||
compiler/ppcgen/ngppcinl.pas svneol=native#text/plain
|
compiler/ppcgen/ngppcinl.pas svneol=native#text/plain
|
||||||
compiler/ppcgen/ngppcset.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/ppcppc.lpi svneol=native#text/plain
|
||||||
compiler/ppcsparc.lpi svneol=native#text/plain
|
compiler/ppcsparc.lpi svneol=native#text/plain
|
||||||
compiler/ppheap.pas 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/tw8525.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8573.pp svneol=native#text/plain
|
tests/webtbs/tw8573.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8615.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/tw8660.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8664.pp svneol=native#text/plain
|
tests/webtbs/tw8664.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1873.pp svneol=native#text/plain
|
tests/webtbs/ub1873.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
|
|
||||||
127
compiler/ppcgen/rgcpu.pas
Normal file
127
compiler/ppcgen/rgcpu.pas
Normal file
@ -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.
|
||||||
46
tests/webtbs/tw8633.pp
Normal file
46
tests/webtbs/tw8633.pp
Normal file
@ -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.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user