+ new spilling heuristics which takes care of the usage weigth of a register,

  not yet activated, can be selected by passing SPILLING_NEW when compiling the compiler

git-svn-id: trunk@40346 -

compiler/rgobj.pas

@@ -110,6 +110,8 @@ unit rgobj;
 {$ifdef llvm}
         def      : pointer;
 {$endif llvm}
+        count_uses : longint;
+        total_interferences : longint;
       end;
       Preginfo=^TReginfo;
 
@@ -710,10 +712,10 @@ unit rgobj;
         i,j:cardinal;
 
     begin
-      assign(f,'igraph'+tostr(loopidx));
+      assign(f,current_procinfo.procdef.mangledname+'_igraph'+tostr(loopidx));
       rewrite(f);
-      writeln(f,'Interference graph');
-      writeln(f,'First imaginary register is ',first_imaginary);
+      writeln(f,'Interference graph of ',current_procinfo.procdef.fullprocname(true));
+      writeln(f,'First imaginary register is ',first_imaginary,' ($',hexstr(first_imaginary,2),')');
       writeln(f);
       write(f,'                  ');
       for i:=0 to maxreg div 16 do
@@ -726,7 +728,7 @@ unit rgobj;
       writeln(f);
       for i:=0 to maxreg-1 do
         begin
-          write(f,reginfo[i].weight:5,'  ',reginfo[i].degree:5,'  ',hexstr(i,2):4);
+          write(f,reginfo[i].weight:5,'  ',reginfo[i].degree:5,'  ',reginfo[i].count_uses:5,'  ',reginfo[i].total_interferences:5,'  ',hexstr(i,2):4);
           for j:=0 to maxreg-1 do
             if ibitmap[i,j] then
               write(f,'*')
@@ -1456,20 +1458,80 @@ unit rgobj;
       freeze_moves(n);
     end;
 
+{ The spilling approach selected by SPILLING_NEW does not work well for AVR as it eploits apparently the problem of the current
+  reg. allocator with AVR. The current reg. allocator is not aware of the fact that r1-r15 and r16-r31 are not equal on AVR }
+{$if defined(AVR)}
+{$define SPILLING_OLD}
+{$else defined(AVR)}
+{ $define SPILLING_NEW}
+{$endif defined(AVR)}
+{$ifndef SPILLING_NEW}
+{$define SPILLING_OLD}
+{$endif SPILLING_NEW}
     procedure trgobj.select_spill;
     var
       n : tsuperregister;
       adj : psuperregisterworklist;
-      max,p,i:word;
+      maxlength,p,i :word;
       minweight: longint;
+      dist,
+      maxdist: Double;
     begin
+{$ifdef SPILLING_NEW}
+      { This new approach for selecting the next spill candidate takes care of the weight of a register:
+        It spills the register with the lowest weight but only if it is expected that it results in convergence of
+        register allocation. Convergence is expected if a register is spilled where the average of the active interferences
+        - active interference means that the register is used in an instruction - is lower than
+        the degree.
+
+        Example (modify means read and the write):
+
+        modify reg1
+
+        loop:
+          modify reg2
+          modify reg3
+          modify reg4
+          modify reg5
+          modify reg6
+          modify reg7
+
+        modify reg1
+
+        In this example, all register have the same degree. However, spilling reg1 is most benefical as it is used least. Furthermore,
+        spilling reg1 is a step toward solving the coloring problem as the registers used during spilling will have a lower degree
+        as no register are in use at the location where reg1 is spilled.
+      }
+      minweight:=high(longint);
+      p:=0;
+      with spillworklist do
+        begin
+          { Safe: This procedure is only called if length<>0 }
+          for i:=0 to length-1 do
+            begin
+              adj:=reginfo[buf^[i]].adjlist;
+              dist:=adj^.length-reginfo[buf^[i]].total_interferences/reginfo[buf^[i]].count_uses;
+              if assigned(adj) and
+                (reginfo[buf^[i]].weight<minweight) and
+                (dist>=1) and
+                (reginfo[buf^[i]].weight>0) then
+                begin
+                  p:=i;
+                  minweight:=reginfo[buf^[i]].weight;
+                end;
+            end;
+          n:=buf^[p];
+          deleteidx(p);
+        end;
+{$endif SPILLING_NEW}
+{$ifdef SPILLING_OLD}
       { We must look for the element with the most interferences in the
         spillworklist. This is required because those registers are creating
         the most conflicts and keeping them in a register will not reduce the
         complexity and even can cause the help registers for the spilling code
         to get too much conflicts with the result that the spilling code
         will never converge (PFV) }
-      max:=0;
+      maxlength:=0;
       minweight:=high(longint);
       p:=0;
       with spillworklist do
@@ -1480,19 +1542,19 @@ unit rgobj;
               adj:=reginfo[buf^[i]].adjlist;
               if assigned(adj) and
                  (
-                  (adj^.length>max) or
-                  ((adj^.length=max) and (reginfo[buf^[i]].weight<minweight))
+                  (adj^.length>maxlength) or
+                  ((adj^.length=maxlength) and (reginfo[buf^[i]].weight<minweight))
                  ) then
                 begin
                   p:=i;
-                  max:=adj^.length;
+                  maxlength:=adj^.length;
                   minweight:=reginfo[buf^[i]].weight;
                 end;
             end;
           n:=buf^[p];
           deleteidx(p);
         end;
