+ Implemented the actual register allocator

  + Scratch registers unavailable when new register allocator used
  + maybe_save/maybe_restore unavailable when new register allocator used

compiler/aasmtai.pas

@@ -435,6 +435,7 @@ interface
           procedure loadref(opidx:longint;const r:treference);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
+          function is_nop:boolean;virtual;abstract;
        end;
 
        { alignment for operator }
@@ -450,9 +451,12 @@ interface
           function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
        end;
 
+       Ttranstable=array[Tsuperregister] of Tsuperregister;
+
        taasmoutput = class(tlinkedlist)
           function getlasttaifilepos : pfileposinfo;
           procedure convert_registers;
+          procedure translate_registers(const table:Ttranstable);
        end;
 
 
@@ -1767,10 +1771,56 @@ uses
         end;
     end;
 
+    procedure Taasmoutput.translate_registers(const table:Ttranstable);
+
+    var p,q:Tai;
+        i:shortint;
+        r:Preference;
+
+    begin
+      p:=Tai(first);
+      while assigned(p) do
+        begin
+          case p.typ of
+            ait_regalloc:
+              Tai_regalloc(p).reg.number:=(Tai_regalloc(p).reg.number and $ff) or
+                                          (table[Tai_regalloc(p).reg.number shr 8] shl 8);
+            ait_instruction:
+              begin
+                for i:=0 to Taicpu_abstract(p).ops-1 do
+                  if Taicpu_abstract(p).oper[i].typ=Top_reg then
+                    Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
+                                                           (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8)
+                  else if Taicpu_abstract(p).oper[i].typ=Top_ref then
+                    begin
+                      r:=Taicpu_abstract(p).oper[i].ref;
+                      r^.base.number:=(r^.base.number and $ff) or
+                                      (table[r^.base.number shr 8] shl 8);
+                      r^.index.number:=(r^.index.number and $ff) or
+                                       (table[r^.index.number shr 8] shl 8);
+                    end;
+                if Taicpu_abstract(p).is_nop then
+                  begin
+                    q:=p;
+                    p:=Tai(p.next);
+                    remove(q);
+                    continue;
+                  end;
+              end;
+          end;
+          p:=Tai(p.next);
+        end;
+    end;
+
 end.
 {
   $Log$
-  Revision 1.21  2003-02-19 22:00:14  daniel
+  Revision 1.22  2003-04-22 10:09:34  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.21  2003/02/19 22:00:14  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

compiler/cg64f32.pas

@@ -97,7 +97,7 @@ unit cg64f32;
        globtype,globals,systems,
        cgbase,
        verbose,
-       symbase,symconst,symdef,defutil;
+       symbase,symconst,symdef,defutil,rgobj;
 
 
     function joinreg64(reglo,reghi : tregister) : tregister64;
@@ -170,7 +170,11 @@ unit cg64f32;
           internalerror(200302035);
         if (tmpref.base.number=reg.reglo.number) then
          begin
+         {$ifdef newra}
+           tmpreg:=rg.getaddressregister(list);
+         {$else}
            tmpreg := cg.get_scratch_reg_address(list);
+         {$endif}
            got_scratch:=true;
            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
            tmpref.base:=tmpreg;
@@ -181,7 +185,11 @@ unit cg64f32;
          { implementation FK                                              }
          if (tmpref.index.number=reg.reglo.number) then
           begin
+          {$ifdef newra}
+            tmpreg:=rg.getaddressregister(list);
+          {$else}
             tmpreg:=cg.get_scratch_reg_address(list);
+          {$endif}
             got_scratch:=true;
             cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
             tmpref.index:=tmpreg;
@@ -189,8 +197,13 @@ unit cg64f32;
         cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
         inc(tmpref.offset,4);
         cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
+{$ifdef newra}
+        if got_scratch then
+          rg.ungetregisterint(list,tmpreg);
+{$else}
         if got_scratch then
           cg.free_scratch_reg(list,tmpreg);
+{$endif}
       end;
 
 
@@ -399,12 +412,22 @@ unit cg64f32;
       var
         tempreg: tregister64;
       begin
+      {$ifdef newra}
+        tempreg.reghi:=rg.getregisterint(list,OS_INT);
+        tempreg.reglo:=rg.getregisterint(list,OS_INT);
+      {$else}
         tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
         tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
+      {$endif}
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_reg_reg(list,op,tempreg,reg);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tempreg.reglo);
+        rg.ungetregisterint(list,tempreg.reghi);
+      {$else}
         cg.free_scratch_reg(list,tempreg.reglo);
         cg.free_scratch_reg(list,tempreg.reghi);
+      {$endif}
       end;
 
 
@@ -412,13 +435,23 @@ unit cg64f32;
       var
         tempreg: tregister64;
       begin
+      {$ifdef newra}
+        tempreg.reghi:=rg.getregisterint(list,OS_INT);
+        tempreg.reglo:=rg.getregisterint(list,OS_INT);
+      {$else}
         tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
         tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
+      {$endif}
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_reg_reg(list,op,reg,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tempreg.reglo);
+        rg.ungetregisterint(list,tempreg.reghi);
+      {$else}
         cg.free_scratch_reg(list,tempreg.reglo);
         cg.free_scratch_reg(list,tempreg.reghi);
+      {$endif}
       end;
 
 
@@ -426,13 +459,23 @@ unit cg64f32;
       var
         tempreg: tregister64;
       begin
+      {$ifdef newra}
+        tempreg.reghi:=rg.getregisterint(list,OS_INT);
+        tempreg.reglo:=rg.getregisterint(list,OS_INT);
+      {$else}
         tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
         tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
+      {$endif}
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_const_reg(list,op,value,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tempreg.reglo);
+        rg.ungetregisterint(list,tempreg.reghi);
+      {$else}
         cg.free_scratch_reg(list,tempreg.reglo);
         cg.free_scratch_reg(list,tempreg.reghi);
+      {$endif}
       end;
 
     procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
@@ -539,7 +582,11 @@ unit cg64f32;
                end
              else
                begin
+               {$ifdef newra}
+                 hreg:=rg.getregisterint(list,OS_INT);
+               {$else}
                  hreg := cg.get_scratch_reg_int(list,OS_INT);
+               {$endif}
                  got_scratch := true;
                  a_load64high_ref_reg(list,p.location.reference,hreg);
                end;
@@ -555,8 +602,13 @@ unit cg64f32;
                  cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
                end;
              { !!! freeing of register should happen directly after compare! (JM) }
+           {$ifdef newra}
+             if got_scratch then
+               rg.ungetregisterint(list,hreg);
+           {$else}
              if got_scratch then
                cg.free_scratch_reg(list,hreg);
+           {$endif}
              { For all other values we have a range check error }
              cg.a_call_name(list,'FPC_RANGEERROR');
 
@@ -587,7 +639,11 @@ unit cg64f32;
                    end
                  else
                    begin
+                   {$ifdef newra}
+                     hreg:=rg.getregisterint(list,OS_INT);
+                   {$else}
                      hreg := cg.get_scratch_reg_int(list,OS_INT);
+                   {$endif}
                      got_scratch := true;
                      a_load64low_ref_reg(list,p.location.reference,hreg);
                    end;
@@ -595,8 +651,13 @@ unit cg64f32;
                  objectlibrary.getlabel(neglabel);
                  cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
                  { !!! freeing of register should happen directly after compare! (JM) }
+               {$ifdef newra}
+                 if got_scratch then
+                   rg.ungetregisterint(list,hreg);
+               {$else}
                  if got_scratch then
                    cg.free_scratch_reg(list,hreg);
+               {$endif}
 
                  cg.a_call_name(list,'FPC_RANGEERROR');
 
@@ -641,7 +702,11 @@ unit cg64f32;
                  end
                else
                  begin
+                 {$ifdef newra}
+                   hreg:=rg.getregisterint(list,OS_INT);
+                 {$else}
                    hreg := cg.get_scratch_reg_int(list,OS_INT);
+                 {$endif}
                    got_scratch := true;
 
                    opsize := def_cgsize(p.resulttype.def);
@@ -654,8 +719,13 @@ unit cg64f32;
                cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
 
                { !!! freeing of register should happen directly after compare! (JM) }
+             {$ifdef newra}
+               if got_scratch then
+                 rg.ungetregisterint(list,hreg);
+             {$else}
                if got_scratch then
                  cg.free_scratch_reg(list,hreg);
+             {$endif}
                cg.a_call_name(list,'FPC_RANGEERROR');
                cg.a_label(list,poslabel);
              end;
@@ -766,7 +836,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.38  2003-04-07 08:52:58  jonas
+  Revision 1.39  2003-04-22 10:09:34  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.38  2003/04/07 08:52:58  jonas
     * fixed compiling error
 
   Revision 1.37  2003/04/07 08:45:09  jonas

compiler/cgobj.pas

@@ -59,9 +59,11 @@ unit cgobj;
           sould be @link(tcg64f32) and not @var(tcg).
        }
        tcg = class
