paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-07 04:50:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Only synchronise regvars after a loop (and only those regvars

Browse Source 
which are used in the loop). The compiler makes now much
    more efficient use of registers for register variables (and
    different regvars can now also share the same register if
    their live range does not overlap)

git-svn-id: trunk@2186 -
This commit is contained in:
Jonas Maebe 2006-01-05 17:48:11 +00:00
parent b769a968e3
commit 61ef30381c
3 changed files with 170 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/cgbase.pas
View File

@ -224,6 +224,7 @@ interface
destructor done;
procedure clear;
procedure add(s:tsuperregister);
function addnodup(s:tsuperregister): boolean;
function get:tsuperregister;
procedure deleteidx(i:word);
function delete(s:tsuperregister):boolean;
@ -375,6 +376,18 @@ implementation
end;
function tsuperregisterworklist.addnodup(s:tsuperregister): boolean;
begin
addnodup := false;
if indexword(buf^,length,s) = -1 then
begin
add(s);
addnodup := true;
end;
end;
procedure tsuperregisterworklist.clear;
begin

44
compiler/ncgflw.pas
View File

@ -106,6 +106,7 @@ implementation
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
oldflowcontrol : tflowcontrol;
usedregvars: tusedregvars;
begin
location_reset(location,LOC_VOID,OS_NO);
@ -157,6 +158,23 @@ implementation
maketojumpbool(exprasmlist,left,lr_load_regvars);
cg.a_label(exprasmlist,lbreak);
if (cs_regvars in aktglobalswitches) then
begin
usedregvars.intregvars.init;
usedregvars.fpuregvars.init;
usedregvars.mmregvars.init;
{ we have to synchronise both the regvars used in the loop and }
{ and the ones in the while/until condition }
get_used_regvars(self,usedregvars);
gen_sync_regvars(exprasmlist,usedregvars);
usedregvars.intregvars.done;
usedregvars.fpuregvars.done;
usedregvars.mmregvars.done;
end;
truelabel:=otlabel;
falselabel:=oflabel;
@ -338,6 +356,7 @@ implementation
count_var_is_signed,do_loopvar_at_end : boolean;
cmp_const:Tconstexprint;
oldflowcontrol : tflowcontrol;
usedregvars: tusedregvars;
begin
location_reset(location,LOC_VOID,OS_NO);
@ -676,6 +695,31 @@ implementation
{ this is the break label: }
cg.a_label(exprasmlist,aktbreaklabel);
if (cs_regvars in aktglobalswitches) then
begin
usedregvars.intregvars.init;
usedregvars.fpuregvars.init;
usedregvars.mmregvars.init;
{ We have to synchronise the loop variable and loop body. The }
{ loop end is not necessary, unless it's a register variable. }
{ The start value also doesn't matter }
{ loop var }
get_used_regvars(right,usedregvars);
{ loop body }
get_used_regvars(t2,usedregvars);
{ end value if necessary }
if (t1.location.loc = LOC_CREGISTER) then
get_used_regvars(t1,usedregvars);
gen_sync_regvars(exprasmlist,usedregvars);
usedregvars.intregvars.done;
usedregvars.fpuregvars.done;
usedregvars.mmregvars.done;
end;
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside }

138
compiler/ncgutil.pas
View File

@ -39,6 +39,23 @@ interface
type
tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
pusedregvars = ^tusedregvars;
tusedregvars = record
intregvars, fpuregvars, mmregvars: Tsuperregisterworklist;
end;
{
Not used currently, implemented because I thought we had to
synchronise around if/then/else as well, but not needed. May
still be useful for SSA once we get around to implementing
that (JM)
pusedregvarscommon = ^tusedregvarscommon;
tusedregvarscommon = record
allregvars, commonregvars, myregvars: tusedregvars;
end;
}
procedure firstcomplex(p : tbinarynode);
procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
// procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
@ -74,6 +91,17 @@ interface
procedure gen_intf_wrappers(list:taasmoutput;st:tsymtable);
procedure gen_load_vmt_register(list:taasmoutput;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
procedure get_used_regvars(n: tnode; var rv: tusedregvars);
{ adds the regvars used in n and its children to rv.allregvars,
those which were already in rv.allregvars to rv.commonregvars and
uses rv.myregvars as scratch (so that two uses of the same regvar
in a single tree to make it appear in commonregvars). Useful to
find out which regvars are used in two different node trees
(e.g. in the "else" and "then" path, or in various case blocks }
// procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
procedure gen_sync_regvars(list:TAAsmoutput; var rv: tusedregvars);
{#
Allocate the buffers for exception management and setjmp environment.
Return a pointer to these buffers, send them to the utility routine
@ -1267,18 +1295,6 @@ implementation
sym. localloc.register:=cg.getmmregister(list,sym.localloc.size);
end;
end;
{ Allocate register already, to prevent first allocation to be
inside a loop }
{$ifndef cpu64bit}
if sym.localloc.size in [OS_64,OS_S64] then
begin
cg.a_reg_sync(list,sym.localloc.register64.reglo);
cg.a_reg_sync(list,sym.localloc.register64.reghi);
end
else
{$endif cpu64bit}
cg.a_reg_sync(list,sym.localloc.register);
if cs_asm_source in aktglobalswitches then
begin
case sym.localloc.loc of
@ -2100,6 +2116,91 @@ implementation
end;
function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult;
var
rv: pusedregvars absolute arg;
begin
if (n.nodetype = loadn) and
(tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
case loc of
LOC_CREGISTER:
{$ifndef cpu64bit}
if size in [OS_64,OS_S64] then
begin
rv^.intregvars.addnodup(getsupreg(register64.reglo));
rv^.intregvars.addnodup(getsupreg(register64.reghi));
end
else
{$endif cpu64bit}
rv^.intregvars.addnodup(getsupreg(register));
LOC_CFPUREGISTER:
rv^.fpuregvars.addnodup(getsupreg(register));
LOC_CMMREGISTER:
rv^.mmregvars.addnodup(getsupreg(register));
end;
result := fen_true;
end;
procedure get_used_regvars(n: tnode; var rv: tusedregvars);
begin
foreachnodestatic(n,@do_get_used_regvars,@rv);
end;
{
See comments at declaration of pusedregvarscommon
function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult;
var
rv: pusedregvarscommon absolute arg;
begin
if (n.nodetype = loadn) and
(tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do
case loc of
LOC_CREGISTER:
{ if not yet encountered in this node tree }
if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
{ but nevertheless already encountered somewhere }
not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
{ then it's a regvar used in two or more node trees }
rv^.commonregvars.intregvars.addnodup(getsupreg(register));
LOC_CFPUREGISTER:
if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
rv^.commonregvars.intregvars.addnodup(getsupreg(register));
LOC_CMMREGISTER:
if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and
not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then
rv^.commonregvars.intregvars.addnodup(getsupreg(register));
end;
result := fen_true;
end;
procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon);
begin
rv.myregvars.intregvars.clear;
rv.myregvars.fpuregvars.clear;
rv.myregvars.mmregvars.clear;
foreachnodestatic(n,@do_get_used_regvars_common,@rv);
end;
}
procedure gen_sync_regvars(list:TAAsmoutput; var rv: tusedregvars);
var
count: longint;
begin
for count := 1 to rv.intregvars.length do
cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.get,R_SUBWHOLE));
for count := 1 to rv.fpuregvars.length do
cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.get,R_SUBWHOLE));
for count := 1 to rv.mmregvars.length do
cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.get,R_SUBWHOLE));
end;
procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
var
sym : tsym;
@ -2115,19 +2216,6 @@ implementation
for the sub procedures that can access local data
in the parent procedures }
case localloc.loc of
LOC_CREGISTER :
{$ifndef cpu64bit}
if def_cgsize(vartype.def) in [OS_64,OS_S64] then
begin
cg.a_reg_sync(list,localloc.register64.reglo);
cg.a_reg_sync(list,localloc.register64.reghi);
end
else
{$endif cpu64bit}
cg.a_reg_sync(list,localloc.register);
LOC_CFPUREGISTER,
LOC_CMMREGISTER:
cg.a_reg_sync(list,localloc.register);
LOC_REFERENCE :
begin
case st.symtabletype of