From 61ef30381cb990fa70966be237c8d57b3fdb4636 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 5 Jan 2006 17:48:11 +0000 Subject: [PATCH] * Only synchronise regvars after a loop (and only those regvars 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 - --- compiler/cgbase.pas | 13 ++++ compiler/ncgflw.pas | 44 ++++++++++++++ compiler/ncgutil.pas | 138 +++++++++++++++++++++++++++++++++++-------- 3 files changed, 170 insertions(+), 25 deletions(-) diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 98d8514876..9c74549f02 100644 --- a/compiler/cgbase.pas +++ b/compiler/cgbase.pas @@ -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 diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 0f7612b4bc..799a553e34 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -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 } diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 2cb66e5a99..bdfd7dc551 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -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