* Prevent spilling of spill-helper registers which contain the value of a

  previously spilled register. These helper registers must never be spilled.
  This fixes failures of the register allocator in rare corner cases.

compiler/rgobj.pas

@@ -95,7 +95,7 @@ unit rgobj;
       Treginfoflag=(
         ri_coalesced,       { the register is coalesced with other register }
         ri_selected,        { the register is put to selectstack }
-        ri_spill_read,      { the register contains a value loaded from a spilled register }
+        ri_spill_helper,    { the register contains a value of a previously spilled register }
         ri_has_initial_loc  { the register has the initial memory location (e.g. a parameter in the stack) }
       );
       Treginfoflagset=set of Treginfoflag;
@@ -1621,9 +1621,9 @@ unit rgobj;
         to get too much conflicts with the result that the spilling code
         will never converge (PFV)
 
-        We need a special processing for nodes with the ri_spill_read flag set. 
-        These nodes contain a value loaded from a previously spilled node. 
-        We need to avoid another spilling of ri_spill_read nodes, since it will 
+        We need a special processing for nodes with the ri_spill_helper flag set. 
+        These nodes contain a value of a previously spilled node.
+        We need to avoid another spilling of ri_spill_helper nodes, since it will 
         likely lead to an endless loop and the register allocation will fail.
       }
       maxlength:=0;
@@ -1632,9 +1632,9 @@ unit rgobj;
       with spillworklist do
         begin
           {Safe: This procedure is only called if length<>0}
-          { Search for a candidate to be spilled, ignoring nodes with the ri_spill_read flag set. }
+          { Search for a candidate to be spilled, ignoring nodes with the ri_spill_helper flag set. }
           for i:=0 to length-1 do
-            if not(ri_spill_read in reginfo[buf^[i]].flags) then
+            if not(ri_spill_helper in reginfo[buf^[i]].flags) then
               begin
                 adj:=reginfo[buf^[i]].adjlist;
                 if assigned(adj) and
@@ -1651,10 +1651,10 @@ unit rgobj;
 
           if p=high(p) then
             begin