+{$ifndef newra}
           scratch_register_array_pointer : aword;
           {# List of currently unused scratch registers }
           unusedscratchregisters:Tsupregset;
+{$endif}
 
           alignment : talignment;
           {************************************************}
@@ -79,6 +81,7 @@ unit cgobj;
           {# Deallocates register r by inserting a pa_regdealloc record}
           procedure a_reg_dealloc(list : taasmoutput;r : tregister);
 
+{$ifndef newra}
           {# @abstract(Returns an int register for use as scratch register)
              This routine returns a register which can be used by
              the code generator as a general purpose scratch register.
@@ -102,6 +105,7 @@ unit cgobj;
              was previously allocated using @link(get_scratch_reg).
           }
           procedure free_scratch_reg(list : taasmoutput;r : tregister);
+{$endif newra}
           {# Pass a parameter, which is located in a register, to a routine.
 
              This routine should push/send the parameter to the routine, as
@@ -503,7 +507,9 @@ unit cgobj;
        rgobj,cutils;
 
     const
+{$ifndef newra}
       max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1;
+{$endif}
 
       { Please leave this here, this module should NOT use
         exprasmlist, the lists are always passed as arguments.
@@ -520,9 +526,11 @@ unit cgobj;
          i : longint;
 
       begin
+{$ifndef newra}
          scratch_register_array_pointer:=1;
          for i:=low(scratch_regs) to high(scratch_regs) do
            include(unusedscratchregisters,scratch_regs[i]);
+{$endif}
       end;
 
     procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
@@ -543,6 +551,7 @@ unit cgobj;
          list.concat(tai_label.create(l));
       end;
 
+{$ifndef newra}
     function tcg.get_scratch_reg_int(list:taasmoutput;size:Tcgsize):tregister;
 
       var
@@ -587,6 +596,7 @@ unit cgobj;
          include(unusedscratchregisters,r.number shr 8);
          a_reg_dealloc(list,r);
       end;
+{$endif newra}
 
 {*****************************************************************************
           for better code generation these methods should be overridden
@@ -626,20 +636,36 @@ unit cgobj;
          hr : tregister;
 
       begin
+      {$ifdef newra}
+         hr:=rg.getregisterint(list,size);
+      {$else}
          hr:=get_scratch_reg_int(list,size);
+      {$endif}
          a_load_const_reg(list,size,a,hr);
          a_param_reg(list,size,hr,locpara);
+      {$ifdef newra}
+         rg.ungetregisterint(list,hr);
+      {$else}
          free_scratch_reg(list,hr);
+      {$endif}
       end;
 
     procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
       var
          hr : tregister;
       begin
+      {$ifdef newra}
+         hr:=rg.getregisterint(list,size);
+      {$else}
          hr:=get_scratch_reg_int(list,size);
+      {$endif}
          a_load_ref_reg(list,size,r,hr);
          a_param_reg(list,size,hr,locpara);
+      {$ifdef newra}
+         rg.ungetregisterint(list,hr);
+      {$else}
          free_scratch_reg(list,hr);
+      {$endif}
       end;
 
 
@@ -664,10 +690,18 @@ unit cgobj;
       var
          hr : tregister;
       begin
+      {$ifdef newra}
+         hr:=rg.getaddressregister(list);
+      {$else newra}
          hr:=get_scratch_reg_address(list);
+      {$endif}
          a_loadaddr_ref_reg(list,r,hr);
          a_param_reg(list,OS_ADDR,hr,locpara);
+      {$ifdef newra}
+         rg.ungetregisterint(list,hr);
+      {$else}
          free_scratch_reg(list,hr);
+      {$endif}
       end;
 
 
@@ -732,7 +766,11 @@ unit cgobj;
             tmpreg := rg.getregisterint(list,size)
         else
 {$endif i386}
+{$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+{$else}
         tmpreg := get_scratch_reg_int(list,size);
+{$endif}
         a_load_ref_reg(list,size,sref,tmpreg);
         a_load_reg_ref(list,size,tmpreg,dref);
 {$ifdef i386}
@@ -745,7 +783,11 @@ unit cgobj;
           end
         else
 {$endif i386}
+{$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+{$else}
         free_scratch_reg(list,tmpreg);
+{$endif}
       end;
 
 
@@ -755,10 +797,18 @@ unit cgobj;
         tmpreg: tregister;
 
       begin
+{$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+{$else}
         tmpreg := get_scratch_reg_int(list,size);
+{$endif}
         a_load_const_reg(list,size,a,tmpreg);
         a_load_reg_ref(list,size,tmpreg,ref);
+{$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+{$else}
         free_scratch_reg(list,tmpreg);
+{$endif}
       end;
 
 
@@ -949,11 +999,19 @@ unit cgobj;
         tmpreg: tregister;
 
       begin
+      {$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+      {$else}
         tmpreg := get_scratch_reg_int(list,size);
+      {$endif}
         a_load_ref_reg(list,size,ref,tmpreg);
         a_op_const_reg(list,op,a,tmpreg);
         a_load_reg_ref(list,size,tmpreg,ref);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+      {$else}
         free_scratch_reg(list,tmpreg);
+      {$endif}
       end;
 
 
@@ -977,11 +1035,19 @@ unit cgobj;
         tmpreg: tregister;
 
       begin
+      {$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+      {$else}
         tmpreg := get_scratch_reg_int(list,size);
+      {$endif}
         a_load_ref_reg(list,size,ref,tmpreg);
         a_op_reg_reg(list,op,size,reg,tmpreg);
         a_load_reg_ref(list,size,tmpreg,ref);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+      {$else}
         free_scratch_reg(list,tmpreg);
+      {$endif}
       end;
 
 
@@ -1000,10 +1066,18 @@ unit cgobj;
             end;
           else
             begin
+            {$ifdef newra}
+              tmpreg:=rg.getregisterint(list,size);
+            {$else}
               tmpreg := get_scratch_reg_int(list,size);
+            {$endif}
               a_load_ref_reg(list,size,ref,tmpreg);
               a_op_reg_reg(list,op,size,tmpreg,reg);
+            {$ifdef newra}
+              rg.ungetregisterint(list,tmpreg);
+            {$else}
               free_scratch_reg(list,tmpreg);
+            {$endif}
             end;
         end;
       end;
@@ -1034,10 +1108,18 @@ unit cgobj;
             a_op_ref_reg(list,op,loc.size,ref,loc.register);
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
+            {$ifdef newra}
+              tmpreg:=rg.getregisterint(list,loc.size);
+            {$else}
               tmpreg := get_scratch_reg_int(list,loc.size);
+            {$endif}
               a_load_ref_reg(list,loc.size,ref,tmpreg);
               a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
+            {$ifdef newra}
+              rg.ungetregisterint(list,tmpreg);
+            {$else}
               free_scratch_reg(list,tmpreg);
+            {$endif}
             end;
           else
             internalerror(200109061);
@@ -1067,10 +1149,18 @@ unit cgobj;
         tmpreg: tregister;
 
       begin
+      {$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+      {$else}
         tmpreg := get_scratch_reg_int(list,size);
+      {$endif}
         a_load_ref_reg(list,size,ref,tmpreg);
         a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+      {$else}
         free_scratch_reg(list,tmpreg);
+      {$endif}
       end;
 
     procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
@@ -1093,10 +1183,18 @@ unit cgobj;
         tmpreg: tregister;
 
       begin
+      {$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+      {$else}
         tmpreg := get_scratch_reg_int(list,size);
+      {$endif}
         a_load_ref_reg(list,size,ref,tmpreg);
         a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+      {$else}
         free_scratch_reg(list,tmpreg);
+      {$endif}
       end;
 
     procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
@@ -1128,6 +1226,12 @@ unit cgobj;
             a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
           LOC_REFERENCE,LOC_CREFERENCE:
             begin
+{$ifdef newra}
+              tmpreg := rg.getregisterint(list,size);
+              a_load_ref_reg(list,size,loc.reference,tmpreg);
+              a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
+              rg.ungetregisterint(list,tmpreg);
+{$else newra}
 {$ifdef i386}
               { the following is done with defines to avoid a speed penalty,  }
               { since all this is only necessary for the 80x86 (because EDI   }
@@ -1145,7 +1249,8 @@ unit cgobj;
                 rg.ungetregisterint(list,tmpreg)
               else
 {$endif i386}
-              free_scratch_reg(list,tmpreg);
+                free_scratch_reg(list,tmpreg);
+{$endif newra}
             end
           else
             internalerror(200109061);
@@ -1392,8 +1497,11 @@ unit cgobj;
               if lto < 0 then
                 lto := 0;
             end;
-
+{$ifdef newra}
+        hreg:=rg.getregisterint(list,OS_INT);
+{$else}
         hreg := get_scratch_reg_int(list,OS_INT);
+{$endif}
         if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
           a_op_const_reg_reg(list,OP_SUB,def_cgsize(p.resulttype.def),
            aword(lto),p.location.register,hreg)
@@ -1406,7 +1514,11 @@ unit cgobj;
         objectlibrary.getlabel(neglabel);
         a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
         { !!! should happen right after the compare (JM) }
+{$ifdef newra}
+        rg.ungetregisterint(list,hreg);
+{$else}
         free_scratch_reg(list,hreg);
+{$endif}
         a_call_name(list,'FPC_RANGEERROR');
         a_label(list,neglabel);
       end;
@@ -1425,10 +1537,18 @@ unit cgobj;
       var
         tmpreg : tregister;
       begin
+      {$ifdef newra}
+        tmpreg:=rg.getregisterint(list,size);
+      {$else}
         tmpreg := get_scratch_reg_int(list,size);
+      {$endif}
         g_flags2reg(list,size,f,tmpreg);
         a_load_reg_ref(list,size,tmpreg,ref);
+      {$ifdef newra}
+        rg.ungetregisterint(list,tmpreg);
+      {$else}
         free_scratch_reg(list,tmpreg);
+      {$endif}
       end;
 
 
@@ -1719,7 +1839,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.81  2003-04-06 21:11:23  olle
+  Revision 1.82  2003-04-22 10:09:34  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.81  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.80  2003/03/28 19:16:56  peter

compiler/i386/aasmcpu.pas

@@ -199,6 +199,7 @@ interface
          function  NeedAddrPrefix(opidx:byte):boolean;
          procedure Swapoperands;
     {$endif NOAG386BIN}
+         function is_nop:boolean;override;
       end;
 
 
@@ -1898,6 +1899,17 @@ implementation
       end;
 {$endif NOAG386BIN}
 
+    function Taicpu.is_nop:boolean;
+
+    begin
+      {We do not check the number of operands; we assume that nobody constructs
+       a mov or xchg instruction with less than 2 operands.}
+      is_nop:=(opcode=A_NOP) or
+              (opcode=A_MOV) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and (oper[0].reg.number=oper[1].reg.number) or
+              (opcode=A_XCHG) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and (oper[0].reg.number=oper[1].reg.number);
+    end;
+
+
 {*****************************************************************************
                               Instruction table
 *****************************************************************************}
@@ -1947,7 +1959,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2003-03-26 12:50:54  armin
+  Revision 1.16  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.15  2003/03/26 12:50:54  armin
   * avoid problems with the ide in init/dome
 
   Revision 1.14  2003/03/08 08:59:07  daniel

compiler/i386/ag386nsm.pas

@@ -460,7 +460,7 @@ interface
                else
                 regstr:=std_reg2str[tai_regalloc(hp).reg.enum];
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+regstr+
+                 AsmWriteLn(#9#9+target_asm.comment+'Register '+regstr+
                    allocstr[tai_regalloc(hp).allocation]);
              end;
 
@@ -921,7 +921,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.32  2003-03-08 13:59:17  daniel
+  Revision 1.33  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.32  2003/03/08 13:59:17  daniel
     * Work to handle new register notation in ag386nsm
     + Added newra version of Ti386moddivnode
 

compiler/i386/cpubase.pas

@@ -552,8 +552,10 @@ uses
       {# Registers which are defined as scratch and no need to save across
          routine calls or in assembler blocks.
       }
+{$ifndef newra}
       max_scratch_regs = 1;
       scratch_regs : array[1..max_scratch_regs] of Tsuperregister = (RS_EDI);
+{$endif}
 
 
 {*****************************************************************************
@@ -814,7 +816,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  2003-04-21 19:16:50  peter
+  Revision 1.47  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.46  2003/04/21 19:16:50  peter
     * count address regs separate
 
   Revision 1.45  2003/03/28 19:16:57  peter

compiler/i386/n386add.pas

@@ -84,13 +84,17 @@ interface
         secondpass(left);
 
         { are too few registers free? }
+      {$ifndef newra}
         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+      {$endif newra}
         if location.loc=LOC_FPUREGISTER then
           pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
         else
           pushedfpu:=false;
         secondpass(right);
+      {$ifndef newra}
         maybe_restore(exprasmlist,left.location,pushedregs);
+      {$endif}
       end;
 
 
@@ -476,7 +480,9 @@ interface
                falselabel:=ofl;
              end;
 
+          {$ifndef newra}
             maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+          {$endif}
             isjump:=(right.location.loc=LOC_JUMP);
             if isjump then
               begin
@@ -486,7 +492,9 @@ interface
                  objectlibrary.getlabel(falselabel);
               end;
             secondpass(right);
+          {$ifndef newra}
             maybe_restore(exprasmlist,left.location,pushedregs);
+          {$endif newra}
             if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
              location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],false);
             if isjump then
@@ -1642,7 +1650,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.61  2003-04-17 10:02:48  daniel
+  Revision 1.62  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.61  2003/04/17 10:02:48  daniel
     * Tweaked register allocate/deallocate positition to less interferences
       are generated.
 

compiler/i386/n386cal.pas

@@ -146,9 +146,17 @@ implementation
         { better than an add on all processors }
         if pop_size=4 then
           begin
+          {$ifdef newra}
+            hreg:=rg.getregisterint(exprasmlist,OS_INT);
+          {$else}
             hreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+          {$endif}
             exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
+          {$ifdef newra}
+            rg.ungetregisterint(exprasmlist,hreg);
+          {$else}
             cg.free_scratch_reg(exprasmlist,hreg);
+          {$endif newra}
           end
         { the pentium has two pipes and pop reg is pairable }
         { but the registers must be different!        }
@@ -158,9 +166,17 @@ implementation
              (aktoptprocessor=ClassP5) and
              (rg.countunusedregsint>0) then
             begin
+            {$ifdef newra}
+               hreg:=rg.getregisterint(exprasmlist,OS_INT);
+            {$else}
                hreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+            {$endif}
                exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
+            {$ifdef newra}
+               rg.ungetregisterint(exprasmlist,hreg);
+            {$else}
                cg.free_scratch_reg(exprasmlist,hreg);
+            {$endif}
                hreg:=rg.getregisterint(exprasmlist,OS_INT);
                exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
                rg.ungetregisterint(exprasmlist,hreg);
@@ -185,7 +201,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.87  2003-04-04 15:38:56  peter
+  Revision 1.88  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.87  2003/04/04 15:38:56  peter
     * moved generic code from n386cal to ncgcal, i386 now also
       uses the generic ncgcal
 

compiler/i386/n386cnv.pas

@@ -117,7 +117,11 @@ implementation
                    hregister:=left.location.register;
                  else
                    begin
+                    {$ifdef newra}
+                     hregister:=rg.getregisterint(exprasmlist,OS_32);
+                    {$else}
                      hregister:=cg.get_scratch_reg_int(exprasmlist,OS_32);
+                    {$endif}
                      freereg:=true;
                      cg.a_load_reg_reg(exprasmlist,left.location.size,OS_32,left.location.register,hregister);
                    end;
@@ -126,7 +130,11 @@ implementation
            LOC_REFERENCE,
            LOC_CREFERENCE :
              begin
+              {$ifdef newra}
+               hregister:=rg.getregisterint(exprasmlist,OS_INT);
+              {$else}
                hregister:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+              {$endif newra}
                freereg:=true;
                if left.location.size in [OS_64,OS_S64] then
                 begin
@@ -147,8 +155,13 @@ implementation
 
          { for 64 bit integers, the high dword is already pushed }
          exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,hregister));
+        {$ifdef newra}
+         if freereg then
+           rg.ungetregisterint(exprasmlist,hregister);
+        {$else}
          if freereg then
            cg.free_scratch_reg(exprasmlist,hregister);
+        {$endif}
          r.enum:=R_INTREGISTER;
          r.number:=NR_ESP;
          reference_reset_base(href,r,0);
@@ -268,10 +281,18 @@ implementation
               begin
                 if left.location.size in [OS_64,OS_S64] then
                  begin
+                 {$ifdef newra}
+                   hregister:=rg.getregisterint(exprasmlist,OS_32);
+                 {$else}
                    hregister:=cg.get_scratch_reg_int(exprasmlist,OS_32);
+                 {$endif}
                    cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,left.location.registerlow,hregister);
                    cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.registerhigh,hregister);
+                 {$ifdef newra}
+                   rg.ungetregisterint(exprasmlist,hregister);
+                 {$else}
                    cg.free_scratch_reg(exprasmlist,hregister);
+                 {$endif}
                  end
                 else
                  cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
@@ -432,7 +453,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  2003-03-13 19:52:23  jonas
+  Revision 1.58  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.57  2003/03/13 19:52:23  jonas
     * and more new register allocator fixes (in the i386 code generator this
       time). At least now the ppc cross compiler can compile the linux
       system unit again, but I haven't tested it.

compiler/i386/n386inl.pas

@@ -288,10 +288,14 @@ implementation
           else
             begin
               { generate code for the element to set }
+            {$ifndef newra}
               maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
                         tcallparanode(left).left.location,pushedregs);
+            {$endif}
               secondpass(tcallparanode(tcallparanode(left).right).left);
+            {$ifndef newra}
               maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
+            {$endif}
               { determine asm operator }
               if inlinenumber=in_include_x_y then
                  asmop:=A_BTS
@@ -316,15 +320,24 @@ implementation
               else
                 begin
                   scratch_reg := TRUE;
+                {$ifdef newra}
+                  hregister:=rg.getregisterint(exprasmlist,OS_INT);
+                {$else}
                   hregister:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                {$endif newra}
                 end;
               cg.a_load_loc_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,hregister);
               if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
                 emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference)
               else
                 emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
+            {$ifdef newra}
+              if scratch_reg then
+                rg.ungetregisterint(exprasmlist,hregister);
+            {$else}
               if scratch_reg then
                 cg.free_scratch_reg(exprasmlist,hregister);
+            {$endif newra}
             end;
         end;
 
@@ -334,7 +347,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.56  2003-02-19 22:00:15  daniel
+  Revision 1.57  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.56  2003/02/19 22:00:15  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

compiler/i386/n386mat.pas

@@ -77,9 +77,7 @@ implementation
       secondpass(left);
       if codegenerror then
         exit;
-      maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
       secondpass(right);
-      maybe_restore(exprasmlist,left.location,pushedregs);
       if codegenerror then
         exit;
 
@@ -154,15 +152,22 @@ implementation
             emit_none(A_CDQ,S_NO);
 
           {Division depends on the right type.}
-          if torddef(right.resulttype.def).typ=u32bit then
+          if Torddef(right.resulttype.def).typ=u32bit then
             op:=A_DIV
           else
             op:=A_IDIV;
 
           if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
             emit_ref(op,S_L,right.location.reference)
+          else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+            emit_reg(op,S_L,right.location.register)
           else
-            emit_reg(op,S_L,right.location.register);
+            begin
+              hreg1:=rg.getregisterint(exprasmlist,right.location.size);
+              cg.a_load_loc_reg(exprasmlist,right.location,hreg1);
+              rg.ungetregisterint(exprasmlist,hreg1);
+              emit_reg(op,S_L,hreg1);
+            end;
           location_release(exprasmlist,right.location);
 
           {Copy the result into a new register. Release EAX & EDX.}
@@ -425,9 +430,13 @@ implementation
 
     begin
       secondpass(left);
+    {$ifndef newra}
       maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+    {$endif}
       secondpass(right);
+    {$ifndef newra}
       maybe_restore(exprasmlist,left.location,pushedregs);
+    {$endif newra}
 
       { determine operator }
       if nodetype=shln then
@@ -1172,7 +1181,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2003-04-21 19:15:26  peter
+  Revision 1.51  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.50  2003/04/21 19:15:26  peter
     * when ecx is not available allocated another register
 
   Revision 1.49  2003/04/17 10:02:48  daniel

compiler/i386/n386set.pas

@@ -200,9 +200,13 @@ implementation
          { Only process the right if we are not generating jumps }
          if not genjumps then
           begin
+          {$ifndef newra}
             maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+          {$endif}
             secondpass(right);
+          {$ifndef newra}
             maybe_restore(exprasmlist,left.location,pushedregs);
+          {$endif newra}
           end;
          if codegenerror then
           exit;
@@ -720,7 +724,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2003-03-13 19:52:23  jonas
+  Revision 1.52  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.51  2003/03/13 19:52:23  jonas
     * and more new register allocator fixes (in the i386 code generator this
       time). At least now the ppc cross compiler can compile the linux
       system unit again, but I haven't tested it.

compiler/i386/rgcpu.pas

@@ -329,9 +329,9 @@ unit rgcpu;
     procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference);
 
       begin
-         if ref.base.number<>NR_NO then
+         if (ref.base.number<>NR_NO) and (ref.base.number<>NR_FRAME_POINTER_REG) then
            ungetregisterint(list,ref.base);
-         if ref.index.number<>NR_NO then
+         if (ref.index.number<>NR_NO) and (ref.index.number<>NR_FRAME_POINTER_REG) then
            ungetregisterint(list,ref.index);
       end;
 
@@ -557,12 +557,17 @@ unit rgcpu;
 
 
 initialization
-  rg := trgcpu.create;
+  rg := trgcpu.create(7);   {We use 7 int registers on i386.}
 end.
 
 {
   $Log$
-  Revision 1.18  2003-04-21 19:16:50  peter
+  Revision 1.19  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.18  2003/04/21 19:16:50  peter
     * count address regs separate
 
   Revision 1.17  2003/03/28 19:16:57  peter

compiler/m68k/rgcpu.pas

@@ -210,12 +210,17 @@ unit rgcpu;
 
 
 initialization
-  rg := trgcpu.create;
+  rg := trgcpu.create(16);
 end.
 
 {
   $Log$
-  Revision 1.7  2003-02-19 22:00:16  daniel
+  Revision 1.8  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.7  2003/02/19 22:00:16  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

compiler/ncgcal.pas

@@ -171,11 +171,19 @@ implementation
                      begin
                        if calloption=pocall_inline then
                          begin
+                         {$ifdef newra}
+                           tmpreg:=rg.getaddressregister(exprasmlist);
+                         {$else}
                            tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                         {$endif newra}
                            cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
                            reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                            cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                         {$ifdef newra}
+                           rg.ungetregisterint(exprasmlist,tmpreg);
+                         {$else}
                            cg.free_scratch_reg(exprasmlist,tmpreg);
+                         {$endif}
                          end
                        else
                          cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@@ -202,11 +210,19 @@ implementation
               inc(pushedparasize,POINTER_SIZE);
               if calloption=pocall_inline then
                 begin
+                {$ifdef newra}
+                   tmpreg:=rg.getaddressregister(exprasmlist);
+                {$else}
                    tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                {$endif}
                    cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
                    reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                    cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                {$ifdef newra}
+                   rg.ungetregisterint(exprasmlist,tmpreg);
+                {$else}
                    cg.free_scratch_reg(exprasmlist,tmpreg);
+                {$endif}
                 end
               else
                 cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@@ -250,11 +266,19 @@ implementation
                    inc(pushedparasize,POINTER_SIZE);
                    if calloption=pocall_inline then
                      begin
+                     {$ifdef newra}
+                        tmpreg:=rg.getaddressregister(exprasmlist);
+                     {$else}
                         tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                     {$endif}
                         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
                         reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
                         cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                     {$ifdef newra}
+                        rg.ungetregisterint(exprasmlist,tmpreg);
+                     {$else}
                         cg.free_scratch_reg(exprasmlist,tmpreg);
+                     {$endif}
                      end
                    else
                      cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@@ -719,6 +743,14 @@ implementation
                         r.number:=NR_ACCUMULATOR;
                         hregister.enum:=R_INTREGISTER;
                         hregister.number:=NR_ACCUMULATORHIGH;
+{$ifdef newra}
+                        rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
+                        rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH);
+                        rg.ungetregisterint(exprasmlist,r);
+                        rg.ungetregisterint(exprasmlist,hregister);
+                        location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
+                        location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
+{$else newra}
                         cg.a_reg_alloc(exprasmlist,r);
                         cg.a_reg_alloc(exprasmlist,hregister);
                         if RS_ACCUMULATOR in rg.unusedregsint then
@@ -729,6 +761,7 @@ implementation
                           location.registerhigh:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH)
                         else
                           location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
+{$endif newra}
                         cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
                             location.register64);
                       end
@@ -740,11 +773,17 @@ implementation
                         nr:=RS_ACCUMULATOR shl 8 or cgsize2subreg(cgsize);
                         r.enum:=R_INTREGISTER;
                         r.number:=nr;
+{$ifdef newra}
+                        rg.getexplicitregisterint(exprasmlist,nr);
+                        rg.ungetregisterint(exprasmlist,r);
+                        location.register:=rg.getregisterint(exprasmlist,cgsize);
+{$else newra}
                         cg.a_reg_alloc(exprasmlist,r);
                         if RS_ACCUMULATOR in rg.unusedregsint then
                           location.register:=rg.getexplicitregisterint(exprasmlist,nr)
                         else
                           location.register:=rg.getregisterint(exprasmlist,cgsize);
+{$endif newra}
                         cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,r,location.register);
                       end;
                    end;
@@ -783,12 +822,18 @@ implementation
               else
                 begin
                   location_reset(location,LOC_REGISTER,OS_INT);
+                  r.enum:=R_INTREGISTER;
+                  r.number:=NR_ACCUMULATOR;
+{$ifdef newra}
+                  rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
+                  rg.ungetregisterint(exprasmlist,r);
+                  location.register:=rg.getregisterint(exprasmlist,OS_INT);
+{$else newra}
                   if RS_ACCUMULATOR in rg.unusedregsint then
                     location.register:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
                   else
                     location.register:=rg.getregisterint(exprasmlist,OS_INT);
-                  r.enum:=R_INTREGISTER;
-                  r.number:=NR_ACCUMULATOR;
+{$endif newra}
                   cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
                 end;
             end;
@@ -999,11 +1044,19 @@ implementation
                by function itself !   }
              if inlined then
                begin
+                {$ifdef newra}
+                  hregister:=rg.getaddressregister(exprasmlist);
+                {$else}
                   hregister:=cg.get_scratch_reg_address(exprasmlist);
+                {$endif}
                   cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
                   reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
+                {$ifdef newra}
+                  rg.ungetregisterint(exprasmlist,hregister);
+                {$else}
                   cg.free_scratch_reg(exprasmlist,hregister);
+                {$endif}
                end
              else
                cg.a_paramaddr_ref(exprasmlist,funcretref,paramanager.getfuncretparaloc(procdefinition));
@@ -1423,7 +1476,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-22 09:49:44  peter
+  Revision 1.48  2003-04-22 10:09:34  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.47  2003/04/22 09:49:44  peter
     * do not load self when calling a non-inherited class constructor
 
   Revision 1.46  2003/04/21 20:03:32  peter

compiler/ncginl.pas

@@ -390,10 +390,14 @@ implementation
           { second_ argument specified?, must be a s32bit in register }
           if assigned(tcallparanode(left).right) then
             begin
+            {$ifndef newra}
               maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
                  tcallparanode(left).left.location,pushedregs);
+            {$endif}
               secondpass(tcallparanode(tcallparanode(left).right).left);
+            {$ifndef newra}
               maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
+            {$endif}
               { when constant, just multiply the addvalue }
               if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
                  addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
@@ -504,13 +508,21 @@ implementation
                    (tenumdef(tcallparanode(tcallparanode(left).right).left.resulttype.def).max<=32));
 
               { generate code for the element to set }
