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

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

git-svn-id: trunk@2192 -

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

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;
 

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;

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

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