-              { If no normal nodes found, then only ri_spill_read nodes are present
+              { If no normal nodes found, then only ri_spill_helper nodes are present
                 in the list. Finding the node with the least interferences and
                 the least weight.
-                This allows us to put the most restricted ri_spill_read nodes
+                This allows us to put the most restricted ri_spill_helper nodes
                 to the top of selectstack so they will be the first to get
                 a color assigned.
               }
@@ -1688,63 +1688,115 @@ unit rgobj;
 
     {Assign_colours assigns the actual colours to the registers.}
 
-    var adj : Psuperregisterworklist;
-        i,j,k : cardinal;
-        n,a,c : Tsuperregister;
-        colourednodes : Tsuperregisterset;
+    var
+      colourednodes : Tsuperregisterset;
+
+      procedure reset_colours;
+        var
+          n : Tsuperregister;
+        begin
+          spillednodes.clear;
+          {Reset colours}
+          for n:=0 to maxreg-1 do
+            reginfo[n].colour:=n;
+          {Colour the cpu registers...}
+          supregset_reset(colourednodes,false,maxreg);
+          for n:=0 to first_imaginary-1 do
+            supregset_include(colourednodes,n);
+        end;
+
+    function colour_regitser(n : Tsuperregister) : boolean;
+      var
+        j,k : cardinal;
+        adj : Psuperregisterworklist;
         adj_colours:set of 0..255;
-        found : boolean;
+        a,c : Tsuperregister;
 {$if declared(RS_STACK_POINTER_REG) and (RS_STACK_POINTER_REG<>RS_INVALID)}
         tmpr: tregister;
 {$endif}
+      begin
+        {Create a list of colours that we cannot assign to n.}
+        adj_colours:=[];
+        adj:=reginfo[n].adjlist;
+        if adj<>nil then
+          for j:=0 to adj^.length-1 do
+            begin
+              a:=get_alias(adj^.buf^[j]);
+              if supregset_in(colourednodes,a) and (reginfo[a].colour<=255) then
+                include(adj_colours,reginfo[a].colour);
+            end;
+        { e.g. AVR does not have a stack pointer register }
+{$if declared(RS_STACK_POINTER_REG) and (RS_STACK_POINTER_REG<>RS_INVALID)}
+        { FIXME: temp variable r is needed here to avoid Internal error 20060521 }
+        {        while compiling the compiler. }
+        tmpr:=NR_STACK_POINTER_REG;
+        if (regtype=getregtype(tmpr)) then
+          include(adj_colours,RS_STACK_POINTER_REG);
+{$ifend}
+        {Assume a spill by default...}
+        result:=false;
+        {Search for a colour not in this list.}
+        for k:=0 to usable_registers_cnt-1 do
+          begin
+            c:=usable_registers[k];
+            if not(c in adj_colours) then
+              begin
+                reginfo[n].colour:=c;
+                result:=true;
+                supregset_include(colourednodes,n);
+                break;
+              end;
+          end;
+        if not result then
+          spillednodes.add(n);
+      end;
+
+    var
+        i,k : cardinal;
+        n : Tsuperregister;
+        spill_loop : boolean;
     begin
-      spillednodes.clear;
-      {Reset colours}
-      for n:=0 to maxreg-1 do
-        reginfo[n].colour:=n;
-      {Colour the cpu registers...}
-      supregset_reset(colourednodes,false,maxreg);
-      for n:=0 to first_imaginary-1 do
-        supregset_include(colourednodes,n);
+      reset_colours;
       {Now colour the imaginary registers on the select-stack.}
+      spill_loop:=false;
       for i:=selectstack.length downto 1 do
         begin
           n:=selectstack.buf^[i-1];
-          {Create a list of colours that we cannot assign to n.}
-          adj_colours:=[];
-          adj:=reginfo[n].adjlist;
-          if adj<>nil then
-            for j:=0 to adj^.length-1 do
-              begin
-                a:=get_alias(adj^.buf^[j]);
-                if supregset_in(colourednodes,a) and (reginfo[a].colour<=255) then
-                  include(adj_colours,reginfo[a].colour);
-              end;
-          { e.g. AVR does not have a stack pointer register }
-{$if declared(RS_STACK_POINTER_REG) and (RS_STACK_POINTER_REG<>RS_INVALID)}
-          { FIXME: temp variable r is needed here to avoid Internal error 20060521 }
-          {        while compiling the compiler. }
-          tmpr:=NR_STACK_POINTER_REG;
-          if (regtype=getregtype(tmpr)) then
-            include(adj_colours,RS_STACK_POINTER_REG);
-{$ifend}
-          {Assume a spill by default...}
-          found:=false;
-          {Search for a colour not in this list.}
-          for k:=0 to usable_registers_cnt-1 do
+          if not colour_regitser(n) and
+            (ri_spill_helper in reginfo[n].flags) then
             begin
-              c:=usable_registers[k];
-               if not(c in adj_colours) then
-                 begin
-                   reginfo[n].colour:=c;
-                   found:=true;
-                   supregset_include(colourednodes,n);
-                   break;
-                 end;
+              { Register n is a helper register which holds the value
+                of a previously spilled register. Register n must never
+                be spilled. Report the spilling loop and break. }
+              spill_loop:=true;
+              break;
             end;
-          if not found then
-            spillednodes.add(n);
         end;
+
+      if spill_loop then
+        begin
+          { Spilling loop is detected when colouring registers using the select-stack order.
+            Trying to eliminte this by using a different colouring order. }
+          reset_colours;
+          { To prevent spilling of helper registers it is needed to assign colours to them first. }
+          for i:=selectstack.length downto 1 do
+            begin
+              n:=selectstack.buf^[i-1];
+              if ri_spill_helper in reginfo[n].flags then
+                if not colour_regitser(n) then
+                  { Can't colour the spill helper register n.
+                    This can happen only when the code generator produces invalid code. }
+                  internalerror(2021091001);
+            end;
+          { Assign colours for the rest of the registers }
+          for i:=selectstack.length downto 1 do
+            begin
+              n:=selectstack.buf^[i-1];
+              if not (ri_spill_helper in reginfo[n].flags) then
+                colour_regitser(n);
+            end;
+        end;
+
       {Finally colour the nodes that were coalesced.}
       for i:=1 to coalescednodes.length do
         begin
@@ -2833,7 +2885,7 @@ unit rgobj;
                 begin
                   loadreg:=getregisterinline(list,regs.reginfo[counter].spillregconstraints);
                   do_spill_read(list,tai(loadpos.previous),spilltemplist[orgreg],loadreg,orgreg);
-                  include(reginfo[getsupreg(loadreg)].flags,ri_spill_read);
+                  include(reginfo[getsupreg(loadreg)].flags,ri_spill_helper);
                 end;
             end;
 
@@ -2871,6 +2923,7 @@ unit rgobj;
                      ssa_safe then
                     begin
                       storereg:=getregisterinline(list,regs.reginfo[counter].spillregconstraints);
+                      include(reginfo[getsupreg(storereg)].flags,ri_spill_helper);
                       { we also use loadreg for store replacements in case we
                         don't have ensure ssa -> initialise loadreg even if
                         there are no reads }