+            {$ifndef newra}
               maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
                         tcallparanode(left).left.location,pushedregs);
+            {$endif newra}
               secondpass(tcallparanode(tcallparanode(left).right).left);
+            {$ifndef newra}
               maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
+            {$endif newra}
 
               { bitnumber - which must be loaded into register }
+            {$ifdef newra}
+              hregister:=rg.getregisterint(exprasmlist,OS_INT);
+            {$else}
               hregister := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+            {$endif}
               hregister2 := rg.getregisterint(exprasmlist,OS_INT);
 
               case tcallparanode(tcallparanode(left).right).left.location.loc of
@@ -568,7 +580,11 @@ implementation
                   }
                   { hregister contains the bitnumber (div 32 to get the correct offset) }
                   cg.a_op_const_reg(exprasmlist, OP_SHR, 5, hregister);
+              {$ifdef newra}
+                  addrreg:=rg.getaddressregister(exprasmlist);
+              {$else}
                   addrreg := cg.get_scratch_reg_address(exprasmlist);
+              {$endif}
                   { calculate the correct address of the operand }
                   cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
                   cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_INT, hregister, addrreg);
@@ -583,10 +599,17 @@ implementation
                          cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2);
                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
                        end;
-
+                {$ifdef newra}
+                  rg.ungetregisterint(exprasmlist,addrreg);
+                {$else}
                   cg.free_scratch_reg(exprasmlist, addrreg);
