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

* Speed optimisations for peephole register tracking functions

Browse Source
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2023-02-26 01:56:41 +00:00 committed by FPK
parent 05d6e20acc
commit 3882066f23
1 changed files with 82 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
compiler/aoptobj.pas
View File

@ -85,7 +85,7 @@ Unit AoptObj;
p } p }
procedure Update(p: Tai; IgnoreNewAllocs: Boolean=false); procedure Update(p: Tai; IgnoreNewAllocs: Boolean=false);
{ is Reg currently in use } { is Reg currently in use }
Function IsUsed(Reg: TRegister): Boolean; Function IsUsed(Reg: TRegister): Boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
{ get all the currently used registers } { get all the currently used registers }
Function GetUsedRegs: TRegSet; {$ifdef USEINLINE}inline;{$endif USEINLINE} Function GetUsedRegs: TRegSet; {$ifdef USEINLINE}inline;{$endif USEINLINE}
@ -271,7 +271,7 @@ Unit AoptObj;
Procedure CreateUsedRegs(var regs: TAllUsedRegs); Procedure CreateUsedRegs(var regs: TAllUsedRegs);
Procedure ClearUsedRegs; Procedure ClearUsedRegs;
Procedure UpdateUsedRegs(p : Tai); Procedure UpdateUsedRegs(p : Tai); {$ifdef USEINLINE}inline;{$endif USEINLINE}
class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai); static; class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai); static;
{ UpdateUsedRegsBetween updates the given TUsedRegs from p1 to p2 exclusive, calling GetNextInstruction { UpdateUsedRegsBetween updates the given TUsedRegs from p1 to p2 exclusive, calling GetNextInstruction
@ -287,9 +287,9 @@ Unit AoptObj;
procedure RestoreUsedRegs(const Regs : TAllUsedRegs); procedure RestoreUsedRegs(const Regs : TAllUsedRegs);
procedure TransferUsedRegs(var dest: TAllUsedRegs); procedure TransferUsedRegs(var dest: TAllUsedRegs);
class procedure ReleaseUsedRegs(const regs : TAllUsedRegs); static; class procedure ReleaseUsedRegs(const regs : TAllUsedRegs); static;
class function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean; static; class function RegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs) : boolean; static;
class procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs); static; class procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs); static; {$ifdef USEINLINE}inline;{$endif USEINLINE}
class procedure ExcludeRegFromUsedRegs(reg: TRegister;var regs : TAllUsedRegs); static; class procedure ExcludeRegFromUsedRegs(reg: TRegister;var regs : TAllUsedRegs); static; {$ifdef USEINLINE}inline;{$endif USEINLINE}
class function GetAllocationString(const regs : TAllUsedRegs) : string; static; class function GetAllocationString(const regs : TAllUsedRegs) : string; static;
@ -433,8 +433,14 @@ Unit AoptObj;
protected protected
{ Set to True if this is the second time that Pass 1 is being run } { Set to True if this is the second time that Pass 1 is being run }
NotFirstIteration: Boolean; NotFirstIteration: Boolean;
{ Actually updates a used register }
class procedure UpdateReg(var Regs : TAllUsedRegs; p: tai_regalloc); static; {$ifdef USEINLINE}inline;{$endif USEINLINE}
private private
procedure DebugMsg(const s: string; p: tai); procedure DebugMsg(const s: string; p: tai);
{ Utilty function for the UpdateUsedRegs family of methods }
class function GetNextRegUpdatePoint(var p : Tai; pTerm: tai): Boolean; static;
End; End;
Function ArrayRefsEq(const r1, r2: TReference): Boolean; Function ArrayRefsEq(const r1, r2: TReference): Boolean;
@ -547,7 +553,7 @@ Unit AoptObj;
End; End;
Function TUsedRegs.IsUsed(Reg: TRegister): Boolean; Function TUsedRegs.IsUsed(Reg: TRegister): Boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
Begin Begin
IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs); IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
End; End;
@ -1080,30 +1086,57 @@ Unit AoptObj;
end; end;
procedure TAOptObj.UpdateUsedRegs(p : Tai); procedure TAOptObj.UpdateUsedRegs(p : Tai); {$ifdef USEINLINE}inline;{$endif USEINLINE}
begin
UpdateUsedRegs(UsedRegs, p);
end;
class function TAOptObj.GetNextRegUpdatePoint(var p : Tai; pTerm: tai): Boolean;
begin
Result := False; { Needed to suppress compiler warning }
while SetAndTest(Assigned(p) and (p <> pTerm), Result) and
((p.typ in (SkipInstr - [ait_RegAlloc])) or
((p.typ = ait_label) and
labelCanBeSkipped(tai_label(p))) or
((p.typ = ait_marker) and
(tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd])) or
(
Assigned(pTerm) and { Causes p to stop on any live label or instruction if pTerm is nil }
(p.typ in [ait_label, ait_instruction])
)
) do
p := tai(p.next);
end;
class procedure TAOptObj.UpdateReg(var Regs : TAllUsedRegs; p: tai_regalloc);
begin
case tai_regalloc(p).ratype of
ra_alloc :
Include(Regs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
ra_dealloc :
Exclude(Regs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
else
;
end;
end;
class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
begin begin
{ this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist, { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
the code is duplicated here } the code is duplicated here }
repeat repeat
while assigned(p) and if not GetNextRegUpdatePoint(p, nil) then
((p.typ in (SkipInstr - [ait_RegAlloc])) or Exit;
((p.typ = ait_label) and
labelCanBeSkipped(tai_label(p))) or
((p.typ = ait_marker) and
(tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
p := tai(p.next);
while assigned(p) and while assigned(p) and
(p.typ=ait_RegAlloc) Do (p.typ=ait_RegAlloc) Do
begin begin
prefetch(pointer(p.Next)^); prefetch(pointer(p.Next)^);
case tai_regalloc(p).ratype of UpdateReg(Regs, tai_regalloc(p));
ra_alloc :
Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
ra_dealloc :
Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
else
;
end;
p := tai(p.next); p := tai(p.next);
end; end;
until not(assigned(p)) or until not(assigned(p)) or
@ -1113,27 +1146,34 @@ Unit AoptObj;
end; end;
class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai); class procedure TAOptObj.UpdateUsedRegsBetween(var Regs: TAllUsedRegs; p1, p2: Tai);
var
i : TRegisterType;
begin begin
for i:=low(TRegisterType) to high(TRegisterType) do { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
Regs[i].Update(p); the code is duplicated here }
end; repeat
if not GetNextRegUpdatePoint(p1, p2) then
Exit;
while assigned(p1) and (p1 <> p2) and
(p1.typ=ait_RegAlloc) Do
begin
prefetch(pointer(p1.Next)^);
UpdateReg(Regs, tai_regalloc(p1));
p1 := tai(p1.next);
end;
class procedure TAOptObj.UpdateUsedRegsBetween(var Regs: TAllUsedRegs; p1, p2: Tai); static; { Only stop if either p2 or a terminating marker is reached }
var until not Assigned(p1) or (p1 = p2) or
i : TRegisterType; not (p1.typ in (SkipInstr + [ait_label, ait_instruction])) or
begin (
while (p1 <> p2) do (p1.typ = ait_marker) and
begin not (tai_Marker(p1).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd])
for i:=low(TRegisterType) to high(TRegisterType) do );
Regs[i].Update(tai(p1.Next));
if (p1 <> p2) then
{ Reached the end of the procedure or a terminating marker that wasn't p2 }
InternalError(2022010701);
if not GetNextInstruction(p1, p1) then
InternalError(2022010701);
end;
end; end;
@ -1180,21 +1220,21 @@ Unit AoptObj;
end; end;
class Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean; class Function TAOptObj.RegInUsedRegs(reg : TRegister; var regs : TAllUsedRegs) : boolean;
begin begin
result:=regs[getregtype(reg)].IsUsed(reg); result:=regs[getregtype(reg)].IsUsed(reg);
end; end;
class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister; class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
var regs: TAllUsedRegs); var regs: TAllUsedRegs); {$ifdef USEINLINE}inline;{$endif USEINLINE}
begin begin
include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg)); include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
end; end;
class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister; class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
var regs: TAllUsedRegs); var regs: TAllUsedRegs); {$ifdef USEINLINE}inline;{$endif USEINLINE}
begin begin
exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg)); exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
end; end;