paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 10:48:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed loading spilled registers from offsets outside the smallint

Browse Source 
range for ppc32 and ppc64 (mantis #8633)

git-svn-id: trunk@7142 -
This commit is contained in:
Jonas Maebe 2007-04-20 13:22:45 +00:00
parent e98fc7e396
commit 8077765f13
5 changed files with 175 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -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

130
compiler/powerpc/rgcpu.pas
View File

@ -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.

46
compiler/powerpc64/rgcpu.pas
View File

@ -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
View 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
View 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.