+                {$endif}
                 end;
+              {$ifdef newra}
+                rg.ungetregisterint(exprasmlist,hregister);
+              {$else}
                 cg.free_scratch_reg(exprasmlist,hregister);
+              {$endif}
                 rg.ungetregisterint(exprasmlist,hregister2);
             end;
         end;
@@ -646,7 +669,12 @@ end.
 
 {
   $Log$
-  Revision 1.23  2003-04-06 21:11:23  olle
+  Revision 1.24  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.23  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.22  2003/03/28 19:16:56  peter

compiler/ncgld.pas

@@ -363,10 +363,18 @@ implementation
                           rg.ungetregisterint(exprasmlist,hregister);
                           { load address of the function }
                           reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
+                        {$ifdef newra}
+                          hregister:=rg.getaddressregister(exprasmlist);
+                        {$else}
                           hregister:=cg.get_scratch_reg_address(exprasmlist);
+                        {$endif}
                           cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
                           cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
+                        {$ifdef newra}
+                          rg.ungetregisterint(exprasmlist,hregister);
+                        {$else newra}
                           cg.free_scratch_reg(exprasmlist,hregister);
+                        {$endif}
                         end;
                     end
                   else
@@ -443,12 +451,16 @@ implementation
             begin
               { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
               { can be false                                             }
+            {$ifndef newra}
               maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
+            {$endif}
               secondpass(left);
               { decrement destination reference counter }
               if (left.resulttype.def.needs_inittable) then
                cg.g_decrrefcount(exprasmlist,left.resulttype.def,left.location.reference);
+            {$ifndef newra}
               maybe_restore(exprasmlist,right.location,pushedregs);
+            {$endif newra}
               if codegenerror then
                 exit;
             end;
@@ -469,14 +481,18 @@ implementation
 
            { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
            { can be false                                             }
+          {$ifndef newra}
            maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+          {$endif newra}
            secondpass(right);
            { increment source reference counter, this is
              useless for string constants}
            if (right.resulttype.def.needs_inittable) and
               (right.nodetype<>stringconstn) then
             cg.g_incrrefcount(exprasmlist,right.resulttype.def,right.location.reference);
+          {$ifndef newra}
            maybe_restore(exprasmlist,left.location,pushedregs);
+          {$endif}
 
            if codegenerror then
              exit;
@@ -633,9 +649,13 @@ implementation
                   { generate the leftnode for the true case, and
                     release the location }
                   cg.a_label(exprasmlist,truelabel);
+                {$ifndef newra}
                   maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
+                {$endif newra}
                   secondpass(left);
+                {$ifndef newra}
                   maybe_restore(exprasmlist,right.location,pushedregs);
+                {$endif newra}
                   if codegenerror then
                     exit;
                   cg.a_load_const_loc(exprasmlist,1,left.location);
@@ -643,9 +663,13 @@ implementation
                   cg.a_jmp_always(exprasmlist,hlabel);
                   { generate the leftnode for the false case }
                   cg.a_label(exprasmlist,falselabel);
+                {$ifndef newra}
                   maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
+                {$endif}
                   secondpass(left);
+                {$ifndef newra}
                   maybe_restore(exprasmlist,right.location,pushedregs);
+                {$endif newra}
                   if codegenerror then
                     exit;
                   cg.a_load_const_loc(exprasmlist,0,left.location);
@@ -910,10 +934,18 @@ implementation
                     if vaddr then
                      begin
                        location_force_mem(exprasmlist,hp.left.location);
+                     {$ifdef newra}
+                       tmpreg:=rg.getaddressregister(exprasmlist);
+                     {$else}
                        tmpreg:=cg.get_scratch_reg_address(exprasmlist);
+                     {$endif}
                        cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
                        cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
+                     {$ifdef newra}
+                       rg.ungetregisterint(exprasmlist,tmpreg);
+                     {$else}
                        cg.free_scratch_reg(exprasmlist,tmpreg);
+                     {$endif}
                        location_release(exprasmlist,hp.left.location);
                        if freetemp then
                          location_freetemp(exprasmlist,hp.left.location);
@@ -970,7 +1002,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-06 21:11:23  olle
+  Revision 1.48  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.47  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.46  2003/03/28 19:16:56  peter

compiler/ncgmat.pas

@@ -257,9 +257,13 @@ implementation
          secondpass(left);
          if codegenerror then
           exit;
+        {$ifndef newra}
          maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+        {$endif}
          secondpass(right);
+        {$ifndef newra}
          maybe_restore(exprasmlist,left.location,pushedregs);
+        {$endif newra}
          if codegenerror then
           exit;
          location_copy(location,left.location);
@@ -350,9 +354,13 @@ implementation
       begin
          freescratch:=false;
          secondpass(left);
+      {$ifndef newra}
          maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+      {$endif newra}
          secondpass(right);
+      {$ifndef newra}
          maybe_restore(exprasmlist,left.location,pushedregs);
+      {$endif}
          { determine operator }
          case nodetype of
            shln: op:=OP_SHL;
@@ -428,15 +436,24 @@ implementation
                      begin
                        if right.location.loc<>LOC_CREGISTER then
                         location_release(exprasmlist,right.location);
+                     {$ifdef newra}
+                       hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
+                     {$else}
                        hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                     {$endif}
                        freescratch := true;
                        cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
                      end
                    else
                      hcountreg:=right.location.register;
                    cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
+                 {$ifdef newra}
+                   if freescratch then
+                      rg.ungetregisterint(exprasmlist,hcountreg);
+                 {$else}
                    if freescratch then
                       cg.free_scratch_reg(exprasmlist,hcountreg);
+                 {$endif}
                 end;
            end;
       end;
@@ -450,7 +467,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2003-03-28 19:16:56  peter
+  Revision 1.8  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.7  2003/03/28 19:16:56  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

compiler/ncgmem.pas

@@ -406,12 +406,20 @@ implementation
                   usetemp:=true;
                   if is_class_or_interface(left.resulttype.def) then
                     begin
+                    {$ifdef newra}
+                      tmpreg:=rg.getregisterint(exprasmlist,OS_INT);
+                    {$else}
                       tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                    {$endif}
                       cg.a_load_loc_reg(exprasmlist,left.location,tmpreg)
                     end
                   else
                     begin
+                    {$ifdef newra}
+                      tmpreg:=rg.getaddressregister(exprasmlist);
+                    {$else}
                       tmpreg := cg.get_scratch_reg_address(exprasmlist);
+                    {$endif newra}
                       cg.a_loadaddr_ref_reg(exprasmlist,
                         left.location.reference,tmpreg);
                     end;
@@ -444,7 +452,11 @@ implementation
                   tg.GetTemp(exprasmlist,pointer_size,tt_persistant,withreference);
                   { move to temp reference }
                   cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference);
+                {$ifdef newra}
+                  rg.ungetregisterint(exprasmlist,tmpreg);
+                {$else}
                   cg.free_scratch_reg(exprasmlist,tmpreg);
+                {$endif}
 {$ifdef GDB}
                   if (cs_debuginfo in aktmoduleswitches) then
                     begin
@@ -580,7 +592,11 @@ implementation
                  hreg:=right.location.register
                else
                  begin
+                 {$ifdef newra}
+                   hreg:=rg.getregisterint(exprasmlist,OS_INT);
+                 {$else}
                    hreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                 {$endif}
                    freereg:=true;
                    cg.a_load_loc_reg(exprasmlist,right.location,hreg);
                  end;
@@ -588,8 +604,13 @@ implementation
                objectlibrary.getlabel(poslabel);
                cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel);
                cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel);
