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

* getregisterinline() can be used to replace multiple size variants

Browse Source 
of the same register (or of a register and its aliases) -> make
    sure that all relevant constraints are applied to it as well
    (mantis #16980)

git-svn-id: trunk@15952 -
This commit is contained in:
Jonas Maebe 2010-09-08 21:13:02 +00:00
parent a311607ca6
commit 22b4860dd7
3 changed files with 55 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10629,6 +10629,7 @@ tests/webtbs/tw16949a.pp svneol=native#text/plain
tests/webtbs/tw16949b.pp svneol=native#text/plain
tests/webtbs/tw16954.pp svneol=native#text/plain
tests/webtbs/tw1696.pp svneol=native#text/plain
tests/webtbs/tw16980.pp svneol=native#text/plain
tests/webtbs/tw1699.pp svneol=native#text/plain
tests/webtbs/tw1709.pp svneol=native#text/plain
tests/webtbs/tw17118.pp svneol=native#text/plain

26
compiler/rgobj.pas
View File

@ -105,7 +105,11 @@ unit rgobj;
Preginfo=^TReginfo;
tspillreginfo = record
spillreg : tregister;
{ a single register may appear more than once in an instruction,
but with different subregister types -> store all subregister types
that occur, so we can add the necessary constraints for the inline
register that will have to replace it }
spillregconstraints : set of TSubRegister;
orgreg : tsuperregister;
tempreg : tregister;
regread,regwritten, mustbespilled: boolean;
@ -164,7 +168,7 @@ unit rgobj;
procedure add_cpu_interferences(p : tai);virtual;
procedure add_constraints(reg:Tregister);virtual;
function get_alias(n:Tsuperregister):Tsuperregister;
function getregisterinline(list:TAsmList;subreg:Tsubregister):Tregister;
function getregisterinline(list:TAsmList;const subregconstraints:Tsubregisterset):Tregister;
procedure ungetregisterinline(list:TAsmList;r:Tregister);
function get_spill_subreg(r : tregister) : tsubregister;virtual;
function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;virtual;
@ -1451,15 +1455,24 @@ unit rgobj;
end;
function trgobj.getregisterinline(list:TAsmList;subreg:Tsubregister):Tregister;
function trgobj.getregisterinline(list:TAsmList;const subregconstraints:Tsubregisterset):Tregister;
var
p : Tsuperregister;
subreg: tsubregister;
begin
for subreg:=high(tsubregister) downto low(tsubregister) do
if subreg in subregconstraints then
break;
p:=getnewreg(subreg);
live_registers.add(p);
result:=newreg(regtype,p,subreg);
add_edges_used(p);
add_constraints(result);
{ also add constraints for other sizes used for this register }
if subreg<>low(tsubregister) then
for subreg:=pred(subreg) downto low(tsubregister) do
if subreg in subregconstraints then
add_constraints(newreg(regtype,getsupreg(result),subreg));
end;
@ -1872,7 +1885,7 @@ unit rgobj;
if tmpindex > high(regs) then
internalerror(2003120301);
regs[tmpindex].orgreg := supreg;
regs[tmpindex].spillreg:=reg;
include(regs[tmpindex].spillregconstraints,get_spill_subreg(reg));
if supregset_in(r,supreg) then
begin
{ add/update info on this register }
@ -1910,6 +1923,7 @@ unit rgobj;
end;
end;
var
loadpos,
storepos : tai;
@ -2036,7 +2050,7 @@ unit rgobj;
begin
if mustbespilled and regread then
begin
tempreg:=getregisterinline(list,get_spill_subreg(regs[counter].spillreg));
tempreg:=getregisterinline(list,regs[counter].spillregconstraints);
do_spill_read(list,tai(loadpos.previous),spilltemplist[orgreg],tempreg);
end;
end;
@ -2063,7 +2077,7 @@ unit rgobj;
begin
{ When the register is also loaded there is already a register assigned }
if (not regread) then
tempreg:=getregisterinline(list,get_spill_subreg(regs[counter].spillreg));
tempreg:=getregisterinline(list,regs[counter].spillregconstraints);
{ The original instruction will be the next that uses this register, this
also needs to be done for read-write registers }
add_reg_instruction(instr,tempreg,1);

34
tests/webtbs/tw16980.pp Normal file
View File

@ -0,0 +1,34 @@
{ %norun }
{$mode delphi}
{$packset 4}
type
TColorComponent = (ccRed, ccGreen, ccBlue, ccAlpha);
TColorMask = set of TColorComponent;
TGLStateCache = class
private
FColorWriteMask: array[0..15] of TColorMask;
procedure SetColorWriteMask(Index: Integer; const Value: TColorMask);
end;
TGLuint = cardinal;
tglboolean = boolean;
var
glColorMaski: procedure(index: TGLuint; r: TGLboolean; g: TGLboolean;
b: TGLboolean; a: TGLboolean);{$IFDEF MSWINDOWS} stdcall; {$ENDIF} {$IFDEF UNIX} cdecl; {$ENDIF}
procedure TGLStateCache.SetColorWriteMask(Index: Integer;
const Value: TColorMask);
begin
// if FColorWriteMask[Index]<>Value then
begin
FColorWriteMask[Index] := Value;
glColorMaski(Index, ccRed in Value, ccGreen in Value, ccBlue in Value,
ccAlpha in Value);
end;
end;
begin
end.