diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 9c74549f02..0f421a33cd 100644 --- a/compiler/cgbase.pas +++ b/compiler/cgbase.pas @@ -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 diff --git a/compiler/globtype.pas b/compiler/globtype.pas index ccf59ddf41..5fa549cb5d 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -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; diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 799a553e34..d083ed2417 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -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; diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index bdfd7dc551..e4e3e26671 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -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 diff --git a/compiler/nflw.pas b/compiler/nflw.pas index a4c2e04fd1..fbf512a521 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -973,6 +973,7 @@ implementation begin result:=nil; expectloc:=LOC_VOID; + include(current_procinfo.flags,pi_has_goto); if not(assigned(labelnode)) then begin