+             {$ifdef newra}
+               if freereg then
+                 rg.ungetregisterint(exprasmlist,hreg);
+             {$else}
                if freereg then
                  cg.free_scratch_reg(exprasmlist,hreg);
+             {$endif}
                cg.a_label(exprasmlist,poslabel);
                cg.a_call_name(exprasmlist,'FPC_RANGEERROR');
                cg.a_label(exprasmlist,neglabel);
@@ -843,9 +864,13 @@ implementation
                  ofl:=falselabel;
                  objectlibrary.getlabel(falselabel);
                end;
+            {$ifndef newra}
               maybe_save(exprasmlist,right.registers32,location,pushedregs);
+            {$endif}
               secondpass(right);
+            {$ifndef newra}
               maybe_restore(exprasmlist,location,pushedregs);
+            {$endif}
 
               if cs_check_range in aktlocalswitches then
                begin
@@ -919,7 +944,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2003-04-06 21:11:23  olle
+  Revision 1.46  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.45  2003/04/06 21:11:23  olle
     * changed newasmsymbol to newasmsymboldata for data symbols
 
   Revision 1.44  2003/03/28 19:16:56  peter

compiler/ncgset.pas

@@ -110,11 +110,15 @@ implementation
        { also a second value ? }
          if assigned(right) then
            begin
+           {$ifndef newra}
              maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+           {$endif}
              secondpass(right);
              if codegenerror then
                exit;
+           {$ifndef newra}
              maybe_restore(exprasmlist,left.location,pushedregs);
+           {$endif newra}
              if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
               location_force_reg(exprasmlist,right.location,OS_32,false);
            end;
@@ -264,9 +268,13 @@ implementation
          { Only process the right if we are not generating jumps }
          if not genjumps then
           begin
+          {$ifndef newra}
             maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+          {$endif}
             secondpass(right);
+          {$ifndef newra}
             maybe_restore(exprasmlist,left.location,pushedregs);
+          {$endif}
           end;
          if codegenerror then
           exit;
@@ -312,7 +320,11 @@ implementation
             else
              begin
                { load the value in a register }
+             {$ifdef newra}
+               pleftreg:=rg.getregisterint(exprasmlist,OS_INT);
+             {$else}
                pleftreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+             {$endif}
                opsize := OS_INT;
                cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),left.location.reference,pleftreg);
              end;
@@ -340,7 +352,11 @@ implementation
                       if (left.location.loc = LOC_CREGISTER) and
                          (hr.enum <> pleftreg.enum) then
                         begin
+                        {$ifdef newra}
+                          hr:=rg.getregisterint(exprasmlist,OS_INT);
+                        {$else}
                           hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                        {$endif}
                           cg.a_op_const_reg_reg(exprasmlist,OP_SUB,opsize,setparts[i].start,pleftreg,hr);
                           pleftreg:=hr;
                           opsize := OS_INT;
@@ -388,13 +404,21 @@ implementation
              cg.a_label(exprasmlist,l3);
              case left.location.loc of
                LOC_CREGISTER :
+                {$ifdef newra}
+                 rg.ungetregisterint(exprasmlist,pleftreg);
+                {$else}
                  cg.free_scratch_reg(exprasmlist,pleftreg);
+                {$endif}
                LOC_REGISTER :
                  rg.ungetregister(exprasmlist,pleftreg);
                else
                  begin
                    reference_release(exprasmlist,left.location.reference);
+                  {$ifdef newra}
+                   rg.ungetregisterint(exprasmlist,pleftreg);
+                  {$else}
                    cg.free_scratch_reg(exprasmlist,pleftreg);
+                  {$endif}
                  end;
              end;
           end
@@ -412,7 +436,11 @@ implementation
                 begin
                   { clear the register value, indicating result is FALSE }
                   cg.a_load_const_reg(exprasmlist,OS_INT,0,location.register);
+                {$ifdef newra}
+                  hr:=rg.getregisterint(exprasmlist,OS_INT);
+                {$else}
                   hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                {$endif}
                   case right.location.loc of
                     LOC_REGISTER,
                     LOC_CREGISTER:
@@ -444,14 +472,23 @@ implementation
                      LOC_REGISTER,
                      LOC_CREGISTER:
                        begin
-                          hr3:=rg.makeregsize(left.location.register,OS_INT);
+                          hr3.enum:=R_INTREGISTER;
+                          hr3.number:=(left.location.register.number and not $ff) or R_SUBWHOLE;
                           cg.a_load_reg_reg(exprasmlist,left.location.size,OS_INT,left.location.register,hr3);
+                        {$ifdef newra}
+                          hr:=rg.getregisterint(exprasmlist,OS_INT);
+                        {$else}
                           hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                        {$endif}
                           cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,hr3,hr);
                        end;
                   else
                     begin
+                    {$ifdef newra}
+                      hr:=rg.getregisterint(exprasmlist,OS_INT);
+                    {$else}
                       hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+                    {$endif}
                       cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
                          left.location.reference,hr);
                       location_release(exprasmlist,left.location);
@@ -496,7 +533,11 @@ implementation
                        internalerror(2002032210);
                   end;
                   { free bitnumber register }
+                {$ifdef newra}
+                  rg.ungetregisterint(exprasmlist,hr);
+                {$else}
                   cg.free_scratch_reg(exprasmlist,hr);
+                {$endif}
                 end;
              end
             else
@@ -683,9 +724,17 @@ implementation
            begin
               last:=0;
               first:=true;
+            {$ifdef newra}
+              scratch_reg:=rg.getregisterint(exprasmlist,OS_INT);
+            {$else newra}
               scratch_reg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+            {$endif}
               genitem(hp);
+            {$ifdef newra}
+              rg.ungetregisterint(exprasmlist,scratch_reg);
+            {$else}
               cg.free_scratch_reg(exprasmlist,scratch_reg);
+            {$endif}
               cg.a_jmp_always(exprasmlist,elselabel);
            end;
       end;
@@ -1063,7 +1112,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2003-02-19 22:00:14  daniel
+  Revision 1.27  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.26  2003/02/19 22:00:14  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

compiler/ncgutil.pas

@@ -52,8 +52,10 @@ interface
     procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
     procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
 
+{$ifndef newra}
     procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
     procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
+{$endif}
     function  maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
 
     procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
@@ -607,6 +609,7 @@ implementation
                                   Maybe_Save
 *****************************************************************************}
 
+{$ifndef newra}
     procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
       begin
         s.saved:=false;
@@ -707,6 +710,7 @@ implementation
         end;
         tg.ungetiftemp(list,s.ref);
       end;
+{$endif newra}
 
 
     function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
@@ -1064,11 +1068,19 @@ implementation
              vs_out :
                begin
                  reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
+               {$ifdef newra}
+                 tmpreg:=rg.getaddressregister(list);
+               {$else}
                  tmpreg:=cg.get_scratch_reg_address(list);
+               {$endif}
                  cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
                  reference_reset_base(href,tmpreg,0);
                  cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
+               {$ifdef newra}
+                 rg.ungetregisterint(list,tmpreg);
+               {$else}
                  cg.free_scratch_reg(list,tmpreg);
+               {$endif newra}
                end;
            end;
          end;
@@ -1518,14 +1530,22 @@ function returns in a register and the caller receives it in an other one}
            reference_reset_base(href,procinfo.framepointer,procinfo.inheritedflag_offset);
            cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,inheriteddesctructorlabel);
            reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
+         {$ifdef newra}
+           tmpreg:=rg.getaddressregister(list);
+         {$else}
            tmpreg:=cg.get_scratch_reg_address(list);
+         {$endif}
            cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
            cg.a_param_reg(list,OS_ADDR,tmpreg,paramanager.getintparaloc(1));
            reference_reset_base(href,tmpreg,0);
            cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
            reference_reset_base(href,tmpreg,72);
            cg.a_call_ref(list,href);
+         {$ifdef newra}
+           rg.ungetregisterint(list,tmpreg);
+         {$else}
            cg.free_scratch_reg(list,tmpreg);