-
+{$endif SPILLING_OLD}
       simplifyworklist.add(n);
       freeze_moves(n);
     end;
@@ -1767,12 +1829,17 @@ unit rgobj;
 
 
     procedure trgobj.generate_interference_graph(list:TAsmList;headertai:tai);
+
+      procedure RecordUse(var r : Treginfo);
+        begin
+          inc(r.total_interferences,live_registers.length);
+          inc(r.count_uses);
+        end;
+
       var
         p : tai;
-{$if defined(EXTDEBUG) or defined(DEBUG_REGISTERLIFE)}
         i : integer;
-{$endif defined(EXTDEBUG) or defined(DEBUG_REGISTERLIFE)}
-        supreg : tsuperregister;
+        supreg, u: tsuperregister;
       begin
         { All allocations are available. Now we can generate the
           interference graph. Walk through all instructions, we can
@@ -1783,46 +1850,123 @@ unit rgobj;
         while assigned(p) do
           begin
             prefetch(pointer(p.next)^);
-            if p.typ=ait_regalloc then
-              with Tai_regalloc(p) do
-                begin
-                  if (getregtype(reg)=regtype) then
-                    begin
-                      supreg:=getsupreg(reg);
-                      case ratype of
-                        ra_alloc :
-                          begin
-                            live_registers.add(supreg);
+            case p.typ of
+              ait_instruction:
+                with Taicpu(p) do
+                  begin
+                    current_filepos:=fileinfo;
+                    {For speed reasons, get_alias isn't used here, instead,
+                     assign_colours will also set the colour of coalesced nodes.
+                     If there are registers with colour=0, then the coalescednodes
+                     list probably doesn't contain these registers, causing
+                     assign_colours not to do this properly.}
+                    for i:=0 to ops-1 do
+                      with oper[i]^ do
+                        case typ of
+                          top_reg:
+                             if (getregtype(reg)=regtype) then
+                               begin
+                                 u:=getsupreg(reg);
+{$ifdef EXTDEBUG}
+                                 if (u>=maxreginfo) then
+                                   internalerror(2018111701);
+{$endif}
+                                 RecordUse(reginfo[u]);
+                               end;
+                          top_ref:
+                            begin
+                              if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
+                                with ref^ do
+                                  begin
+                                    if (base<>NR_NO) and
+                                       (getregtype(base)=regtype) then
+                                      begin
+                                        u:=getsupreg(base);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111702);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+                                    if (index<>NR_NO) and
+                                       (getregtype(index)=regtype) then
+                                      begin
+                                        u:=getsupreg(index);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111703);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+{$if defined(x86)}
+                                    if (segment<>NR_NO) and
+                                       (getregtype(segment)=regtype) then
+                                      begin
+                                        u:=getsupreg(segment);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111704);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+{$endif defined(x86)}
+                                  end;
+                            end;
+{$ifdef arm}
+                          Top_shifterop:
+                            begin
+                              if regtype=R_INTREGISTER then
+                                begin
+                                  so:=shifterop;
+                                  if (so^.rs<>NR_NO) and
+                                     (getregtype(so^.rs)=regtype) then
+                                    RecordUse(reginfo[getsupreg(so^.rs)]);
+                                end;
+                            end;
+{$endif arm}
+                        end;
+                  end;
+              ait_regalloc:
+                with Tai_regalloc(p) do
+                  begin
+                    if (getregtype(reg)=regtype) then
+                      begin
+                        supreg:=getsupreg(reg);
+                        case ratype of
+                          ra_alloc :
+                            begin
+                              live_registers.add(supreg);
 {$ifdef DEBUG_REGISTERLIFE}
-                            write(live_registers.length,'  ');
-                            for i:=0 to live_registers.length-1 do
-                              write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
-                            writeln;
+                              write(live_registers.length,'  ');
+                              for i:=0 to live_registers.length-1 do
+                                write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
+                              writeln;
 {$endif DEBUG_REGISTERLIFE}
-                            add_edges_used(supreg);
-                          end;
-                        ra_dealloc :
-                          begin
-                            live_registers.delete(supreg);
+                              add_edges_used(supreg);
+                            end;
+                          ra_dealloc :
+                            begin
+                              live_registers.delete(supreg);
 {$ifdef DEBUG_REGISTERLIFE}
-                            write(live_registers.length,'  ');
-                            for i:=0 to live_registers.length-1 do
-                              write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
-                            writeln;
+                              write(live_registers.length,'  ');
+                              for i:=0 to live_registers.length-1 do
+                                write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
+                              writeln;
 {$endif DEBUG_REGISTERLIFE}
-                            add_edges_used(supreg);
-                          end;
-                        ra_markused :
-                          if (supreg<first_imaginary) then
-                            begin
-                              include(used_in_proc,supreg);
-                              has_usedmarks:=true;
+                              add_edges_used(supreg);
                             end;
+                          ra_markused :
+                            if (supreg<first_imaginary) then
+                              begin
+                                include(used_in_proc,supreg);
+                                has_usedmarks:=true;
+                              end;
+                        end;
+                        { constraints needs always to be updated }
+                        add_constraints(reg);
                       end;
-                      { constraints needs always to be updated }
-                      add_constraints(reg);
-                    end;
-                end;
+                  end;
+            end;
             add_cpu_interferences(p);
             p:=Tai(p.next);
           end;