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

* procedures which use goto/label revert to the older and less

Browse Source 
efficient regvar allocation scheme
  * also allocate regvars before the loops, not just afterwards

git-svn-id: trunk@2192 -
This commit is contained in:
Jonas Maebe 2006-01-05 23:45:00 +00:00
parent 548a9040bc
commit ac24965242
5 changed files with 126 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/cgbase.pas
View File

@ -226,6 +226,7 @@ interface
procedure add(s:tsuperregister);
function addnodup(s:tsuperregister): boolean;
function get:tsuperregister;
function readidx(i:word):tsuperregister;
procedure deleteidx(i:word);
function delete(s:tsuperregister):boolean;
end;
@ -398,13 +399,21 @@ implementation
procedure tsuperregisterworklist.deleteidx(i:word);
begin
if length=0 then
if i>=length then
internalerror(200310144);
buf^[i]:=buf^[length-1];
dec(length);
end;
function tsuperregisterworklist.readidx(i:word):tsuperregister;
begin
if (i >= length) then
internalerror(2005010601);
result := buf^[i];
end;
function tsuperregisterworklist.get:tsuperregister;
begin

4
compiler/globtype.pas
View File

@ -242,7 +242,9 @@ than 255 characters. That's why using Ansi Strings}
i.e. not allowed for inlining from other units }
pi_uses_static_symtable,
{ set if the procedure has to push parameters onto the stack }
pi_has_stackparameter
pi_has_stackparameter,
{ set if the procedure has at least one got }
pi_has_goto
);
tprocinfoflags=set of tprocinfoflag;

123
compiler/ncgflw.pas
View File

@ -27,11 +27,14 @@ unit ncgflw;
interface
uses
aasmbase,node,nflw;
aasmbase,node,nflw,ncgutil;
type
tcgwhilerepeatnode = class(twhilerepeatnode)
procedure pass_2;override;
procedure sync_regvars(checkusedregvars: boolean);
usedregvars: tusedregvars;
end;
tcgifnode = class(tifnode)
@ -40,6 +43,9 @@ interface
tcgfornode = class(tfornode)
procedure pass_2;override;
procedure sync_regvars(checkusedregvars: boolean);
usedregvars: tusedregvars;
end;
tcgexitnode = class(texitnode)
@ -90,7 +96,6 @@ implementation
procinfo,cgbase,pass_2,parabase,
cpubase,cpuinfo,
nld,ncon,
ncgutil,
tgobj,paramgr,
regvars,
cgutils,cgobj
@ -100,13 +105,39 @@ implementation
Second_While_RepeatN
*****************************************************************************}
procedure tcgwhilerepeatnode.sync_regvars(checkusedregvars: boolean);
begin
if (cs_regvars in aktglobalswitches) and
not(pi_has_goto in current_procinfo.flags) then
begin
if checkusedregvars then
begin
usedregvars.intregvars.init;
usedregvars.fpuregvars.init;
usedregvars.mmregvars.init;
{ we have to synchronise both the regvars used in the loop }
{ and the ones in the while/until condition }
get_used_regvars(self,usedregvars);
gen_sync_regvars(exprasmlist,usedregvars);
end
else
begin
gen_sync_regvars(exprasmlist,usedregvars);
usedregvars.intregvars.done;
usedregvars.fpuregvars.done;
usedregvars.mmregvars.done;
end;
end;
end;
procedure tcgwhilerepeatnode.pass_2;
var
lcont,lbreak,lloop,
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
oldflowcontrol : tflowcontrol;
usedregvars: tusedregvars;
begin
location_reset(location,LOC_VOID,OS_NO);
@ -118,6 +149,7 @@ implementation
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
sync_regvars(true);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
@ -159,21 +191,7 @@ 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;
sync_regvars(false);
truelabel:=otlabel;
falselabel:=oflabel;
@ -241,15 +259,17 @@ implementation
{ save current asmlist (previous instructions + then-block) and }
{ loaded regvar state and create new clean ones }
{
if cs_regvars in aktglobalswitches then
begin
{ then_regvar_loaded_int := rg.regvar_loaded_int;
then_regvar_loaded_int := rg.regvar_loaded_int;
then_regvar_loaded_other := rg.regvar_loaded_other;
rg.regvar_loaded_int := org_regvar_loaded_int;
rg.regvar_loaded_other := org_regvar_loaded_other;
then_list := exprasmlist;
exprasmlist := taasmoutput.create;}
exprasmlist := taasmoutput.create;
end;
}
if assigned(t1) then
begin
@ -346,6 +366,42 @@ implementation
SecondFor
*****************************************************************************}
procedure tcgfornode.sync_regvars(checkusedregvars: boolean);
begin
if (cs_regvars in aktglobalswitches) and
not(pi_has_goto in current_procinfo.flags) then
begin
if checkusedregvars 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);
end
else
begin
gen_sync_regvars(exprasmlist,usedregvars);
usedregvars.intregvars.done;
usedregvars.fpuregvars.done;
usedregvars.mmregvars.done;
end;
end;
end;
procedure tcgfornode.pass_2;
var
l3,oldclabel,oldblabel : tasmlabel;
@ -356,7 +412,6 @@ 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);
@ -417,6 +472,7 @@ implementation
else
hcond:=OC_A;
sync_regvars(true);
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
@ -695,30 +751,7 @@ 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;
sync_regvars(false);
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;

37
compiler/ncgutil.pas
View File

@ -1295,6 +1295,22 @@ implementation
sym. localloc.register:=cg.getmmregister(list,sym.localloc.size);
end;
end;
if (pi_has_goto in current_procinfo.flags) then
begin
{ 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);
end;
if cs_asm_source in aktglobalswitches then
begin
case sym.localloc.loc of
@ -2193,11 +2209,11 @@ implementation
count: longint;
begin
for count := 1 to rv.intregvars.length do
cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.get,R_SUBWHOLE));
cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE));
for count := 1 to rv.fpuregvars.length do
cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.get,R_SUBWHOLE));
cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE));
for count := 1 to rv.mmregvars.length do
cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.get,R_SUBWHOLE));
cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE));
end;
@ -2216,6 +2232,21 @@ implementation
for the sub procedures that can access local data
in the parent procedures }
case localloc.loc of
LOC_CREGISTER :
{$ifndef cpu64bit}
if (pi_has_goto in current_procinfo.flags) then
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:
if (pi_has_goto in current_procinfo.flags) then
cg.a_reg_sync(list,localloc.register);
LOC_REFERENCE :
begin
case st.symtabletype of

1
compiler/nflw.pas
View File

@ -973,6 +973,7 @@ implementation
begin
result:=nil;
expectloc:=LOC_VOID;
include(current_procinfo.flags,pi_has_goto);
if not(assigned(labelnode)) then
begin