+         {$endif}
            cg.a_label(list,inheriteddesctructorlabel);
          end;
 
@@ -1801,11 +1821,19 @@ function returns in a register and the caller receives it in an other one}
                    cg.a_load_ref_reg(list,OS_ADDR,href,r);
                    cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
                    reference_reset_base(href,r,0);
+                 {$ifdef newra}
+                   tmpreg:=rg.getaddressregister(list);
+                 {$else newra}
                    tmpreg:=cg.get_scratch_reg_address(list);
+                 {$endif}
                    cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
                    reference_reset_base(href,tmpreg,68);
                    cg.a_call_ref(list,href);
+                 {$ifdef newra}
+                   rg.ungetregisterint(list,tmpreg);
+                 {$else}
                    cg.free_scratch_reg(list,tmpreg);
+                 {$endif}
                  end;
                 { return the self pointer }
                 cg.a_label(list,inheritedconstructorlabel);
@@ -2018,7 +2046,12 @@ function returns in a register and the caller receives it in an other one}
 end.
 {
   $Log$
-  Revision 1.84  2003-04-16 09:26:55  jonas
+  Revision 1.85  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.84  2003/04/16 09:26:55  jonas
     * assembler procedures now again get a stackframe if they have local
       variables. No space is reserved for a function result however.
       Also, the register parameters aren't automatically saved on the stack

compiler/powerpc/rgcpu.pas

@@ -70,12 +70,17 @@ unit rgcpu;
       end;
 
 initialization
-  rg := trgcpu.create;
+  rg := trgcpu.create(32);  {PPC has 32 registers.}
 end.
 
 {
   $Log$
-  Revision 1.5  2003-02-19 22:00:16  daniel
+  Revision 1.6  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.5  2003/02/19 22:00:16  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed
 

compiler/psub.pas

@@ -373,10 +373,26 @@ implementation
                 procinfo.aktproccode.insertlist(procinfo.aktentrycode);
                 procinfo.aktproccode.concatlist(procinfo.aktexitcode);
 {$ifdef newra}
-                rg.writegraph;
+{                rg.writegraph;}
 {$endif}
                 if not(cs_no_regalloc in aktglobalswitches) then
                   begin
+{$ifdef newra}
+                    {Do register allocation.}
+                    repeat
+                      rg.prepare_colouring;
+                      rg.colour_registers;
+                      rg.epilogue_colouring;
+                      {Are there spilled registers? We cannot do that yet.}
+                      if rg.spillednodes<>'' then
+                        internalerror(200304221);
+                      {if not try_fast_spill(rg) then
+                        slow_spill(rg);
+                      }
+                    until rg.spillednodes='';
+                    procinfo.aktproccode.translate_registers(rg.colour);
+                    procinfo.aktproccode.convert_registers;
+{$else newra}
                     procinfo.aktproccode.convert_registers;
 {$ifndef NoOpt}
                     if (cs_optimize in aktglobalswitches) and
@@ -384,6 +400,7 @@ implementation
                        ((procinfo.flags and pi_is_assembler)=0)  then
                       optimize(procinfo.aktproccode);
 {$endif NoOpt}
+{$endif newra}
                   end;
                 { save local data (casetable) also in the same file }
                 if assigned(procinfo.aktlocaldata) and
@@ -867,7 +884,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.98  2003-04-17 07:50:24  daniel
+  Revision 1.99  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.98  2003/04/17 07:50:24  daniel
     * Some work on interference graph construction
 
   Revision 1.97  2003/04/16 09:26:55  jonas

compiler/rgobj.pas

@@ -42,8 +42,7 @@ published by Cambridge University Press.
 Reading this book is recommended for a complete understanding. Here is a small
 introduction.
 
-The code generator thinks it has an infinite amount of registers. Our processor
-has a limited amount of registers. Therefore we must reduce the amount of
+The code generator thinks it has an infinite amount of registers. Our processorhas a limited amount of registers. Therefore we must reduce the amount of
 registers until there are less enough to fit into the processors registers.
 
 Registers can interfere or not interfere. If two imaginary registers interfere
@@ -61,7 +60,7 @@ if two registers interfere there is a connection between them in the graph.
 In addition to the imaginary registers in the code generator, the psysical
 CPU registers are also present in this graph. This allows us to make
 interferences between imaginary registers and cpu registers. This is very
-usefull for describing archtectural constrains, like for example that
+usefull for describing archtectural constraints, like for example that
 the div instruction modifies edx, so variables that are in use at that time
 cannot be stored into edx. This can be modelled by making edx interfere
 with those variables.
@@ -108,8 +107,21 @@ unit rgobj;
       end;
       Pinterferencegraph=^Tinterferencegraph;
 
+      Tmovelist=record
+        count:cardinal;
+        data:array[0..$ffff] of Tlinkedlistitem;
+      end;
+      Pmovelist=^Tmovelist;
+
+      {In the register allocator we keep track of move instructions.
+       These instructions are moved between five linked lists. There
+       is also a linked list per register to keep track about the moves
+       it is associated with. Because we need to determine quickly in 
+       which of the five lists it is we add anu enumeradtion to each 
+       move instruction.}
+
       Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves,
-                ms_worklist_moves,ms_activemoves);
+                ms_worklist_moves,ms_active_moves);
       Tmoveins=class(Tlinkedlistitem)
         moveset:Tmoveset;
         instruction:Taicpu;
@@ -129,7 +141,7 @@ unit rgobj;
           { aren't currently allocated to a regvar. The "unusedregsxxx"  }
           { contain all registers of type "xxx" that aren't currenly     }
           { allocated                                                    }
-          lastintreg:Tsuperregister;
+          lastintreg,maxintreg:Tsuperregister;
           unusedregsint,usableregsint:Tsupregset;
           unusedregsaddr,usableregsaddr:Tsupregset;
           unusedregsfpu,usableregsfpu : tregisterset;
@@ -161,12 +173,15 @@ unit rgobj;
           is_reg_var_int:Tsupregset;
           regvar_loaded: regvar_booleanarray;
           regvar_loaded_int: Tsupregset;
-
+{$ifdef newra}
+          colour:array[Tsuperregister] of Tsuperregister;
+          spillednodes:string;
+{$endif}
 
           { tries to hold the amount of times which the current tree is processed  }
           t_times: longint;
 
-          constructor create;
+          constructor create(Acpu_registers:byte);
 
           {# Allocate a general purpose register
 
@@ -245,7 +260,12 @@ unit rgobj;
           }
           procedure ungetreference(list: taasmoutput; const ref : treference); virtual;
 
-          {# Reset the register allocator information (usable registers etc) }
+          {# Reset the register allocator information (usable registers etc).
+             Please note that it is mortal sins to call cleartempgen during
+             graph colouring (that is between prepare_colouring and
+             epilogue_colouring).
+          }
+
           procedure cleartempgen;virtual;
 
           {# Convert a register to a specified register size, and return that register size }
@@ -299,13 +319,26 @@ unit rgobj;
           procedure saveUnusedState(var state: pointer);virtual;
           procedure restoreUnusedState(var state: pointer);virtual;
 {$ifdef newra}
+{$ifdef ra_debug}
           procedure writegraph;
 {$endif}
+          procedure add_move_instruction(instr:Taicpu);
+          procedure prepare_colouring;
+          procedure epilogue_colouring;
+          procedure colour_registers;
+{$endif newra}
        protected
+          cpu_registers:byte;
 {$ifdef newra}
           igraph:Tinterferencegraph;
-          movelist:array[Tsuperregister] of Tlinkedlist;
-          worklistmoves:Tlinkedlist;
+          degree:array[0..255] of byte;
+          alias:array[Tsuperregister] of Tsuperregister;
+          simplifyworklist,freezeworklist,spillworklist:string;
+          coalescednodes:string;
+          selectstack:string;
+          movelist:array[Tsuperregister] of Pmovelist;
+          worklist_moves,active_moves,frozen_moves,
+          coalesced_moves,constrained_moves:Tlinkedlist;
 {$endif}
           { the following two contain the common (generic) code for all }
           { get- and ungetregisterxxx functions/procedures              }
@@ -332,6 +365,23 @@ unit rgobj;
 {$ifdef newra}
          procedure add_edge(u,v:Tsuperregister);
          procedure add_edges_used(u:Tsuperregister);
+         procedure add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
+         function move_related(n:Tsuperregister):boolean;
+         procedure make_work_list;
+         procedure enable_moves(n:Tsuperregister);
+         procedure decrement_degree(m:Tsuperregister);
+         procedure simplify;
+
+         function get_alias(n:Tsuperregister):Tsuperregister;
+         procedure add_worklist(u:Tsuperregister);
+         function adjacent_ok(u,v:Tsuperregister):boolean;
+         function conservative(u,v:Tsuperregister):boolean;
+         procedure combine(u,v:Tsuperregister);
+         procedure coalesce;
+         procedure freeze_moves(u:Tsuperregister);
+         procedure freeze;
+         procedure select_spill;
+         procedure assign_colours;
 {$endif}
        end;
 
@@ -415,7 +465,7 @@ unit rgobj;
        globals,verbose,
        cgobj,tgobj,regvars;
 
-    constructor trgobj.create;
+    constructor Trgobj.create(Acpu_registers:byte);
 
      begin
        usedinproc := [];
@@ -423,14 +473,17 @@ unit rgobj;
        t_times := 0;
        resetusableregisters;
        lastintreg:=0;
+       maxintreg:=first_imreg;
+       cpu_registers:=Acpu_registers;
 {$ifdef TEMPREGDEBUG}
        fillchar(reg_user,sizeof(reg_user),0);
        fillchar(reg_releaser,sizeof(reg_releaser),0);
 {$endif TEMPREGDEBUG}
 {$ifdef newra}
        fillchar(igraph,sizeof(igraph),0);
+       fillchar(degree,sizeof(degree),0);
        fillchar(movelist,sizeof(movelist),0);
-       worklistmoves.create;
+       worklist_moves:=Tlinkedlist.create;
 {$endif}
      end;
 
@@ -487,6 +540,8 @@ unit rgobj;
             list.concat(Tai_regalloc.alloc(r));
             result:=r;
             lastintreg:=i;
+            if i>maxintreg then
+              maxintreg:=i;
 {$ifdef newra}
             add_edges_used(i);
 {$endif}
@@ -749,6 +804,8 @@ unit rgobj;
       countunusedregsint:=countusableregsint;
       countunusedregsfpu:=countusableregsfpu;
       countunusedregsmm:=countusableregsmm;
+      lastintreg:=0;
+      maxintreg:=first_imreg;
    {$ifdef newra}
       unusedregsint:=[0..255];
    {$else}
@@ -762,10 +819,12 @@ unit rgobj;
           if igraph.adjlist[i]<>nil then
             dispose(igraph.adjlist[i]);
           if movelist[i]<>nil then
-            movelist[i].destroy;
+            dispose(movelist[i]);
         end;
+      fillchar(movelist,sizeof(movelist),0);
       fillchar(igraph,sizeof(igraph),0);
-      worklistmoves.destroy;
+      fillchar(degree,sizeof(degree),0);
+      worklist_moves.clear;
    {$endif}
     end;
 
@@ -1224,9 +1283,15 @@ unit rgobj;
           include(igraph.bitmap[v],u);
           {Precoloured nodes are not stored in the interference graph.}
           if not(u in [first_supreg..last_supreg]) then
-            addadj(u,v);
+            begin
+              addadj(u,v);
+              inc(degree[u]);
+            end;
           if not(v in [first_supreg..last_supreg]) then
-            addadj(v,u);
+            begin
+              addadj(v,u);
+              inc(degree[v]);
+            end;
         end;
     end;
 
@@ -1240,13 +1305,18 @@ unit rgobj;
           add_edge(u,i);
     end;
 
+{$ifdef ra_debug}
     procedure Trgobj.writegraph;
 
+    {This procedure writes out the current interference graph in the
+    register allocator.}
+
+
     var f:text;
         i,j:Tsuperregister;
 
     begin
-      assign(f,'igraph');
+      assign(f,'igraph'+char(48+random(10))+char(48+random(10)));
       rewrite(f);
       writeln(f,'Interference graph');
       writeln(f);
@@ -1273,6 +1343,502 @@ unit rgobj;
     end;
 {$endif}
 
+    procedure Trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
+
+    begin
+      if movelist[u]=nil then
+        begin
+          getmem(movelist[u],64);
+          movelist[u]^.count:=0;
+        end
+      else if (movelist[u]^.count and 15)=15 then
+        reallocmem(movelist[u],(movelist[u]^.count+1)*4+64);
+      movelist[u]^.data[movelist[u]^.count]:=data;
+      inc(movelist[u]^.count);
+    end;
+
+    procedure Trgobj.add_move_instruction(instr:Taicpu);
+
+    {This procedure notifies a certain as a move instruction so the
+     register allocator can try to eliminate it.}
+
+    var i:Tmoveins;
+        ssupreg,dsupreg:Tsuperregister;
+
+    begin
+      i:=Tmoveins.create;
+      i.moveset:=ms_worklist_moves;
+      i.instruction:=instr;
+      worklist_moves.insert(i);
+      ssupreg:=instr.oper[0].reg.number shr 8;
+      add_to_movelist(ssupreg,i);
+      dsupreg:=instr.oper[1].reg.number shr 8;
+      add_to_movelist(dsupreg,i);
+    end;
+
+    function Trgobj.move_related(n:Tsuperregister):boolean;
+
+    var i:cardinal;
+
+    begin
+      move_related:=false;
+      if movelist[n]<>nil then
+        begin
+          for i:=0 to movelist[n]^.count-1 do
+            if Tmoveins(movelist[n]^.data[i]).moveset in
+               [ms_worklist_moves,ms_active_moves] then
+              begin
+                move_related:=true;
+                break;
+              end;
+        end;
+    end;
+
+    procedure Trgobj.make_work_list;
+
+    var n:Tsuperregister;
+
+    begin
+      for n:=first_imreg to maxintreg do
+        if degree[n]>cpu_registers then
+          spillworklist:=spillworklist+char(n)
+        else if move_related(n) then
+          freezeworklist:=freezeworklist+char(n)
+        else
+          simplifyworklist:=simplifyworklist+char(n);
+    end;
+
+    procedure Trgobj.prepare_colouring;
+
+    begin
+      make_work_list;
+      active_moves:=Tlinkedlist.create;
+      frozen_moves:=Tlinkedlist.create;
+      coalesced_moves:=Tlinkedlist.create;
+      constrained_moves:=Tlinkedlist.create;
+      fillchar(alias,sizeof(alias),0);
+      coalescednodes:='';
+      selectstack:='';
+    end;
+
+    procedure Trgobj.enable_moves(n:Tsuperregister);
+
+    var m:Tlinkedlistitem;
+        i:cardinal;
+
+    begin
+      if movelist[n]<>nil then
+        for i:=0 to movelist[n]^.count-1 do
+          begin 
+            m:=movelist[n]^.data[i];
+            if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
+              begin
+                if Tmoveins(m).moveset=ms_active_moves then
+                  begin
+                    {Move m from the set active_moves to the set worklist_moves.}
+                    active_moves.remove(m);
+                    Tmoveins(m).moveset:=ms_worklist_moves;
+                    worklist_moves.concat(m);
+                  end;
+              end;
+          end;
+    end;
+
+    procedure Trgobj.decrement_degree(m:Tsuperregister);
+
+    var adj:Pstring;
+        d:byte;
+        i:byte;
+        n:char;
+
+    begin
+      d:=degree[m];
+      dec(degree[m]);
+      if d=cpu_registers then
+        begin
+          {Enable moves for m.}
+          enable_moves(m);
+          {Enable moves for adjacent.}
+          adj:=igraph.adjlist[m];
+          if adj<>nil then
+            for i:=1 to length(adj^) do
+              begin
+                n:=adj^[i];
+                if (pos(n,selectstack) or pos(n,coalescednodes))=0 then
+                  enable_moves(Tsuperregister(n));
+              end;
+          {In case the node is in the spillworklist, delete it.}
+          delete(spillworklist,pos(char(m),spillworklist),1);
+          if move_related(m) then
+            freezeworklist:=freezeworklist+char(m)
+          else
+            simplifyworklist:=simplifyworklist+char(m);
+        end;
+    end;
+
+    procedure Trgobj.simplify;
+
+    var adj:Pstring;
+        i:byte;
+        m:char;
+        n:Tsuperregister;
+
+    begin
+      {We need to take a random element out of the simplifyworklist. We take
+       the last element. Dirty code!}
+      n:=Tsuperregister(simplifyworklist[byte(simplifyworklist[0])]);
+      dec(simplifyworklist[0]);
+      {Push it on the selectstack.}
+      selectstack:=selectstack+char(n);
+      adj:=igraph.adjlist[n];
+      if adj<>nil then
+        for i:=1 to length(adj^) do
+          begin
+            m:=adj^[i];
+            if (pos(m,selectstack) or pos(m,coalescednodes))=0 then
+              decrement_degree(Tsuperregister(m));
+          end;
+    end;
+
+    function Trgobj.get_alias(n:Tsuperregister):Tsuperregister;
+
+    begin
+      while pos(char(n),coalescednodes)<>0 do
+        n:=alias[n];
+      get_alias:=n;
+    end;
+
+    procedure Trgobj.add_worklist(u:Tsuperregister);
+
+    begin
+      if not(u in [first_supreg..last_supreg]) and not move_related(u) and
+         (degree[u]<cpu_registers) then
+        begin
+          delete(freezeworklist,pos(char(u),freezeworklist),1);
+          simplifyworklist:=simplifyworklist+char(u);
+        end;
+    end;
+
+    function Trgobj.adjacent_ok(u,v:Tsuperregister):boolean;
+
+    {Check wether u and v should be coalesced. u is precoloured.}
+
+      function ok(t,r:Tsuperregister):boolean;
+
+      begin
+        ok:=(degree[t]<cpu_registers) or
+            (t in [first_supreg..last_supreg]) or
+            (r in igraph.bitmap[t]);
+      end;
+
+    var adj:Pstring;
+        i:byte;
+        t:char;
+
+    begin
+      adjacent_ok:=true;
+      adj:=igraph.adjlist[v];
+      if adj<>nil then
+        for i:=1 to length(adj^) do
+          begin
+            t:=adj^[i];
+            if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
+              if not ok(Tsuperregister(t),u) then
+                begin
+                  adjacent_ok:=false;
+                  break;
+                end;
+          end;
+    end;
+
+    function Trgobj.conservative(u,v:Tsuperregister):boolean;
+
+    var adj:Pstring;
+        done:set of char; {To prevent that we count nodes twice.}
+        i,k:byte;
+        n:char;
+
+    begin
+      k:=0;
+      done:=[];
+      adj:=igraph.adjlist[u];
+      if adj<>nil then
+        for i:=1 to length(adj^) do
+          begin
+            n:=adj^[i];
+            if (pos(n,selectstack) or pos(n,coalescednodes))=0 then
+              begin
+                include(done,n);
+                if degree[Tsuperregister(n)]>=cpu_registers then
+                  inc(k);
+              end;
+          end;
+      adj:=igraph.adjlist[v];
+      if adj<>nil then
+        for i:=1 to length(adj^) do
+          begin
+            n:=adj^[i];
+            if ((pos(n,selectstack) or pos(n,coalescednodes))=0) and
+               not (n in done) and
+               (degree[Tsuperregister(n)]>=cpu_registers) then
+              inc(k);
+         end;
+      conservative:=(k<cpu_registers);
+    end;
+
+    procedure Trgobj.combine(u,v:Tsuperregister);
+
+    var add:boolean;
+        adj:Pstring;
+        i,p:byte;
+        n,o:cardinal;
+        t:char;
+
+    begin
+      p:=pos(char(v),freezeworklist);
+      if p<>0 then
+        delete(freezeworklist,p,1)
+      else
+        delete(spillworklist,pos(char(v),spillworklist),1);
+      coalescednodes:=coalescednodes+char(v);
+      alias[v]:=u;
+
+      {Combine both movelists. Since the movelists are sets, only add
+       elements that are not already present.}
+      for n:=0 to movelist[v]^.count-1 do
+        begin
+          add:=true;
+          for o:=0 to movelist[u]^.count-1 do
+            if movelist[u]^.data[o]=movelist[v]^.data[n] then
+              begin
+                add:=false;
+                break;
+              end;
+          if add then
+            add_to_movelist(u,movelist[v]^.data[n]);
+        end;
+      enable_moves(v);
+
+      adj:=igraph.adjlist[v];
+      if adj<>nil then
+        for i:=1 to length(adj^) do
+          begin
+            t:=adj^[i];
+            if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
+              begin
+                add_edge(Tsuperregister(t),u);
+                decrement_degree(Tsuperregister(t));
+              end;
+          end;
+      p:=pos(char(u),freezeworklist);
+      if (degree[u]>=cpu_registers) and (p<>0) then
+        begin
+          delete(freezeworklist,p,1);
+          spillworklist:=spillworklist+char(u);
+        end;
+    end;
+
+    procedure Trgobj.coalesce;
+
+    var m:Tmoveins;
+        x,y,u,v:Tsuperregister;
+
+    begin
+      m:=Tmoveins(worklist_moves.getfirst);
+      x:=get_alias(m.instruction.oper[0].reg.number shr 8);
+      y:=get_alias(m.instruction.oper[1].reg.number shr 8);
+      if y in [first_supreg..last_supreg] then
+        begin
+          u:=y;
+          v:=x;
+        end
+      else
+        begin
+          u:=x;
+          v:=y;
+        end;
+      if (u=v) then
+        begin
+          m.moveset:=ms_coalesced_moves;  {Already coalesced.}
+          coalesced_moves.insert(m);
+          add_worklist(u);
+        end
+      {Do u and v interfere? In that case the move is constrained. Two
+       precoloured nodes interfere allways. If v is precoloured, by the above
+       code u is precoloured, thus interference...}
+      else if (v in [first_supreg..last_supreg]) or (u in igraph.bitmap[v]) then
+        begin
+          m.moveset:=ms_constrained_moves;  {Cannot coalesce yet...}
+          constrained_moves.insert(m);
+          add_worklist(u);
+          add_worklist(v);
+        end
+      {Next test: is it possible and a good idea to coalesce??}
+      else if ((u in [first_supreg..last_supreg]) and adjacent_ok(u,v)) or
+              (not(u in [first_supreg..last_supreg]) and conservative(u,v)) then
+        begin
+          m.moveset:=ms_coalesced_moves;  {Move coalesced!}
+          coalesced_moves.insert(m);
+          combine(u,v);
+          add_worklist(u);
+        end
+      else
+        begin
+          m.moveset:=ms_active_moves;
+          active_moves.insert(m);
+        end;
+    end;
+
+    procedure Trgobj.freeze_moves(u:Tsuperregister);
+
+    var i:cardinal;
+        m:Tlinkedlistitem;
+        v,x,y:Tsuperregister;
+
+    begin
+      for i:=0 to movelist[u]^.count-1 do
+        begin
+          m:=movelist[u]^.data[i];
+          if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
+            begin
+              x:=Tmoveins(m).instruction.oper[0].reg.number shr 8;
+              y:=Tmoveins(m).instruction.oper[1].reg.number shr 8;
+              if get_alias(y)=get_alias(u) then
+                v:=get_alias(x)
+              else
+                v:=get_alias(y);
+              {Move m from active_moves/worklist_moves to frozen_moves.}
+              if Tmoveins(m).moveset=ms_active_moves then
+                active_moves.remove(m)
+              else
+                worklist_moves.remove(m);
+              Tmoveins(m).moveset:=ms_frozen_moves;
+              frozen_moves.insert(m);
+        
+              if not(move_related(v)) and (degree[v]<cpu_registers) then
+                begin
+                  delete(freezeworklist,pos(char(v),freezeworklist),1);
+                  simplifyworklist:=simplifyworklist+char(v);
+                end;
+            end;
+        end;
+    end;
+
+    procedure Trgobj.freeze;
+
+    var n:Tsuperregister;
+
+    begin
+      {We need to take a random element out of the freezeworklist. We take
+       the last element. Dirty code!}
+      n:=Tsuperregister(freezeworklist[byte(freezeworklist[0])]);
+      dec(freezeworklist[0]);
+      {Add it to the simplifyworklist.}
+      simplifyworklist:=simplifyworklist+char(n);
+      freeze_moves(n);
+    end;
+
+    procedure Trgobj.select_spill;
+
+    var n:char;
+
+    begin
+      {This code is WAY too naive. We need not to select just a register, but
+       the register that is used the least...}
+      n:=spillworklist[byte(spillworklist[0])];
+      dec(spillworklist[0]);
+      simplifyworklist:=simplifyworklist+n;
+      freeze_moves(Tsuperregister(n));
+    end;
+
+    procedure Trgobj.assign_colours;
+
+    {Assign_colours assigns the actual colours to the registers.}
+
+    var adj:Pstring;
+        i,j,k:byte;
+        n,a:Tsuperregister;
+        adj_colours,colourednodes:set of Tsuperregister;
+        w:char;
+
+    begin
+      spillednodes:='';
+      {Colour the cpu registers...}
+      colourednodes:=[first_supreg..last_supreg];
+      for i:=first_supreg to last_supreg do
+        colour[i]:=i;
+      {Now colour the imaginary registers on the select-stack.}
+      for i:=length(selectstack) downto 1 do
+        begin
+          n:=Tsuperregister(selectstack[i]);
+          {Create a list of colours that we cannot assign to n.}
+          adj_colours:=[];
+          adj:=igraph.adjlist[n];
+          if adj<>nil then
+            for j:=1 to length(adj^) do
+              begin
+                w:=adj^[j];
+                a:=get_alias(Tsuperregister(w));
+                if a in colourednodes then
+                  include(adj_colours,colour[a]);
+              end;
+          {Assume a spill by default...}
+          spillednodes:=spillednodes+char(n);
+          {Search for a colour not in this list.}
+          for k:=1 to cpu_registers do
+            if not(k in adj_colours) then
+              begin
+                colour[n]:=k;
+                dec(spillednodes[0]);  {Colour found: no spill.}
+                include(colourednodes,n);
+                break;
+              end;
+        end;
+      {Finally colour the nodes that were coalesced.}
+      for i:=1 to length(coalescednodes) do
+        begin
+          n:=Tsuperregister(coalescednodes[i]);
+          colour[n]:=colour[get_alias(n)];
+        end;
+      for i:=first_imreg to maxintreg do
+        writeln(i:4,'   ',colour[i]:4)
+    end;
+
+    procedure Trgobj.colour_registers;
+
+    begin
+      repeat
+        if length(simplifyworklist)<>0 then
+          simplify
+        else if not(worklist_moves.empty) then
+          coalesce
+        else if length(freezeworklist)<>0 then
+          freeze
+        else if length(spillworklist)<>0 then
+          select_spill;
+      until (length(simplifyworklist) or
+             byte(not(worklist_moves.empty)) or
+             length(freezeworklist) or
+             length(spillworklist)
+            )=0;
+      assign_colours;
+    end;
+
+    procedure Trgobj.epilogue_colouring;
+
+    begin
+      active_moves.destroy;
+      active_moves:=nil;
+      frozen_moves.destroy;
+      frozen_moves:=nil;
+      coalesced_moves.destroy;
+      coalesced_moves:=nil;
+      constrained_moves.destroy;
+      constrained_moves:=nil;
+    end;
+
+{$endif newra}
+
 
 {****************************************************************************
                                   TReference
@@ -1403,7 +1969,12 @@ end.
 
 {
   $Log$
-  Revision 1.35  2003-04-21 19:16:49  peter
+  Revision 1.36  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.35  2003/04/21 19:16:49  peter
     * count address regs separate
 
   Revision 1.34  2003/04/17 16:48:21  daniel

compiler/sparc/rgcpu.pas

@@ -66,11 +66,16 @@ procedure trgcpu.UngetRegisterInt(list:taasmoutput;reg:tregister);
       inherited ungetregisterint(list,reg);
   end;
 begin
-  rg := trgcpu.create;
+  rg := trgcpu.create(24); {24 registers.}
 end.
 {
   $Log$
-  Revision 1.8  2003-03-15 22:51:58  mazen
+  Revision 1.9  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.8  2003/03/15 22:51:58  mazen
   * remaking sparc rtl compile
 
   Revision 1.7  2003/03/10 21:59:54  mazen

compiler/x86/cgx86.pas

@@ -363,13 +363,24 @@ unit cgx86;
           OS_8,OS_S8,
           OS_16,OS_S16:
             begin
+            {$ifdef newra}
+              if target_info.alignment.paraalign = 2 then
+                tmpreg:=rg.getregisterint(list,OS_16)
+              else
+                tmpreg:=rg.getregisterint(list,OS_32);
+            {$else}
               if target_info.alignment.paraalign = 2 then
                 tmpreg:=get_scratch_reg_int(list,OS_16)
               else
                 tmpreg:=get_scratch_reg_int(list,OS_32);
+            {$endif}
               a_load_ref_reg(list,size,r,tmpreg);
               list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
+            {$ifdef newra}
+              rg.ungetregisterint(list,tmpreg);
+            {$else}
               free_scratch_reg(list,tmpreg);
+            {$endif}
             end;
           OS_32,OS_S32:
             list.concat(taicpu.op_ref(A_PUSH,S_L,r));
@@ -405,10 +416,18 @@ unit cgx86;
           list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
         else
           begin
+          {$ifdef newra}
+            tmpreg:=rg.getaddressregister(list);
+          {$else}
             tmpreg := get_scratch_reg_address(list);
+          {$endif}
             a_loadaddr_ref_reg(list,r,tmpreg);
             list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
+          {$ifdef newra}
+            rg.ungetregisterint(list,tmpreg);
+          {$else}
             free_scratch_reg(list,tmpreg);
+          {$endif}
           end;
       end;
 
@@ -780,7 +799,9 @@ unit cgx86;
           regloadsize: tcgsize;
           dstsize: topsize;
           tmpreg : tregister;
+    {$ifndef newra}
           popecx : boolean;
+    {$endif}
           r:Tregister;
           instr:Taicpu;
 
@@ -805,6 +826,13 @@ unit cgx86;
               internalerror(200109233);
             OP_SHR,OP_SHL,OP_SAR:
               begin
+              {$ifdef newra}
+                tmpreg:=rg.getexplicitregisterint(list,NR_CL);
+                a_load_reg_reg(list,size,OS_8,dst,tmpreg);
+                list.concat(taicpu.op_reg_reg(Topcg2asmop[op],S_B,src,
+                            tmpreg));
+                rg.ungetregisterint(list,tmpreg);
+              {$else newra}
                 tmpreg.enum:=R_INTREGISTER;
                 tmpreg.number:=NR_NO;
                 popecx := false;
@@ -821,8 +849,6 @@ unit cgx86;
                         regloadsize:=OS_32;
                     end;
                     tmpreg := get_scratch_reg_int(list,OS_INT);
-                    tmpreg.enum:=R_INTREGISTER;
-                    tmpreg.number:=NR_EDI;
                     a_load_reg_reg(list,regloadsize,regloadsize,src,tmpreg);
                   end;
                 if src.number shr 8<>RS_ECX then
@@ -862,16 +888,13 @@ unit cgx86;
                   list.concat(taicpu.op_reg(A_POP,S_L,r))
                 else if not (dst.number shr 8=RS_ECX) then
                   rg.ungetregisterint(list,r);
+              {$endif newra}
               end;
             else
               begin
                 if reg2opsize(src) <> dstsize then
                   internalerror(200109226);
                 instr:=taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,src,dst);
-{$ifdef newra}
-                if op in [_MOV,_XCHG] then
-                  rg.add_move_instruction(instr);
-{$endif newra}
                 list.concat(instr);
               end;
           end;
@@ -1839,7 +1862,12 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.38  2003-04-17 16:48:21  daniel
+  Revision 1.39  2003-04-22 10:09:35  daniel
+    + Implemented the actual register allocator
+    + Scratch registers unavailable when new register allocator used
+    + maybe_save/maybe_restore unavailable when new register allocator used
+
+  Revision 1.38  2003/04/17 16:48:21  daniel
     * Added some code to keep track of move instructions in register
       allocator