* Register allocator finished

compiler/aasmtai.pas

@@ -178,6 +178,8 @@ interface
        { Buffer type used for alignment }
        tfillbuffer = array[0..63] of char;
 
+       Tspill_temp_list=array[0..255] of Treference;
+
        { abstract assembler item }
        tai = class(TLinkedListItem)
 {$ifndef NOOPT}
@@ -402,6 +404,11 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
 
+      Taasmoutput=class;
+
+      Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
+      Trgungetproc=procedure(list:Taasmoutput;position:Tai;const r:Tregister) of object;
+
        { Class template for assembler instructions
        }
        taicpu_abstract = class(tailineinfo)
@@ -436,6 +443,13 @@ interface
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
           function is_nop:boolean;virtual;abstract;
+          function is_move:boolean;virtual;abstract;
+          function spill_registers(list:Taasmoutput;
+                                   rgget:Trggetproc;
+                                   rgunget:Trgungetproc;
+                                   r:Tsupregset;
+                                   var unusedregsint:Tsupregset;
+                                   const spilltemplist:Tspill_temp_list):boolean;virtual;abstract;
        end;
 
        { alignment for operator }
@@ -1635,13 +1649,13 @@ uses
 
 
     procedure taicpu_abstract.derefimpl;
-      var
-        i : integer;
-      begin
-        for i:=1 to ops do
-          ppuderefoper(oper[i-1]);
-      end;
 
+    var i:byte;
+
+    begin
+      for i:=1 to ops do
+        ppuderefoper(oper[i-1]);
+    end;
 
 {****************************************************************************
                               tai_align_abstract
@@ -1816,7 +1830,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.28  2003-05-12 18:13:57  peter
+  Revision 1.29  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.28  2003/05/12 18:13:57  peter
     * create rtti label using newasmsymboldata and update binding
       only when calling tai_symbol.create
     * tai_symbol.create_global added

compiler/cg64f32.pas

@@ -50,10 +50,10 @@ unit cg64f32;
         procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
         procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
-        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
-        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
+        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});override;
+        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});override;
         procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
-        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
+        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete: boolean{$endif});override;
         procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
         procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
         procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
@@ -97,7 +97,7 @@ unit cg64f32;
        globtype,globals,systems,
        cgbase,
        verbose,
-       symbase,symconst,symdef,defutil,rgobj;
+       symbase,symconst,symdef,defutil,rgobj,tgobj;
 
 
     function joinreg64(reglo,reghi : tregister) : tregister64;
@@ -150,7 +150,7 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
+    procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});
       var
         tmpreg: tregister;
         tmpref: treference;
@@ -164,10 +164,6 @@ unit cg64f32;
           end;
         got_scratch:=false;
         tmpref := ref;
-        if tmpref.base.enum<>R_INTREGISTER then
-          internalerror(200302035);
-        if reg.reglo.enum<>R_INTREGISTER then
-          internalerror(200302035);
         if (tmpref.base.number=reg.reglo.number) then
          begin
          {$ifdef newra}
@@ -196,6 +192,13 @@ unit cg64f32;
           end;
         cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
         inc(tmpref.offset,4);
+{$ifdef newra}
+        if delete then
+          begin
+            tg.ungetiftemp(list,tmpref);
+            reference_release(list,tmpref);
+          end;
+{$endif}
         cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
 {$ifdef newra}
         if got_scratch then
@@ -207,10 +210,18 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
+    procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});
 
       begin
+      {$ifdef newra}
+        if delete then
+          rg.ungetregisterint(list,regsrc.reglo);
+      {$endif}
         cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
+      {$ifdef newra}
+        if delete then
+          rg.ungetregisterint(list,regsrc.reghi);
+      {$endif}
         cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
       end;
 
@@ -221,14 +232,14 @@ unit cg64f32;
         cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
       end;
 
-    procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
+    procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete :boolean{$endif});
 
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_ref_reg(list,l.reference,reg);
+            a_load64_ref_reg(list,l.reference,reg{$ifdef newra},delete{$endif});
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,l.register64,reg);
+            a_load64_reg_reg(list,l.register64,reg{$ifdef newra},delete{$endif});
           LOC_CONSTANT :
             a_load64_const_reg(list,l.valueqword,reg);
           else
@@ -271,7 +282,7 @@ unit cg64f32;
           LOC_REFERENCE, LOC_CREFERENCE:
             a_load64_reg_ref(list,reg,l.reference);
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,reg,l.register64);
+            a_load64_reg_reg(list,reg,l.register64{$ifdef newra},false{$endif});
           else
             internalerror(200112293);
         end;
@@ -419,7 +430,7 @@ unit cg64f32;
         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_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
         a_op64_reg_reg(list,op,tempreg,reg);
       {$ifdef newra}
         rg.ungetregisterint(list,tempreg.reglo);
@@ -442,7 +453,7 @@ unit cg64f32;
         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_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
         a_op64_reg_reg(list,op,reg,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
       {$ifdef newra}
@@ -466,7 +477,7 @@ unit cg64f32;
         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_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
         a_op64_const_reg(list,op,value,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
       {$ifdef newra}
@@ -898,7 +909,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2003-06-01 21:38:06  peter
+  Revision 1.46  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.45  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/cgobj.pas

@@ -437,10 +437,10 @@ unit cgobj;
         procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
         procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
-        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
-        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
+        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
+        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
         procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
-        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
+        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
         procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
         procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
         procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
@@ -1172,10 +1172,10 @@ unit cgobj;
         else
           begin
 {$ifdef newra}
-            tmpreg := rg.getregisterint(list);
-            a_load_reg_reg(list,size,src2,tmpreg);
+            tmpreg := rg.getregisterint(list,size);
+            a_load_reg_reg(list,size,size,src2,tmpreg);
             a_op_reg_reg(list,op,size,src1,tmpreg);
-            a_load_reg_reg,tmpreg,dst);
+            a_load_reg_reg(list,size,size,tmpreg,dst);
             rg.ungetregisterint(list,tmpreg);
 {$else newra}
             internalerror(200305011);
@@ -1691,14 +1691,14 @@ unit cgobj;
     procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;
        regsrc,regdst : tregister64);
       begin
-        a_load64_reg_reg(list,regsrc,regdst);
+        a_load64_reg_reg(list,regsrc,regdst{$ifdef newra},false{$endif});
         a_op64_const_reg(list,op,value,regdst);
       end;
 
 
     procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
       begin
-        a_load64_reg_reg(list,regsrc2,regdst);
+        a_load64_reg_reg(list,regsrc2,regdst{$ifdef newra},false{$endif});
         a_op64_reg_reg(list,op,regsrc1,regdst);
       end;
 
@@ -1712,7 +1712,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.105  2003-06-01 21:38:06  peter
+  Revision 1.106  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.105  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/i386/ag386nsm.pas

@@ -384,7 +384,7 @@ interface
       found,
       do_line,
       quoted   : boolean;
-      regstr:string[5];
+      regstr:string[6];
     begin
       if not assigned(p) then
        exit;
@@ -926,7 +926,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.34  2003-05-26 19:37:57  peter
+  Revision 1.35  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.34  2003/05/26 19:37:57  peter
     * don't generate align in .bss
 
   Revision 1.33  2003/04/22 10:09:35  daniel

compiler/i386/cpubase.inc

@@ -147,7 +147,10 @@
 
       {# Stack pointer register }
       NR_STACK_POINTER_REG = NR_ESP;
+      RS_STACK_POINTER_REG = RS_ESP;
       {# Frame pointer register }
+      frame_pointer_reg = R_EBP;
+      RS_FRAME_POINTER_REG = RS_EBP;
       NR_FRAME_POINTER_REG = NR_EBP;
       {# Register for addressing absolute data in a position independant way,
          such as in PIC code. The exact meaning is ABI specific. For
@@ -202,7 +205,10 @@
 
 {
   $Log$
-  Revision 1.5  2003-05-31 15:05:28  peter
+  Revision 1.6  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.5  2003/05/31 15:05:28  peter
     * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
 
   Revision 1.4  2003/05/30 23:57:08  peter

compiler/i386/n386add.pas

@@ -350,7 +350,13 @@ interface
 
       var
         cmpop      : boolean;
+      {$ifdef newra}
+        r          : Tregister;
+        i          : Tsuperregister;
+      {$else}
         pushed     : Tpushedsavedint;
+      {$endif}
+        regstopush : Tsupregset;
       begin
         { string operations are not commutative }
         if nf_swaped in flags then
@@ -362,16 +368,37 @@ interface
                    ltn,lten,gtn,gten,equaln,unequaln :
                      begin
                        cmpop := true;
+                     {$ifndef newra}
                        rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+                     {$endif newra}
                        secondpass(left);
                        location_release(exprasmlist,left.location);
                        cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
                        secondpass(right);
                        location_release(exprasmlist,right.location);
                        cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
-                       rg.saveintregvars(exprasmlist,all_intregisters);
+                      {$ifdef newra}
+                        r.enum:=R_INTREGISTER;
+                        for i:=first_supreg to last_supreg do
+                          if i<>RS_FRAME_POINTER_REG then
+                            begin
+                              r.number:=i shl 8 or R_SUBWHOLE;
+                              rg.getexplicitregisterint(exprasmlist,r.number);
+                            end;
+                      {$else}
+                        rg.saveintregvars(exprasmlist,regstopush);
+                      {$endif}
                        cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
-                       rg.restoreusedintregisters(exprasmlist,pushed);
+                      {$ifdef newra}
+                        for i:=first_supreg to last_supreg do
+                          if i<>RS_FRAME_POINTER_REG then
+                            begin
+                              r.number:=i shl 8 or R_SUBWHOLE;
+                              rg.ungetregisterint(exprasmlist,r);
+                            end;
+                      {$else}
+                        rg.restoreusedintregisters(exprasmlist,pushed);
+                      {$endif}
                        location_freetemp(exprasmlist,left.location);
                        location_freetemp(exprasmlist,right.location);
                      end;
@@ -820,7 +847,7 @@ interface
         pushedfpu,
         mboverflow,
         cmpop,
-        unsigned   : boolean;
+        unsigned,delete:boolean;
         r:Tregister;
 
       procedure firstjmp64bitcmp;
@@ -944,14 +971,22 @@ interface
               { we can reuse a CREGISTER for comparison }
               if not((left.location.loc=LOC_CREGISTER) and cmpop) then
                begin
+               {$ifdef newra}
+                 delete:=left.location.loc<>LOC_CREGISTER;
+               {$else}
                  if (left.location.loc<>LOC_CREGISTER) then
                   begin
                     location_freetemp(exprasmlist,left.location);
                     location_release(exprasmlist,left.location);
                   end;
+               {$endif}
                  hregister:=rg.getregisterint(exprasmlist,OS_INT);
                  hregister2:=rg.getregisterint(exprasmlist,OS_INT);
+               {$ifdef newra}
+                 cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2),delete);
+               {$else}
                  cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2));
+               {$endif}
                  location_reset(left.location,LOC_REGISTER,OS_64);
                  left.location.registerlow:=hregister;
                  left.location.registerhigh:=hregister2;
@@ -1607,7 +1642,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.69  2003-05-30 23:49:18  jonas
+  Revision 1.70  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.69  2003/05/30 23:49:18  jonas
     * a_load_loc_reg now has an extra size parameter for the destination
       register (properly fixes what I worked around in revision 1.106 of
       ncgutil.pas)

compiler/i386/n386inl.pas

@@ -331,8 +331,9 @@ implementation
               else
                 emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
             {$ifdef newra}
-              if scratch_reg then
+{              if scratch_reg then}
                 rg.ungetregisterint(exprasmlist,hregister);
+              location_release(exprasmlist,Tcallparanode(left).left.location);
             {$else}
               if scratch_reg then
                 cg.free_scratch_reg(exprasmlist,hregister);
@@ -346,7 +347,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2003-06-01 21:38:06  peter
+  Revision 1.63  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.62  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/i386/n386mat.pas

@@ -164,7 +164,7 @@ implementation
           else
             begin
               hreg1:=rg.getregisterint(exprasmlist,right.location.size);
-              cg.a_load_loc_reg(exprasmlist,right.location,hreg1);
+              cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hreg1);
               rg.ungetregisterint(exprasmlist,hreg1);
               emit_reg(op,S_L,hreg1);
             end;
@@ -430,13 +430,7 @@ 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
@@ -452,10 +446,6 @@ implementation
           location_force_reg(exprasmlist,left.location,OS_64,false);
           hregisterhigh:=left.location.registerhigh;
           hregisterlow:=left.location.registerlow;
-          if hregisterhigh.enum<>R_INTREGISTER then
-            internalerror(200302056);
-          if hregisterlow.enum<>R_INTREGISTER then
-            internalerror(200302056);
 
           { shifting by a constant directly coded: }
           if (right.nodetype=ordconstn) then
@@ -504,7 +494,7 @@ implementation
             begin
               { load right operators in a register }
               hregister2:=rg.getexplicitregisterint(exprasmlist,NR_ECX);
-              cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
+              cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hregister2);
               if right.location.loc<>LOC_CREGISTER then
                 location_release(exprasmlist,right.location);
 
@@ -576,7 +566,7 @@ implementation
               if right.location.loc<>LOC_CREGISTER then
                 location_release(exprasmlist,right.location);
               hregister2:=rg.getexplicitregisterint(exprasmlist,NR_ECX);
-              cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
+              cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hregister2);
 
               { right operand is in ECX }
               emit_reg_reg(op,S_L,r2,location.register);
@@ -1183,7 +1173,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2003-05-31 15:04:31  peter
+  Revision 1.56  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.55  2003/05/31 15:04:31  peter
     * load_loc_reg update
 
   Revision 1.54  2003/05/22 21:32:29  peter

compiler/i386/rgcpu.pas

@@ -39,8 +39,10 @@ unit rgcpu;
           fpuvaroffset : byte;
 
           { to keep the same allocation order as with the old routines }
+{$ifdef newra}
+          procedure add_constraints(reg:Tnewregister);override;
+{$else}
           function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;override;
-{$ifndef newra}
           function getaddressregister(list:Taasmoutput):Tregister;override;
           procedure ungetregisterint(list:Taasmoutput;r:Tregister); override;
           function getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;override;
@@ -59,30 +61,37 @@ unit rgcpu;
           function makeregsize(reg: tregister; size: tcgsize): tregister; override;
 
           { pushes and restores registers }
+{$ifndef newra}
           procedure pushusedintregisters(list:Taasmoutput;
                                          var pushed:Tpushedsavedint;
                                          const s:Tsupregset);
+{$endif}
 {$ifdef SUPPORT_MMX}
           procedure pushusedotherregisters(list:Taasmoutput;
                                            var pushed:Tpushedsavedother;
                                            const s:Tregisterset);
 {$endif SUPPORT_MMX}
-
+{$ifndef newra}
           procedure popusedintregisters(list:Taasmoutput;
                                         const pushed:Tpushedsavedint);
+{$endif}
 {$ifdef SUPPORT_MMX}
           procedure popusedotherregisters(list:Taasmoutput;
                                           const pushed:Tpushedsavedother);
 {$endif SUPPORT_MMX}
 
+{$ifndef newra}
           procedure saveusedintregisters(list:Taasmoutput;
                                          var saved:Tpushedsavedint;
                                          const s:Tsupregset);override;
+{$endif}
           procedure saveusedotherregisters(list:Taasmoutput;
                                            var saved:Tpushedsavedother;
                                            const s:Tregisterset);override;
+{$ifndef newra}
           procedure restoreusedintregisters(list:Taasmoutput;
                                             const saved:Tpushedsavedint);override;
+{$endif}
           procedure restoreusedotherregisters(list:Taasmoutput;
                                               const saved:Tpushedsavedother);override;
 
@@ -168,16 +177,15 @@ unit rgcpu;
 {************************************************************************}
 
 {$ifdef newra}
-    function Trgcpu.getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
+    procedure Trgcpu.add_constraints(reg:Tnewregister);
 
     begin
-      getregisterint:=inherited getregisterint(list,size);
-      if size in [OS_8,OS_S8] then
+      if reg and $ff in [R_SUBL,R_SUBH] then
         begin
           {These registers have no 8-bit subregister, so add interferences.}
-          add_edge(getregisterint.number shr 8,RS_ESI);
-          add_edge(getregisterint.number shr 8,RS_EDI);
-          add_edge(getregisterint.number shr 8,RS_EBP);
+          add_edge(reg shr 8,RS_ESI);
+          add_edge(reg shr 8,RS_EDI);
+          add_edge(reg shr 8,RS_EBP);
         end;
     end;
 {$endif}
@@ -350,7 +358,7 @@ unit rgcpu;
            ungetregisterint(list,ref.index);
       end;
 
-
+{$ifndef newra}
     procedure trgcpu.pushusedintregisters(list:Taasmoutput;
                                          var pushed:Tpushedsavedint;
                                          const s:Tsupregset);
@@ -383,6 +391,7 @@ unit rgcpu;
       testregisters;
 {$endif TEMPREGDEBUG}
     end;
+{$endif}
 
 {$ifdef SUPPORT_MMX}
     procedure trgcpu.pushusedotherregisters(list:Taasmoutput;
@@ -422,6 +431,7 @@ unit rgcpu;
     end;
 {$endif SUPPORT_MMX}
 
+{$ifndef newra}
     procedure trgcpu.popusedintregisters(list:Taasmoutput;
                                          const pushed:Tpushedsavedint);
 
@@ -448,6 +458,7 @@ unit rgcpu;
       testregisters;
 {$endif TEMPREGDEBUG}
     end;
+{$endif}
 
 {$ifdef SUPPORT_MMX}
     procedure trgcpu.popusedotherregisters(list:Taasmoutput;
@@ -482,6 +493,7 @@ unit rgcpu;
     end;
 {$endif SUPPORT_MMX}
 
+{$ifndef newra}
     procedure trgcpu.saveusedintregisters(list:Taasmoutput;
                                           var saved:Tpushedsavedint;
                                           const s:Tsupregset);
@@ -493,6 +505,7 @@ unit rgcpu;
       else
         inherited saveusedintregisters(list,saved,s);
     end;
+{$endif}
 
 
     procedure trgcpu.saveusedotherregisters(list:Taasmoutput;var saved:Tpushedsavedother;
@@ -508,7 +521,7 @@ unit rgcpu;
         inherited saveusedotherregisters(list,saved,s);
     end;
 
-
+{$ifndef newra}
     procedure trgcpu.restoreusedintregisters(list:Taasmoutput;
                                              const saved:tpushedsavedint);
 
@@ -519,6 +532,7 @@ unit rgcpu;
       else
         inherited restoreusedintregisters(list,saved);
     end;
+{$endif}
 
     procedure trgcpu.restoreusedotherregisters(list:Taasmoutput;
                                                const saved:tpushedsavedother);
@@ -581,7 +595,10 @@ end.
 
 {
   $Log$
-  Revision 1.23  2003-06-01 21:38:06  peter
+  Revision 1.24  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.23  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/m68k/cpubase.pas

@@ -366,10 +366,6 @@ uses
 
       lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,LOC_CREGISTER];
 
-      {# Constant defining possibly all registers which might require saving }
-      ALL_REGISTERS = [R_D1..R_FPCR];
-      ALL_INTREGISTERS = [1..255];
-
       general_registers = [R_D0..R_D7];
       general_superregisters = [RS_D0..RS_D7];
 
@@ -709,7 +705,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2003-04-23 13:40:33  peter
+  Revision 1.21  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.20  2003/04/23 13:40:33  peter
     * fix m68k compile
 
   Revision 1.19  2003/04/23 12:35:35  florian

compiler/ncal.pas

@@ -2300,8 +2300,10 @@ type
 
               { procedure does a call }
               if not (block_type in [bt_const,bt_type]) then
+            {$ifndef newra}
                 include(current_procinfo.flags,pi_do_call);
               rg.incrementintregisterpushed(all_intregisters);
+            {$endif}
               rg.incrementotherregisterpushed(all_registers);
            end
          else
@@ -2336,7 +2338,9 @@ type
                 end;
 
              { It doesn't hurt to calculate it already though :) (JM) }
+          {$ifndef newra}
              rg.incrementintregisterpushed(tprocdef(procdefinition).usedintregisters);
+          {$endif}
              rg.incrementotherregisterpushed(tprocdef(procdefinition).usedotherregisters);
            end;
 
@@ -2569,7 +2573,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.162  2003-05-26 21:17:17  peter
+  Revision 1.163  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.162  2003/05/26 21:17:17  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

compiler/ncgcal.pas

@@ -497,7 +497,7 @@ implementation
                         location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
 {$endif newra}
                       cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
-                          location.register64);
+                          location.register64{$ifdef newra},false{$endif});
                     end
                    else
 {$endif cpu64bit}
@@ -508,7 +508,7 @@ implementation
                       r.enum:=R_INTREGISTER;
                       r.number:=nr;
 {$ifdef newra}
-                      rg.getexplicitregisterint(exprasmlist,nr);
+{                      rg.getexplicitregisterint(exprasmlist,nr);}
                       rg.ungetregisterint(exprasmlist,r);
                       location.register:=rg.getregisterint(exprasmlist,cgsize);
 {$else newra}
@@ -573,26 +573,34 @@ implementation
                end;
              ppn:=tcallparanode(ppn.right);
           end;
-
       end;
 
 
     procedure tcgcallnode.normal_pass_2;
       var
-         regs_to_push_int : Tsupregset;
          regs_to_push_other : tregisterset;
          unusedstate: pointer;
-         pushedother : tpushedsavedother;
+      {$ifdef newra}
+         i:Tsuperregister;
+         regs_to_alloc,regs_to_free:Tsupregset;
+      {$else}
+         regs_to_push_int : Tsupregset;
          pushedint : tpushedsavedint;
+         pushedregs : tmaybesave;
+      {$endif}
+         pushedother : tpushedsavedother;
          oldpushedparasize : longint;
          { adress returned from an I/O-error }
          iolabel : tasmlabel;
          { help reference pointer }
-         href : treference;
-         pushedregs : tmaybesave;
+         href,helpref : treference;
+         hp : tnode;
+         pp : tcallparanode;
+         store_parast_fixup,
          para_alignment,
          pop_size : longint;
-         accreg : tregister;
+         r,accreg,
+         vmtreg,vmtreg2 : tregister;
          oldaktcallnode : tcallnode;
       begin
          if not assigned(procdefinition) then
@@ -605,7 +613,7 @@ implementation
          { already here, we avoid later a push/pop                    }
          if is_widestring(resulttype.def) then
            begin
-             tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
+             tg.gettemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
              cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
            end
          else if is_ansistring(resulttype.def) then
@@ -634,10 +642,12 @@ implementation
               else
                 iolabel:=nil;
 
+{$ifdef newra}
+              regs_to_alloc:=Tprocdef(procdefinition).usedintregisters;
+{$else}
               { save all used registers and possible registers
                 used for the return value }
               regs_to_push_int := tprocdef(procdefinition).usedintregisters;
-              regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
               if (not is_void(resulttype.def)) and
                  (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
                begin
@@ -652,25 +662,35 @@ implementation
                    include(regs_to_push_int,RS_FUNCTION_RESULT_REG);
                end;
               rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
+{$endif}
+
+              regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
               rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
 
               { on the ppc, ever procedure saves the non-volatile registers it uses itself }
               { and must make sure it saves its volatile registers before doing a call     }
 {$ifdef i386}
               { give used registers through }
+{$ifndef newra}
               rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
+{$endif}
               rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
 {$endif i386}
            end
          else
            begin
-              regs_to_push_int := all_intregisters;
-              regs_to_push_other := all_registers;
+              {No procedure is allowed to destroy ebp.}
+{$ifdef newra}
+              regs_to_alloc:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
+{$else}
+              regs_to_push_int := all_intregisters-[RS_FRAME_POINTER_REG];
               rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
+{$endif}
+              regs_to_push_other := all_registers;
               rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
-{$ifdef i386}
+{$ifndef newra}
               rg.usedinproc:=all_registers;
-{$endif i386}
+{$endif}
               { no IO check for methods and procedure variables }
               iolabel:=nil;
            end;
@@ -693,6 +713,7 @@ implementation
          if assigned(right) then
            secondpass(right);
 
+{$ifdef disabled}
          if (po_virtualmethod in procdefinition.procoptions) and
             assigned(methodpointer) then
            begin
@@ -711,6 +732,7 @@ implementation
                 not(is_cppclass(tprocdef(procdefinition)._class)) then
                cg.g_maybe_testvmt(exprasmlist,methodpointer.location.register,tprocdef(procdefinition)._class);
            end;
+{$endif disabled}
 
          if assigned(left) then
            begin
@@ -744,43 +766,124 @@ implementation
                  ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
                 push_framepointer;
 
+{$ifndef newra}
               rg.saveintregvars(exprasmlist,regs_to_push_int);
+{$endif}
               rg.saveotherregvars(exprasmlist,regs_to_push_other);
 
               if (po_virtualmethod in procdefinition.procoptions) and
                  assigned(methodpointer) then
                 begin
+                   secondpass(methodpointer);
+                   location_force_reg(exprasmlist,methodpointer.location,OS_ADDR,false);
+                   vmtreg:=methodpointer.location.register;
+
+                   { virtual methods require an index }
+                   if tprocdef(procdefinition).extnumber=-1 then
+                     internalerror(200304021);
+                   { VMT should already be loaded in a register }
+                   if vmtreg.number=NR_NO then
+                     internalerror(200304022);
+
+                   { test validity of VMT }
+                   if not(is_interface(tprocdef(procdefinition)._class)) and
+                      not(is_cppclass(tprocdef(procdefinition)._class)) then
+                     cg.g_maybe_testvmt(exprasmlist,vmtreg,tprocdef(procdefinition)._class);
+
+{$ifdef newra}
+                   { release self }
+                   rg.ungetaddressregister(exprasmlist,vmtreg);
+                   vmtreg2:=rg.getabtregisterint(exprasmlist,OS_ADDR);
+                   rg.ungetregisterint(exprasmlist,vmtreg2);
+                   cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,vmtreg,vmtreg2);
+                   for i:=first_supreg to last_supreg do
+                    if i in regs_to_alloc then
+                      begin
+                        r.number:=i shl 8 or R_SUBWHOLE;
+                        rg.getexplicitregisterint(exprasmlist,r.number);
+                      end;
+{$endif}
                    { call method }
-                   reference_reset_base(href,methodpointer.location.register,
+                   reference_reset_base(href,{$ifdef newra}vmtreg2{$else}vmtreg{$endif},
                       tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
                    cg.a_call_ref(exprasmlist,href);
-
-                   { release vmt register }
-                   rg.ungetaddressregister(exprasmlist,methodpointer.location.register);
+{$ifndef newra}
+                   { release self }
+                   rg.ungetaddressregister(exprasmlist,vmtreg);
+{$endif}
                 end
               else
                 begin
+{$ifdef newra}
+                  for i:=first_supreg to last_supreg do
+                    if i in regs_to_alloc then
+                      begin
+                        r.number:=i shl 8 or R_SUBWHOLE;
+                        rg.getexplicitregisterint(exprasmlist,r.number);
+                      end;
+{$endif}
                   { Calling interrupt from the same code requires some
                     extra code }
                   if (po_interrupt in procdefinition.procoptions) then
                     extra_interrupt_code;
-
                   cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
                end;
            end
          else
            { now procedure variable case }
            begin
+              secondpass(right);
+
+{$ifdef newra}
+              if right.location.loc in  [LOC_REFERENCE,LOC_CREFERENCE] then
+                begin
+                  helpref:=right.location.reference;
+                  if helpref.index.number<>NR_NO then
+                    begin
+                      rg.ungetregisterint(exprasmlist,helpref.index);
+                      helpref.index:=rg.getabtregisterint(exprasmlist,OS_ADDR);
+                      cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
+                                        right.location.reference.index,helpref.index);
+                    end;
+                  if helpref.base.number<>NR_NO then
+                    begin
+                      rg.ungetregisterint(exprasmlist,helpref.base);
+                      helpref.base:=rg.getabtregisterint(exprasmlist,OS_ADDR);
+                      cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
+                                        right.location.reference.base,helpref.base);
+                    end;
+                end
+              else
+                rg.ungetregisterint(exprasmlist,right.location.register);
+              
+              reference_release(exprasmlist,helpref);
+              location_freetemp(exprasmlist,right.location);
+              for i:=first_supreg to last_supreg do
+                if i in regs_to_alloc then
+                  begin
+                    r.number:=i shl 8 or R_SUBWHOLE;
+                    rg.getexplicitregisterint(exprasmlist,r.number);
+                  end;
+{$endif}
               { Calling interrupt from the same code requires some
                 extra code }
               if (po_interrupt in procdefinition.procoptions) then
                 extra_interrupt_code;
 
-              rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
-              rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
-              cg.a_call_loc(exprasmlist,right.location);
-              location_release(exprasmlist,right.location);
-              location_freetemp(exprasmlist,right.location);
+            {$ifndef newra}
+               helpref:=right.location.reference;
+               rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
+            {$endif}
+               rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
+               if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+                 cg.a_call_ref(exprasmlist,helpref)
+               else
+                 cg.a_call_reg(exprasmlist,right.location.register);
+{               cg.a_call_loc(exprasmlist,right.location);}
+            {$ifndef newra}
+               location_release(exprasmlist,right.location);
+               location_freetemp(exprasmlist,right.location);
+            {$endif newra}
            end;
 
          { Need to remove the parameters from the stack? }
@@ -811,6 +914,26 @@ implementation
          testregisters32;
 {$endif TEMPREGDEBUG}
 
+       {$ifdef newra}
+         regs_to_free:=regs_to_alloc;
+         exclude(regs_to_alloc,RS_STACK_POINTER_REG);
+         if (not is_void(resulttype.def)) and
+            (not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
+           begin
+             exclude(regs_to_free,RS_FUNCTION_RESULT_REG);
+          {$ifndef cpu64bit}
+             if resulttype.def.size>sizeof(aword) then
+               exclude(regs_to_free,RS_FUNCTION_RESULT64_HIGH_REG);
+          {$endif cpu64bit}
+           end;
+         r.enum:=R_INTREGISTER;
+         for i:=first_supreg to last_supreg do
+           if i in regs_to_free then
+             begin
+               r.number:=i shl 8 or R_SUBWHOLE;
+               rg.ungetregisterint(exprasmlist,r);
+             end;
+       {$endif}
          { handle function results }
          if (not is_void(resulttype.def)) then
            handle_return_value
@@ -827,7 +950,9 @@ implementation
 
          { restore registers }
          rg.restoreusedotherregisters(exprasmlist,pushedother);
+       {$ifndef newra}
          rg.restoreusedintregisters(exprasmlist,pushedint);
+       {$endif}
 
          { release temps of paras }
          release_para_temps;
@@ -866,7 +991,9 @@ implementation
          regs_to_push_other : tregisterset;
          unusedstate: pointer;
          pushedother : tpushedsavedother;
+      {$ifndef newra}
          pushedint : tpushedsavedint;
+      {$endif}
          oldpushedparasize : longint;
          { adress returned from an I/O-error }
          iolabel : tasmlabel;
@@ -1045,7 +1172,9 @@ implementation
 {$endif cpu64bit}
                    include(regs_to_push_int,RS_FUNCTION_RESULT_REG);
           end;
+      {$ifndef newra}
          rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
+      {$endif}
          rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
 
 {$ifdef i386}
@@ -1087,7 +1216,9 @@ implementation
            end;
          aktcallnode:=oldaktcallnode;
 
+      {$ifndef newra}
          rg.saveintregvars(exprasmlist,regs_to_push_int);
+      {$endif}
          rg.saveotherregvars(exprasmlist,regs_to_push_other);
 
          { takes care of local data initialization }
@@ -1164,7 +1295,9 @@ implementation
 
          { restore registers }
          rg.restoreusedotherregisters(exprasmlist,pushedother);
+      {$ifndef newra}
          rg.restoreusedintregisters(exprasmlist,pushedint);
+      {$endif}
 
          { release temps of paras }
          release_para_temps;
@@ -1242,7 +1375,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.81  2003-06-01 21:38:06  peter
+  Revision 1.82  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.81  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/ncgld.pas

@@ -68,7 +68,9 @@ implementation
         i : longint;
         href : treference;
         newsize : tcgsize;
+      {$ifndef newra}
         pushed : tpushedsavedint;
+      {$endif}
         dorelocatelab,
         norelocatelab : tasmlabel;
       begin
@@ -143,19 +145,30 @@ implementation
                        cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
                        cg.a_jmp_always(exprasmlist,norelocatelab);
                        cg.a_label(exprasmlist,dorelocatelab);
-                       if hregister.enum<>R_INTREGISTER then
-                         internalerror(200301171);
                        { don't save the allocated register else the result will be destroyed later }
+                    {$ifndef newra}
                        rg.saveusedintregisters(exprasmlist,pushed,[RS_FUNCTION_RESULT_REG]-[hregister.number shr 8]);
+                    {$endif}
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
+                    {$ifdef newra}
+                       rg.ungetregisterint(exprasmlist,hregister);
+                       r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
+                    {$endif}
                        { the called procedure isn't allowed to change }
                        { any register except EAX                    }
                        cg.a_call_reg(exprasmlist,hregister);
+                    {$ifdef newra}
+                       rg.ungetregisterint(exprasmlist,r);
+                       hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
+                    {$else}
                        r.enum:=R_INTREGISTER;
                        r.number:=NR_FUNCTION_RESULT_REG;
+                    {$endif}
                        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
+                    {$ifndef newra}
                        rg.restoreusedintregisters(exprasmlist,pushed);
+                    {$endif}
                        cg.a_label(exprasmlist,norelocatelab);
                        location.reference.base:=hregister;
                     end
@@ -539,7 +552,7 @@ implementation
                         cgsize:=def_cgsize(left.resulttype.def);
                         if cgsize in [OS_64,OS_S64] then
                          cg64.a_load64_ref_reg(exprasmlist,
-                             right.location.reference,left.location.register64)
+                             right.location.reference,left.location.register64{$ifdef newra},false{$endif})
                         else
                          cg.a_load_ref_reg(exprasmlist,cgsize,
                              right.location.reference,left.location.register);
@@ -922,7 +935,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.64  2003-05-30 23:57:08  peter
+  Revision 1.65  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.64  2003/05/30 23:57:08  peter
     * more sparc cleanup
     * accumulator removed, splitted in function_return_reg (called) and
       function_result_reg (caller)

compiler/ncgmem.pas

@@ -455,7 +455,10 @@ implementation
          poslabel,
          neglabel : tasmlabel;
          hreg : tregister;
+         i:Tsuperregister;
+      {$ifndef newra}
          pushed : tpushedsavedint;
+      {$endif}
        begin
          if is_open_array(left.resulttype.def) or
             is_array_of_const(left.resulttype.def) then
@@ -506,12 +509,33 @@ implementation
          else
           if is_dynamic_array(left.resulttype.def) then
             begin
+            {$ifndef newra}
                rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+            {$endif}
                cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(2));
                cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
+            {$ifdef newra}
+               hreg.enum:=R_INTREGISTER;
+               for i:=first_supreg to last_supreg do
+                 if i<>RS_FRAME_POINTER_REG then
+                   begin
+                     hreg.number:=i shl 8 or R_SUBWHOLE;
+                     rg.getexplicitregisterint(exprasmlist,hreg.number);
+                   end;
+            {$else}
                rg.saveintregvars(exprasmlist,all_intregisters);
+            {$endif}
                cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
+            {$ifdef newra}
+               for i:=first_supreg to last_supreg do
+                 if i<>RS_FRAME_POINTER_REG then
+                   begin
+                     hreg.number:=i shl 8 or R_SUBWHOLE;
+                     rg.ungetregisterint(exprasmlist,hreg);
+                   end;
+            {$else}
                rg.restoreusedintregisters(exprasmlist,pushed);
+            {$endif}
             end
          else
            cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
@@ -524,7 +548,12 @@ implementation
          extraoffset : longint;
          t : tnode;
          href : treference;
+      {$ifdef newra}
+         hreg:Tregister;
+         i:Tsuperregister;
+      {$else}
          pushed : tpushedsavedint;
+      {$endif}
          isjump  : boolean;
          otl,ofl : tasmlabel;
          newsize : tcgsize;
@@ -546,11 +575,32 @@ implementation
                 begin
                    if left.location.loc<>LOC_REFERENCE then
                      internalerror(200304236);
+                {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+                {$endif}
                    cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
+                {$ifdef newra}
+                   hreg.enum:=R_INTREGISTER;
+                   for i:=first_supreg to last_supreg do
+                     if i<>RS_FRAME_POINTER_REG then
+                       begin
+                         hreg.number:=i shl 8 or R_SUBWHOLE;
+                         rg.getexplicitregisterint(exprasmlist,hreg.number);
+                       end;
+                {$else}
                    rg.saveintregvars(exprasmlist,all_intregisters);
+                {$endif}
                    cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
+                {$ifdef newra}
+                   for i:=first_supreg to last_supreg do
+                     if i<>RS_FRAME_POINTER_REG then
+                       begin
+                         hreg.number:=i shl 8 or R_SUBWHOLE;
+                         rg.ungetregisterint(exprasmlist,hreg);
+                       end;
+                {$else}
                    rg.restoreusedintregisters(exprasmlist,pushed);
+                {$endif}
                 end;
 
               case left.location.loc of
@@ -572,11 +622,32 @@ implementation
                 we can use the ansistring routine here }
               if (cs_check_range in aktlocalswitches) then
                 begin
+                {$ifndef newra}
                    rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+                {$endif}
                    cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                {$ifdef newra}
+                   hreg.enum:=R_INTREGISTER;
+                   for i:=first_supreg to last_supreg do
+                     if i<>RS_FRAME_POINTER_REG then
+                       begin
+                         hreg.number:=i shl 8 or R_SUBWHOLE;
+                         rg.getexplicitregisterint(exprasmlist,hreg.number);
+                       end;
+                {$else}
                    rg.saveintregvars(exprasmlist,all_intregisters);
-                   cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
+                {$endif}
+                   cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
+                {$ifdef newra}
+                   for i:=first_supreg to last_supreg do
+                     if i<>RS_FRAME_POINTER_REG then
+                       begin
+                         hreg.number:=i shl 8 or R_SUBWHOLE;
+                         rg.ungetregisterint(exprasmlist,hreg);
+                       end;
+                {$else}
                    rg.restoreusedintregisters(exprasmlist,pushed);
+                {$endif}
                 end;
 
               { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
@@ -649,14 +720,35 @@ implementation
                          st_widestring,
                          st_ansistring:
                            begin
+                            {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+                            {$endif}
                               cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
                               href:=location.reference;
                               dec(href.offset,7);
                               cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                            {$ifdef newra}
+                              hreg.enum:=R_INTREGISTER;
+                              for i:=first_supreg to last_supreg do
+                               if i<>RS_FRAME_POINTER_REG then
+                                  begin
+                                    hreg.number:=i shl 8 or R_SUBWHOLE;
+                                    rg.getexplicitregisterint(exprasmlist,hreg.number);
+                                  end;
+                            {$else}
                               rg.saveintregvars(exprasmlist,all_intregisters);
+                            {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                            {$ifdef newra}
+                              for i:=first_supreg to last_supreg do
+                               if i<>RS_FRAME_POINTER_REG then
+                                  begin
+                                    hreg.number:=i shl 8 or R_SUBWHOLE;
+                                    rg.ungetregisterint(exprasmlist,hreg);
+                                  end;
+                            {$else}
                               rg.restoreusedintregisters(exprasmlist,pushed);
+                            {$endif}
                            end;
 
                          st_shortstring:
@@ -783,14 +875,35 @@ implementation
                          st_widestring,
                          st_ansistring:
                            begin
+                            {$ifndef newra}
                               rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
+                            {$endif}
                               cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(2));
                               href:=location.reference;
                               dec(href.offset,7);
                               cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                            {$ifdef newra}
+                              hreg.enum:=R_INTREGISTER;
+                              for i:=first_supreg to last_supreg do
+                               if i<>RS_FRAME_POINTER_REG then
+                                  begin
+                                    hreg.number:=i shl 8 or R_SUBWHOLE;
+                                    rg.getexplicitregisterint(exprasmlist,hreg.number);
+                                  end;
+                            {$else}
                               rg.saveintregvars(exprasmlist,all_intregisters);
+                            {$endif}
                               cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                            {$ifdef newra}
+                              for i:=first_supreg to last_supreg do
+                               if i<>RS_FRAME_POINTER_REG then
+                                  begin
+                                    hreg.number:=i shl 8 or R_SUBWHOLE;
+                                    rg.ungetregisterint(exprasmlist,hreg);
+                                  end;
+                            {$else}
                               rg.restoreusedintregisters(exprasmlist,pushed);
+                            {$endif}
                            end;
                          st_shortstring:
                            begin
@@ -824,7 +937,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  2003-06-02 22:35:45  florian
+  Revision 1.58  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.57  2003/06/02 22:35:45  florian
     * better handling of CREGISTER in subscript nodes
 
   Revision 1.56  2003/06/01 21:38:06  peter

compiler/ncgopt.pas

@@ -196,14 +196,16 @@ begin
   location_copy(location,left.location);
 end;
 
-
 begin
   caddsstringcharoptnode := tcgaddsstringcharoptnode;
 end.
 
 {
   $Log$
-  Revision 1.4  2003-06-01 21:38:06  peter
+  Revision 1.5  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.4  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/ncgutil.pas

@@ -63,8 +63,9 @@ interface
                               para_offset:longint;alignment : longint;
                               const locpara : tparalocation);
 
-    procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
-    procedure genexitcode(list : TAAsmoutput;inlined:boolean);
+    procedure genentrycode(list:TAAsmoutput;inlined:boolean);
+    procedure gen_stackalloc_code(list:Taasmoutput;stackframe:cardinal);
+    procedure genexitcode(list:Taasmoutput;inlined:boolean);
 
     procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
     procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
@@ -382,7 +383,7 @@ implementation
               hreg64.reglo:=hregister;
               hreg64.reghi:=hregisterhi;
               { load value in new register }
-              cg64.a_load64_loc_reg(list,l,hreg64);
+              cg64.a_load64_loc_reg(list,l,hreg64{$ifdef newra},false{$endif});
               location_reset(l,LOC_REGISTER,dst_size);
               l.registerlow:=hregister;
               l.registerhigh:=hregisterhi;
@@ -430,6 +431,9 @@ implementation
                  hregister:=rg.getregisterint(list,dst_size);
              end;
            hregister.number:=(hregister.number and not $ff) or cgsize2subreg(dst_size);
+        {$ifdef newra}
+           rg.add_constraints(hregister.number);
+        {$endif}
            { load value in new register }
            case l.loc of
              LOC_FLAGS :
@@ -596,6 +600,22 @@ implementation
      end;
 {$endif cpu64bit}
 
+{$ifdef newra}
+    procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
+
+    var oldloc:Tlocation;
+
+      begin
+        oldloc:=l;
+        location_force(list, l, dst_size, maybeconst);
+        { release previous location before demanding a new register }
+        if (oldloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+         begin
+           location_freetemp(list,oldloc);
+           location_release(list,oldloc);
+         end;
+      end;
+{$else}
     procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
       begin
         { release previous location before demanding a new register }
@@ -606,7 +626,7 @@ implementation
          end;
         location_force(list, l, dst_size, maybeconst)
       end;
-
+{$endif}
 
     procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
       var
@@ -1286,7 +1306,7 @@ implementation
                     r2.enum:=R_INTREGISTER;
                     r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
                     cg.a_reg_alloc(list,r2);
-                    cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
+                    cg64.a_load64_ref_reg(list,resloc,joinreg64(r,r2){$ifdef newra},false{$endif});
                   end
                  else
 {$endif cpu64bit}
@@ -1323,7 +1343,11 @@ implementation
                        r2.enum:=R_INTREGISTER;
                        r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
                        cg.a_reg_alloc(list,r2);
+<<<<<<< ncgutil.pas
+                       cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
+=======
                        cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
+>>>>>>> 1.117
                      end
                     else
 {$endif cpu64bit}
@@ -1339,17 +1363,13 @@ implementation
       end;
 
 
-    procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
+
+    procedure genentrycode(list:TAAsmoutput;inlined:boolean);
       var
-        hs : string;
         href : treference;
-        stackalloclist : taasmoutput;
         hp : tparaitem;
         rsp : tregister;
       begin
-        if not inlined then
-           stackalloclist:=taasmoutput.Create;
-
         { the actual stack allocation code, symbol entry point and
           gdb stabs information is generated AFTER the rest of this
           code, since temp. allocation might occur before - carl
@@ -1515,81 +1535,81 @@ implementation
         if inlined then
           load_regvars(list,nil);
 
-        {************************* Stack allocation **************************}
-        { and symbol entry point as well as debug information                 }
-        { will be inserted in front of the rest of this list.                 }
-        { Insert alignment and assembler names }
-        if not inlined then
-         begin
-           { Align, gprof uses 16 byte granularity }
-           if (cs_profile in aktmoduleswitches) then
-            stackalloclist.concat(Tai_align.Create(16))
-           else
-            stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
+      end;
+
+    procedure gen_stackalloc_code(list:Taasmoutput;stackframe:cardinal);
+
+    var hs:string;
+
+    begin
+      {************************* Stack allocation **************************}
+      { and symbol entry point as well as debug information                 }
+      { will be inserted in front of the rest of this list.                 }
+      { Insert alignment and assembler names }
+      { Align, gprof uses 16 byte granularity }
+      if (cs_profile in aktmoduleswitches) then
+        list.concat(Tai_align.create(16))
+      else
+        list.concat(Tai_align.create(aktalignment.procalign));
 
 {$ifdef GDB}
-           if (cs_debuginfo in aktmoduleswitches) then
-            begin
-              if (po_public in current_procdef.procoptions) then
-                tprocsym(current_procdef.procsym).is_global:=true;
-              current_procdef.concatstabto(stackalloclist);
-              tprocsym(current_procdef.procsym).isstabwritten:=true;
-            end;
+      if (cs_debuginfo in aktmoduleswitches) then
+        begin
+          if (po_public in current_procdef.procoptions) then
+            Tprocsym(current_procdef.procsym).is_global:=true;
+          current_procdef.concatstabto(list);
+          Tprocsym(current_procdef.procsym).isstabwritten:=true;
+        end;
 {$endif GDB}
 
-           repeat
-             hs:=current_procdef.aliasnames.getfirst;
-             if hs='' then
-              break;
+      repeat
+        hs:=current_procdef.aliasnames.getfirst;
+        if hs='' then
+          break;
 {$ifdef GDB}
-             if (cs_debuginfo in aktmoduleswitches) and
-                target_info.use_function_relative_addresses then
-              stackalloclist.concat(Tai_stab_function_name.Create(strpnew(hs)));
+        if (cs_debuginfo in aktmoduleswitches) and
+           target_info.use_function_relative_addresses then
+        list.concat(Tai_stab_function_name.create(strpnew(hs)));
 {$endif GDB}
-             if (cs_profile in aktmoduleswitches) or
-                (po_public in current_procdef.procoptions) then
-              stackalloclist.concat(Tai_symbol.Createname_global(hs,0))
-             else
-              stackalloclist.concat(Tai_symbol.Createname(hs,0));
-           until false;
+        if (cs_profile in aktmoduleswitches) or
+           (po_public in current_procdef.procoptions) then
+          list.concat(Tai_symbol.createname_global(hs,0))
+        else
+          list.concat(Tai_symbol.createname(hs,0));
+      until false;
 
-          stackframe:=stackframe+tg.gettempsize;
+      stackframe:=stackframe+tg.gettempsize;
 {$ifndef m68k}
           { give a warning if the limit of local variables is reached }
-          if stackframe > maxlocalsize then
-            Message(cg_w_localsize_too_big);
+      if stackframe>maxlocalsize then
+        message(cg_w_localsize_too_big);
 {$endif}
 {$ifndef powerpc}
-           { at least for the ppc this applies always, so this code isn't usable (FK) }
-           { omit stack frame ? }
-           if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
-            begin
-              CGMessage(cg_d_stackframe_omited);
-              if stackframe<>0 then
-                cg.g_stackpointer_alloc(stackalloclist,stackframe);
-            end
-           else
+      { at least for the ppc this applies always, so this code isn't usable (FK) }
+      { omit stack frame ? }
+      if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
+        begin
+          CGmessage(cg_d_stackframe_omited);
+          if stackframe<>0 then
+            cg.g_stackpointer_alloc(list,stackframe);
+        end
+      else
 {$endif powerpc}
-            begin
-              if (po_interrupt in current_procdef.procoptions) then
-                cg.g_interrupt_stackframe_entry(stackalloclist);
+        begin
+          if (po_interrupt in current_procdef.procoptions) then
+            cg.g_interrupt_stackframe_entry(list);
 
-              cg.g_stackframe_entry(stackalloclist,stackframe);
+          cg.g_stackframe_entry(list,stackframe);
 
-              { never call stack checking before the standard system unit
-                has not been initialized
-              }
-              if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
-                cg.g_stackcheck(stackalloclist,stackframe);
-            end;
-            list.insertlist(stackalloclist);
-            stackalloclist.free;
-         end;
-        {************************* End Stack allocation **************************}
-      end;
+          {Never call stack checking before the standard system unit
+           has been initialized.}
+           if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
+             cg.g_stackcheck(list,stackframe);
+        end;
+    end;
 
+    procedure genexitcode(list : TAAsmoutput;inlined:boolean);
 
-   procedure genexitcode(list : TAAsmoutput;inlined:boolean);
       var
 {$ifdef GDB}
         stabsendlabel : tasmlabel;
@@ -1601,10 +1621,14 @@ implementation
         srsym : tsym;
         usesacc,
         usesacchi,
-        usesfpu : boolean;
-        rsp,r  : Tregister;
-        retsize : longint;
+        usesself,usesfpu : boolean;
+        pd : tprocdef;
+        rsp,tmpreg,r  : Tregister;
+        retsize:cardinal;
+        nostackframe:boolean;
       begin
+{        nostackframe:=current_procinfo.framepointer.number=NR_STACK_POINTER_REG;}
+
         if aktexitlabel.is_used then
           cg.a_label(list,aktexitlabel);
 
@@ -1709,11 +1733,10 @@ implementation
            if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
             begin
               if (tg.gettempsize<>0) then
-                cg.a_op_const_reg(list,OP_ADD,OS_ADDR,tg.gettempsize,current_procinfo.framepointer);
+                cg.a_op_const_reg(list,OP_ADD,OS_32,tg.gettempsize,current_procinfo.framepointer);
             end
            else
             cg.g_restore_frame_pointer(list);
-             if not (po_assembler in current_procdef.procoptions) then
          end;
 {$endif}
 
@@ -1848,7 +1871,11 @@ implementation
                   begin
                     r:=rg.getregisterint(list,OS_INT);
                     r2:=rg.getregisterint(list,OS_INT);
+<<<<<<< ncgutil.pas
+                    cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
+=======
                     cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
+>>>>>>> 1.117
                   end
                  else
 {$endif cpu64bit}
@@ -1877,7 +1904,11 @@ implementation
                      begin
                        r:=rg.getregisterint(list,OS_INT);
                        r2:=rg.getregisterint(list,OS_INT);
+<<<<<<< ncgutil.pas
+                       cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
+=======
                        cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
+>>>>>>> 1.117
                      end
                     else
 {$endif cpu64bit}
@@ -1952,7 +1983,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.117  2003-06-02 21:42:05  jonas
+  Revision 1.118  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.117  2003/06/02 21:42:05  jonas
     * function results can now also be regvars
     - removed tprocinfo.return_offset, never use it again since it's invalid
       if the result is a regvar

compiler/pass_2.pas

@@ -287,6 +287,15 @@ implementation
 {$ifndef i386}
               cleanup_regvars(current_procinfo.aktexitcode);
 {$endif i386}
+{$ifdef newra}
+              if current_procinfo.framepointer.number=NR_EBP then
+                begin
+                  {Make sure the register allocator won't allocate registers
+                   into ebp.}
+                  include(rg.usedintinproc,RS_EBP);
+                  exclude(rg.unusedregsint,RS_EBP);
+                end;
+{$endif}
 
               do_secondpass(p);
 
@@ -300,7 +309,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2003-05-26 21:17:17  peter
+  Revision 1.54  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.53  2003/05/26 21:17:17  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

compiler/pmodules.pas

@@ -793,7 +793,8 @@ implementation
         { generate a dummy function }
         objectlibrary.getlabel(aktexitlabel);
         include(current_procinfo.flags,pi_do_call);
-        genentrycode(list,0,false);
+        gen_stackalloc_code(list,0);
+        genentrycode(list,false);
         genexitcode(list,false);
         list.convert_registers;
         release_main_proc(pd);
@@ -867,7 +868,7 @@ implementation
          { handle the global switches }
          setupglobalswitches;
 
-         Message1(unit_u_loading_interface_units,current_module.modulename^);
+         message1(unit_u_loading_interface_units,current_module.modulename^);
 
          { update status }
          status.currentmodule:=current_module.realmodulename^;
@@ -1474,7 +1475,10 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 {
   $Log$
-  Revision 1.109  2003-05-26 21:17:17  peter
+  Revision 1.110  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.109  2003/05/26 21:17:17  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

compiler/psub.pas

@@ -554,6 +554,8 @@ implementation
         oldexitlabel : tasmlabel;
         oldaktmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
+        stackalloccode : Taasmoutput;
+
       begin
         { the initialization procedure can be empty, then we
           don't need to generate anything. When it was an empty
@@ -584,7 +586,9 @@ implementation
         rg.usedinproc:=[];
         rg.usedintinproc:=[];
         rg.usedbyproc:=[];
+      {$ifndef newra}
         rg.usedintbyproc:=[];
+      {$endif}
 
         { set the start offset to the start of the temp area in the stack }
         tg.setfirsttemp(current_procinfo.firsttemp_offset);
@@ -594,7 +598,7 @@ implementation
         { first generate entry code with the correct position and switches }
         aktfilepos:=current_procinfo.entrypos;
         aktlocalswitches:=current_procinfo.entryswitches;
-        genentrycode(current_procinfo.aktentrycode,0,false);
+        genentrycode(current_procinfo.aktentrycode,false);
 
         { now generate exit code with the correct position and switches }
         aktfilepos:=current_procinfo.exitpos;
@@ -602,8 +606,8 @@ implementation
         genexitcode(current_procinfo.aktexitcode,false);
 
         { now all the registers used are known }
-        current_procdef.usedintregisters:=rg.usedintinproc;
-        current_procdef.usedotherregisters:=rg.usedinproc;
+{        current_procdef.usedintregisters:=rg.usedintinproc;
+        current_procdef.usedotherregisters:=rg.usedinproc;}
         current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
         current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
 {$ifdef newra}
@@ -617,13 +621,7 @@ implementation
               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='';
+            until (rg.spillednodes='') or not rg.spill_registers(current_procinfo.aktproccode,rg.spillednodes);
             current_procinfo.aktproccode.translate_registers(rg.colour);
             current_procinfo.aktproccode.convert_registers;
 {$else newra}
@@ -637,6 +635,21 @@ implementation
 {$endif newra}
           end;
 
+        stackalloccode:=Taasmoutput.create;
+        gen_stackalloc_code(stackalloccode,0);
+        stackalloccode.convert_registers;
+        current_procinfo.aktproccode.insertlist(stackalloccode);
+        stackalloccode.destroy;
+
+        { now all the registers used are known }
+        { Remove all imaginary registers from the used list.}
+{$ifdef newra}
+        current_procdef.usedintregisters:=rg.usedintinproc*ALL_INTREGISTERS-rg.savedbyproc;
+{$else}
+        current_procdef.usedintregisters:=rg.usedintinproc;
+{$endif}
+        current_procdef.usedotherregisters:=rg.usedinproc;
+
         { save local data (casetable) also in the same file }
         if assigned(current_procinfo.aktlocaldata) and
            (not current_procinfo.aktlocaldata.empty) then
@@ -648,8 +661,8 @@ implementation
 
         { add the procedure to the codesegment }
         if (cs_create_smart in aktmoduleswitches) then
-         codeSegment.concat(Tai_cut.Create);
-        codeSegment.concatlist(current_procinfo.aktproccode);
+         codesegment.concat(Tai_cut.Create);
+        codesegment.concatlist(current_procinfo.aktproccode);
 
         { all registers can be used again }
         rg.resetusableregisters;
@@ -751,6 +764,7 @@ implementation
     procedure tcgprocinfo.parse_body;
       var
          oldprocdef : tprocdef;
+         stackalloccode : Taasmoutput;
          oldprocinfo : tprocinfo;
       begin
          oldprocdef:=current_procdef;
@@ -785,6 +799,12 @@ implementation
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
 
+         { reset the temporary memory }
+         rg.cleartempgen;
+         rg.usedintinproc:=[];
+         rg.usedinproc:=[];
+         rg.usedbyproc:=[];
+
          { save entry info }
          entrypos:=aktfilepos;
          entryswitches:=aktlocalswitches;
@@ -1213,7 +1233,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.121  2003-05-31 20:23:39  jonas
+  Revision 1.122  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.121  2003/05/31 20:23:39  jonas
     * added pi_do_call if a procedure has a value shortstring parameter
       (it's copied to the local stackframe with a helper)
 

compiler/regvars.pas

@@ -150,6 +150,7 @@ implementation
       r : Tregister;
       siz : tcgsize;
     begin
+{$ifndef newra}
       { max. optimizations     }
       { only if no asm is used }
       { and no try statement   }
@@ -298,6 +299,7 @@ implementation
                   end;
               end;
         end;
+{$endif}
      end;
 
 
@@ -606,7 +608,10 @@ end.
 
 {
   $Log$
-  Revision 1.53  2003-05-31 20:33:57  jonas
+  Revision 1.54  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.53  2003/05/31 20:33:57  jonas
     * temp fix/hack for nested procedures (disable regvars in all procedures
       that have nested procedures)
     * leave register parameters in their own register (instead of storing

compiler/rgobj.pas

@@ -86,6 +86,10 @@ unit rgobj;
 {$endif}
       ;
 
+
+    const ALL_REGISTERS=[firstreg..lastreg];
+          ALL_INTREGISTERS=[first_supreg..last_supreg]-[RS_STACK_POINTER_REG];
+
     type
 
 
@@ -101,7 +105,9 @@ unit rgobj;
        end;
 
        tpushedsavedother = array[firstreg..lastreg] of tpushedsavedloc;
+{$ifndef newra}
        Tpushedsavedint = array[first_supreg..last_supreg] of Tpushedsavedloc;
+{$endif}
 
       Tinterferencebitmap=array[Tsuperregister] of set of Tsuperregister;
       Tinterferenceadjlist=array[Tsuperregister] of Pstring;
@@ -128,6 +134,9 @@ unit rgobj;
                 ms_worklist_moves,ms_active_moves);
       Tmoveins=class(Tlinkedlistitem)
         moveset:Tmoveset;
+      { $ifdef ra_debug}
+        x,y:Tsuperregister;
+      { $endif}
         instruction:Taicpu;
       end;
 
@@ -168,13 +177,19 @@ unit rgobj;
           }
           usedbyproc,
           usedinproc : tregisterset;
+{$ifdef newra}
+          savedbyproc,
+{$else}
           usedintbyproc,
+{$endif}
           usedaddrbyproc,
           usedintinproc,
           usedaddrinproc:Tsupregset;
 
           reg_pushes_other : regvarother_longintarray;
+{$ifndef newra}
           reg_pushes_int : regvarint_longintarray;
+{$endif}
           is_reg_var_other : regvarother_booleanarray;
           is_reg_var_int:Tsupregset;
           regvar_loaded_other: regvarother_booleanarray;
@@ -194,7 +209,20 @@ unit rgobj;
              An internalerror will be generated if there
              is no more free registers which can be allocated
           }
-          function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
+          function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;{$ifndef newra}virtual;{$endif}
+{$ifdef newra}
+          procedure add_constraints(reg:Tnewregister);virtual;
+
+          {# Allocate an ABT register
+
+             An internalerror will be generated if there
+             is no more free registers which can be allocated
+
+             An explanantion of abt registers can be found near the implementation.
+          }
+          function getabtregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
+{$endif}
+
           {# Free a general purpose register
 
              @param(r register to free)
@@ -279,7 +307,9 @@ unit rgobj;
 
 
           {# saves register variables (restoring happens automatically) }
+{$ifndef newra}
           procedure saveintregvars(list:Taasmoutput;const s:Tsupregset);
+{$endif}
           procedure saveotherregvars(list:Taasmoutput;const s:Tregisterset);
 
           {# Saves in temporary references (allocated via the temp. allocator)
@@ -293,9 +323,11 @@ unit rgobj;
              @param(saved)  Array of saved register information
              @param(s)      Registers which might require saving
           }
+{$ifndef newra}
           procedure saveusedintregisters(list:Taasmoutput;
                                          var saved:Tpushedsavedint;
                                          const s:Tsupregset);virtual;
+{$endif}
           procedure saveusedotherregisters(list:Taasmoutput;
                                            var saved:Tpushedsavedother;
                                            const s:Tregisterset);virtual;
@@ -305,13 +337,17 @@ unit rgobj;
              On processors which have instructions which manipulate the stack,
              this routine should be overriden for performance reasons.
           }
+{$ifndef newra}
           procedure restoreusedintregisters(list:Taasmoutput;
                                             const saved:Tpushedsavedint);virtual;
+{$endif}
           procedure restoreusedotherregisters(list:Taasmoutput;
                                               const saved:Tpushedsavedother);virtual;
 
           { used when deciding which registers to use for regvars }
+{$ifndef newra}
           procedure incrementintregisterpushed(const s:Tsupregset);
+{$endif}
           procedure incrementotherregisterpushed(const s: tregisterset);
           procedure clearregistercount;
           procedure resetusableregisters;virtual;
@@ -332,6 +368,7 @@ unit rgobj;
           procedure prepare_colouring;
           procedure epilogue_colouring;
           procedure colour_registers;
+          function spill_registers(list:Taasmoutput;const regs_to_spill:string):boolean;
 {$endif newra}
        protected
           cpu_registers:byte;
@@ -342,6 +379,7 @@ unit rgobj;
           simplifyworklist,freezeworklist,spillworklist:string;
           coalescednodes:string;
           selectstack:string;
+          abtlist:string;
           movelist:array[Tsuperregister] of Pmovelist;
           worklist_moves,active_moves,frozen_moves,
           coalesced_moves,constrained_moves:Tlinkedlist;
@@ -352,7 +390,7 @@ unit rgobj;
               var unusedregs:Tregisterset;var countunusedregs:byte): tregister;
           function getregistergenint(list:Taasmoutput;subreg:Tsubregister;
                                      const lowreg,highreg:Tsuperregister;
-                                     var fusedinproc,fusedbyproc,unusedregs:Tsupregset
+                                     var fusedinproc,{$ifndef newra}fusedbyproc,{$endif}unusedregs:Tsupregset
                                      {$ifndef newra};var countunusedregs:byte{$endif}):Tregister;
           procedure ungetregistergen(list: taasmoutput; const r: tregister;
               const usableregs:tregisterset;var unusedregs: tregisterset; var countunusedregs: byte);
@@ -360,6 +398,10 @@ unit rgobj;
                                         const usableregs:Tsupregset;
                                         var unusedregs:Tsupregset
                                         {$ifndef newra};var countunusedregs:byte{$endif});
+{$ifdef newra}
+          procedure getregisterintinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
+          procedure ungetregisterintinline(list:Taasmoutput;position:Tai;const r:Tregister);
+{$endif}
 {$ifdef TEMPREGDEBUG}
          reg_user   : regvar_ptreearray;
          reg_releaser : regvar_ptreearray;
@@ -388,6 +430,7 @@ unit rgobj;
          procedure freeze;
          procedure select_spill;
          procedure assign_colours;
+         procedure clear_interferences(u:Tsuperregister);
 {$endif}
        end;
 
@@ -495,6 +538,7 @@ unit rgobj;
        fillchar(degree,sizeof(degree),0);
        fillchar(movelist,sizeof(movelist),0);
        worklist_moves:=Tlinkedlist.create;
+       abtlist:='';
 {$endif}
      end;
 
@@ -525,7 +569,7 @@ unit rgobj;
     function Trgobj.getregistergenint(list:Taasmoutput;
                                       subreg:Tsubregister;
                                       const lowreg,highreg:Tsuperregister;
-                                      var fusedinproc,fusedbyproc,unusedregs:Tsupregset
+                                      var fusedinproc,{$ifndef newra}fusedbyproc,{$endif}unusedregs:Tsupregset
                                       {$ifndef newra};var countunusedregs:byte{$endif}):Tregister;
 
 {$ifdef powerpc}
@@ -551,12 +595,12 @@ unit rgobj;
           i:=lowreg
         else
           inc(i);
-        if i in unusedregs then
+        if (i in unusedregs) {$ifdef newra} and (pos(char(i),abtlist)=0) {$endif} then
           begin
             exclude(unusedregs,i);
             include(fusedinproc,i);
-            include(fusedbyproc,i);
           {$ifndef newra}
+            include(fusedbyproc,i);
             dec(countunusedregs);
           {$endif}
             r.enum:=R_INTREGISTER;
@@ -623,7 +667,7 @@ unit rgobj;
 {$ifdef EXTTEMPREGDEBUG}
            begin
              comment(v_debug,'register freed twice '+supreg_name(supreg));
-             testregisters32;
+             testregisters32
              exit;
            end
 {$else EXTTEMPREGDEBUG}
@@ -666,8 +710,8 @@ unit rgobj;
 {$else}
                                 first_supreg,
                                 last_supreg,
-{$endif}
                                 usedintbyproc,
+{$endif}
                                 usedintinproc,
                                 unusedregsint{$ifndef newra},
                                 countunusedregsint{$endif});
@@ -675,8 +719,17 @@ unit rgobj;
       reg_user[result]:=curptree^;
       testregisters32;
 {$endif TEMPREGDEBUG}
+{$ifdef newra}
+      add_constraints(getregisterint.number);
+{$endif}
     end;
 
+{$ifdef newra}
+    procedure Trgobj.add_constraints(reg:Tnewregister);
+
+    begin
+    end;
+{$endif}
 
     procedure trgobj.ungetregisterint(list : taasmoutput; r : tregister);
 
@@ -708,7 +761,9 @@ unit rgobj;
 {$endif newra}
           exclude(unusedregsint,r shr 8);
           include(usedintinproc,r shr 8);
+        {$ifndef newra}
           include(usedintbyproc,r shr 8);
+        {$endif}
           r2.enum:=R_INTREGISTER;
           r2.number:=r;
           list.concat(tai_regalloc.alloc(r2));
@@ -846,6 +901,7 @@ unit rgobj;
       unusedregsfpu:=usableregsfpu;
       unusedregsmm:=usableregsmm;
    {$ifdef newra}
+      savedbyproc:=[];
       for i:=low(Tsuperregister) to high(Tsuperregister) do
         begin
           if igraph.adjlist[i]<>nil then
@@ -857,6 +913,7 @@ unit rgobj;
       fillchar(igraph,sizeof(igraph),0);
       fillchar(degree,sizeof(degree),0);
       worklist_moves.clear;
+      abtlist:='';
    {$endif}
     end;
 
@@ -870,7 +927,7 @@ unit rgobj;
            ungetregisterint(list,ref.index);
       end;
 
-
+{$ifndef newra}
     procedure trgobj.saveintregvars(list:Taasmoutput;const s:Tsupregset);
 
     var r:Tsuperregister;
@@ -887,6 +944,7 @@ unit rgobj;
             store_regvar(list,hr);
           end;
     end;
+{$endif}
 
     procedure trgobj.saveotherregvars(list: taasmoutput; const s: tregisterset);
       var
@@ -906,7 +964,7 @@ unit rgobj;
               store_regvar(list,r);
       end;
 
-
+{$ifndef newra}
     procedure trgobj.saveusedintregisters(list:Taasmoutput;
                                           var saved:Tpushedsavedint;
                                           const s:Tsupregset);
@@ -935,15 +993,14 @@ unit rgobj;
               cg.a_load_reg_ref(list,OS_INT,r2,hr);
               cg.a_reg_dealloc(list,r2);
               include(unusedregsint,r);
-            {$ifndef newra}
               inc(countunusedregsint);
-            {$endif}
             end;
         end;
 {$ifdef TEMPREGDEBUG}
       testregisters32;
 {$endif TEMPREGDEBUG}
     end;
+{$endif}
 
     procedure trgobj.saveusedotherregisters(list: taasmoutput;
         var saved : tpushedsavedother; const s: tregisterset);
@@ -1004,7 +1061,7 @@ unit rgobj;
 {$endif TEMPREGDEBUG}
       end;
 
-
+{$ifndef newra}
     procedure trgobj.restoreusedintregisters(list:Taasmoutput;
                                              const saved:Tpushedsavedint);
 
@@ -1031,9 +1088,7 @@ unit rgobj;
                     may not be real (JM) }
                 else
                   begin
-                  {$ifndef newra}
                     dec(countunusedregsint);
-                  {$endif}
                     exclude(unusedregsint,r);
                   end;
                 tg.UnGetTemp(list,hr);
@@ -1043,6 +1098,7 @@ unit rgobj;
         testregisters32;
 {$endif TEMPREGDEBUG}
       end;
+{$endif}
 
     procedure trgobj.restoreusedotherregisters(list : taasmoutput;
         const saved : tpushedsavedother);
@@ -1104,7 +1160,7 @@ unit rgobj;
 {$endif TEMPREGDEBUG}
       end;
 
-
+{$ifndef newra}
     procedure trgobj.incrementintregisterpushed(const s:Tsupregset);
 
     var regi:Tsuperregister;
@@ -1118,6 +1174,7 @@ unit rgobj;
         end;
 {$endif i386}
     end;
+{$endif}
 
     procedure trgobj.incrementotherregisterpushed(const s:Tregisterset);
 
@@ -1145,14 +1202,18 @@ unit rgobj;
     procedure trgobj.clearregistercount;
 
       begin
+      {$ifndef newra}
         fillchar(reg_pushes_int,sizeof(reg_pushes_int),0);
+      {$endif}
         fillchar(reg_pushes_other,sizeof(reg_pushes_other),0);
 {ifndef i386}
         { all used registers will have to be saved at the start and restored }
         { at the end, but otoh regpara's do not have to be saved to memory   }
         { at the start (there is a move from regpara to regvar most of the   }
         { time though) -> set cost to 100+20                                 }
+      {$ifndef newra}
         filldword(reg_pushes_int[firstsaveintreg],lastsaveintreg-firstsaveintreg+1,120);
+      {$endif}
         filldword(reg_pushes_other[firstsavefpureg],ord(lastsavefpureg)-ord(firstsavefpureg)+1,120);
 {endif not i386}
         fillchar(is_reg_var_other,sizeof(is_reg_var_other),false);
@@ -1254,7 +1315,9 @@ unit rgobj;
         psavedstate(state)^.countusableregsmm := countusableregsmm;
         psavedstate(state)^.usedinproc := usedinproc;
         psavedstate(state)^.usedbyproc := usedbyproc;
+      {$ifndef newra}
         psavedstate(state)^.reg_pushes_int := reg_pushes_int;
+      {$endif}
         psavedstate(state)^.reg_pushes_other := reg_pushes_other;
         psavedstate(state)^.is_reg_var_int := is_reg_var_int;
         psavedstate(state)^.is_reg_var_other := is_reg_var_other;
@@ -1285,7 +1348,9 @@ unit rgobj;
         countusableregsmm := psavedstate(state)^.countusableregsmm;
         usedinproc := psavedstate(state)^.usedinproc;
         usedbyproc := psavedstate(state)^.usedbyproc;
+      {$ifndef newra}
         reg_pushes_int := psavedstate(state)^.reg_pushes_int;
+      {$endif}
         reg_pushes_other := psavedstate(state)^.reg_pushes_other;
         is_reg_var_int := psavedstate(state)^.is_reg_var_int;
         is_reg_var_other := psavedstate(state)^.is_reg_var_other;
@@ -1370,7 +1435,7 @@ unit rgobj;
     var i:Tsuperregister;
 
     begin
-      for i:=1 to 255 do
+      for i:=1 to maxintreg do
         if not(i in unusedregsint) then
           add_edge(u,i);
     end;
@@ -1443,7 +1508,11 @@ unit rgobj;
       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);
+      if ssupreg<>dsupreg then
+        {Avoid adding the same move instruction twice to a single register.}
+        add_to_movelist(dsupreg,i);
+      i.x:=ssupreg;
+      i.y:=dsupreg;
     end;
 
     function Trgobj.move_related(n:Tsuperregister):boolean;
@@ -1469,8 +1538,10 @@ unit rgobj;
     var n:Tsuperregister;
 
     begin
+      {If we have 7 cpu registers, and the degree of a node is 7, we cannot
+       assign it to any of the registers, thus it is significant.}
       for n:=first_imreg to maxintreg do
-        if degree[n]>cpu_registers then
+        if degree[n]>=cpu_registers then
           spillworklist:=spillworklist+char(n)
         else if move_related(n) then
           freezeworklist:=freezeworklist+char(n)
@@ -1518,7 +1589,7 @@ unit rgobj;
 
     var adj:Pstring;
         d:byte;
-        i:byte;
+        i,p:byte;
         n:char;
 
     begin
@@ -1537,8 +1608,14 @@ unit rgobj;
                 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);
+          {Remove the node from the spillworklist.}
+          p:=pos(char(m),spillworklist);
+          if p=0 then
+            internalerror(200305301); {must be found}
+          if length(spillworklist)>1 then
+            spillworklist[p]:=spillworklist[length(spillworklist)];
+          dec(spillworklist[0]);
+
           if move_related(m) then
             freezeworklist:=freezeworklist+char(m)
           else
@@ -1586,7 +1663,7 @@ unit rgobj;
           begin
             m:=adj^[i];
             if (pos(m,selectstack) or pos(m,coalescednodes))=0 then
-              decrement_degree(Tsuperregister(m));
+               decrement_degree(Tsuperregister(m));
           end;
     end;
 
@@ -1716,8 +1793,8 @@ unit rgobj;
             t:=adj^[i];
             if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
               begin
-                add_edge(Tsuperregister(t),u);
                 decrement_degree(Tsuperregister(t));
+                add_edge(Tsuperregister(t),u);
               end;
           end;
       p:=pos(char(u),freezeworklist);
@@ -1882,6 +1959,8 @@ unit rgobj;
                 colour[n]:=k;
                 dec(spillednodes[0]);  {Colour found: no spill.}
                 include(colourednodes,n);
+                if n in usedintinproc then
+                  include(usedintinproc,k);
                 break;
               end;
         end;
@@ -1889,10 +1968,15 @@ unit rgobj;
       for i:=1 to length(coalescednodes) do
         begin
           n:=Tsuperregister(coalescednodes[i]);
-          colour[n]:=colour[get_alias(n)];
+          k:=get_alias(n);
+          colour[n]:=colour[k];
+          if n in usedintinproc then
+            include(usedintinproc,colour[k]);
         end;
+    {$ifdef ra_debug}
       for i:=first_imreg to maxintreg do
         writeln(i:4,'   ',colour[i]:4)
+    {$endif}
     end;
 
     procedure Trgobj.colour_registers;
@@ -1917,7 +2001,33 @@ unit rgobj;
 
     procedure Trgobj.epilogue_colouring;
 
+{
+      procedure move_to_worklist_moves(list:Tlinkedlist);
+
+      var p:Tlinkedlistitem;
+
+      begin
+        p:=list.first;
+        while p<>nil do
+          begin
+            Tmoveins(p).moveset:=ms_worklist_moves;
+            p:=p.next;
+          end;
+        worklist_moves.concatlist(list);
+      end;
+}
+
+    var i:Tsuperregister;
+
     begin
+      worklist_moves.clear;
+{$ifdef Principle_wrong_by_definition}
+      {Move everything back to worklist_moves.}
+      move_to_worklist_moves(active_moves);
+      move_to_worklist_moves(frozen_moves);
+      move_to_worklist_moves(coalesced_moves);
+      move_to_worklist_moves(constrained_moves);
+{$endif}
       active_moves.destroy;
       active_moves:=nil;
       frozen_moves.destroy;
@@ -1926,10 +2036,303 @@ unit rgobj;
       coalesced_moves:=nil;
       constrained_moves.destroy;
       constrained_moves:=nil;
+      for i:=0 to 255 do
+        if movelist[i]<>nil then
+          begin
+            dispose(movelist[i]);
+            movelist[i]:=0;
+          end;
     end;
 
-{$endif newra}
 
+    procedure Trgobj.clear_interferences(u:Tsuperregister);
+
+    {Remove node u from the interference graph and remove all collected
+     move instructions it is associated with.}
+
+    var i:byte; 
+        j,k,count:cardinal;
+        v:Tsuperregister;
+        m,n:Tmoveins;
+
+    begin
+      if igraph.adjlist[u]<>nil then
+        begin
+          for i:=1 to length(igraph.adjlist[u]^) do
+            begin
+              v:=Tsuperregister(igraph.adjlist[u]^[i]);
+              {Remove (u,v) and (v,u) from bitmap.}
+              exclude(igraph.bitmap[u],v);
+              exclude(igraph.bitmap[v],u);
+              {Remove (v,u) from adjacency list.}
+              if igraph.adjlist[v]<>nil then
+                begin
+                  delete(igraph.adjlist[v]^,pos(char(v),igraph.adjlist[v]^),1);
+                  if length(igraph.adjlist[v]^)=0 then
+                    begin
+                      dispose(igraph.adjlist[v]);
+                      igraph.adjlist[v]:=nil;
+                    end;
+                end;
+            end;
+          {Remove ( u,* ) from adjacency list.}
+          dispose(igraph.adjlist[u]);
+          igraph.adjlist[u]:=nil;
+        end;
+{$ifdef Principle_wrong_by_definition}
+      {Now remove the moves.}
+      if movelist[u]<>nil then
+        begin
+          for j:=0 to movelist[u]^.count-1 do
+            begin
+              m:=Tmoveins(movelist[u]^.data[j]);
+              {Get the other register of the move instruction.}
+              v:=m.instruction.oper[0].reg.number shr 8;
+              if v=u then
+                v:=m.instruction.oper[1].reg.number shr 8;
+              repeat
+                repeat
+                  if (u<>v) and (movelist[v]<>nil) then
+                    begin
+                      {Remove the move from it's movelist.}
+                      count:=movelist[v]^.count-1;
+                      for k:=0 to count do
+                        if m=movelist[v]^.data[k] then
+                          begin
+                            if k<>count then
+                              movelist[v]^.data[k]:=movelist[v]^.data[count];
+                            dec(movelist[v]^.count);
+                            if count=0 then
+                              begin
+                                dispose(movelist[v]);
+                                movelist[v]:=nil;
+                              end;
+                            break;
+                          end;
+                    end;
+                  {The complexity is enourmous: the register might have been
+                   coalesced. In that case it's movelists have been added to
+                   it's coalescing alias. (DM)}
+                  v:=alias[v];
+                until v=0;
+                {And also register u might have been coalesced.}
+                u:=alias[u];
+              until u=0;
+
+              case m.moveset of
+                ms_coalesced_moves:
+                  coalesced_moves.remove(m);
+                ms_constrained_moves:
+                  constrained_moves.remove(m);
+                ms_frozen_moves:
+                  frozen_moves.remove(m);
+                ms_worklist_moves:
+                  worklist_moves.remove(m);
+                ms_active_moves:
+                  active_moves.remove(m);
+              end;
+            end;
+          dispose(movelist[u]);
+          movelist[u]:=nil;
+        end;
+{$endif}
+    end;
+
+    procedure Trgobj.getregisterintinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
+
+    var i:Tsuperregister;
+        r:Tregister;
+
+    begin
+      if not (lastintreg in [first_imreg..last_imreg]) then
+        lastintreg:=first_imreg;
+      i:=lastintreg;
+      repeat
+        if i=last_imreg then
+          i:=first_imreg
+        else
+          inc(i);
+        if (i in unusedregsint) and (pos(char(i),abtlist)=0) then
+          begin
+            exclude(unusedregsint,i);
+            include(usedintinproc,i);
+            r.enum:=R_INTREGISTER;
+            r.number:=i shl 8 or subreg;
+            if position=nil then
+              list.insert(Tai_regalloc.alloc(r))
+            else
+              list.insertafter(Tai_regalloc.alloc(r),position);
+            result:=r;
+            lastintreg:=i;
+            if i>maxintreg then
+              maxintreg:=i;
+            add_edges_used(i);
+            add_constraints(result.number);
+            exit;
+          end;
+      until i=lastintreg;
+      internalerror(10);
+    end;
+
+    {In some cases we can get in big trouble. See this example:
+
+     ; register reg23d released
+     ; register eax allocated
+     ; register ebx allocated
+     ; register ecx allocated
+     ; register edx allocated
+     ; register esi allocated
+     ; register edi allocated
+     call [reg23d]
+
+    This code is ok, *except* when reg23d is spilled. In that case the
+    spilled would introduce a help register which can never get
+    allocated to a real register because it interferes with all of them.
+
+    To solve this we introduce the ABT ("avoid big trouble :)" ) registers.
+
+    If you allocate an ABT register you get a register that has less
+    than cpu_register interferences and will not be allocated ever again
+    by the normal register get procedures. In other words it is for sure it
+    will never get spilled.}
+
+    function Trgobj.getabtregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
+
+    var i:Tsuperregister;
+        r:Tregister;
+        found:boolean;
+
+    begin
+      if not (lastintreg in [first_imreg..last_imreg]) then
+        lastintreg:=first_imreg;
+      found:=false;
+      for i:=1 to length(abtlist) do
+        if Tsuperregister(abtlist[i]) in unusedregsint then
+          begin
+            found:=true;
+            break;
+          end;
+      i:=lastintreg;
+      repeat
+        if i=last_imreg then
+          i:=first_imreg
+        else
+          inc(i);
+        if (i in unusedregsint) and ((igraph.adjlist[i]=nil) or (length(igraph.adjlist[i]^)<cpu_registers)) then
+          begin
+            found:=true;
+            break;
+          end;
+      until i=lastintreg;
+      if found then
+        begin
+          exclude(unusedregsint,i);
+          include(usedintinproc,i);
+          r.enum:=R_INTREGISTER;
+          r.number:=i shl 8 or cgsize2subreg(size);
+          list.concat(Tai_regalloc.alloc(r));
+          getabtregisterint:=r;
+          lastintreg:=i;
+          if i>maxintreg then
+            maxintreg:=i;
+          add_edges_used(i);
+          if pos(char(i),abtlist)=0 then
+            abtlist:=abtlist+char(i);
+        end
+      else
+        internalerror(10);
+{$ifdef newra}
+      add_constraints(getabtregisterint.number);
+{$endif}
+    end;
+
+    procedure Trgobj.ungetregisterintinline(list:Taasmoutput;position:Tai;const r:Tregister);
+
+    var supreg:Tsuperregister;
+
+    begin
+      if r.enum<=lastreg then
+        internalerror(2003010803);
+      supreg:=r.number shr 8;
+      { takes much time }
+      include(unusedregsint,supreg);
+      if position=nil then
+        list.insert(Tai_regalloc.dealloc(r))
+      else
+        list.insertafter(Tai_regalloc.dealloc(r),position);
+      add_edges_used(supreg);
+    end;
+
+    function Trgobj.spill_registers(list:Taasmoutput;const regs_to_spill:string):boolean;
+
+    {Returns true if any help registers have been used.}
+
+    var i:byte;
+        r:Tsuperregister;
+        p,q:Tai;
+        regs_to_spill_set:Tsupregset;
+        spill_temps:^Tspill_temp_list;
+
+    begin
+      spill_registers:=false;
+      unusedregsint:=[0..255];
+      fillchar(degree,sizeof(degree),0);
+      if current_procinfo.framepointer.number=NR_FRAME_POINTER_REG then
+        {Make sure the register allocator won't allocate registers into ebp.}
+        exclude(rg.unusedregsint,RS_FRAME_POINTER_REG);
+      new(spill_temps);
+      fillchar(spill_temps^,sizeof(spill_temps^),0);
+      regs_to_spill_set:=[];
+      for i:=1 to length(regs_to_spill) do
+        begin
+          {Alternative representation.}
+          include(regs_to_spill_set,Tsuperregister(regs_to_spill[i]));
+          {Clear all interferences of the spilled register.}
+          clear_interferences(Tsuperregister(regs_to_spill[i]));
+          {Get a temp for the spilled register.}
+          tg.gettemp(list,4,tt_noreuse,spill_temps^[Tsuperregister(regs_to_spill[i])]);
+        end;
+      p:=Tai(list.first);
+      while assigned(p) do
+        begin
+          case p.typ of
+            ait_regalloc:
+              begin
+                {A register allocation of a spilled register can be removed.}
+                if (Tai_regalloc(p).reg.number shr 8) in regs_to_spill_set then
+                  begin
+                    q:=p;
+                    p:=Tai(p.next);
+                    list.remove(q);
+                    continue;
+                  end
+                else
+                  if Tai_regalloc(p).allocation then
+                    exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
+                  else
+                    include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
+              end;
+            ait_instruction:
+              begin
+                if Taicpu_abstract(p).spill_registers(list,@getregisterintinline,
+                                                      @ungetregisterintinline,
+                                                      regs_to_spill_set,
+                                                      unusedregsint,
+                                                      spill_temps^) then
+                  spill_registers:=true;
+                if Taicpu_abstract(p).is_move then
+                  add_move_instruction(Taicpu(p));
+              end;
+          end;
+          p:=Tai(p.next);
+        end;
+      for i:=1 to length(regs_to_spill) do
+        begin
+          tg.ungettemp(list,spill_temps^[Tsuperregister(regs_to_spill[i])]);
+        end;
+      dispose(spill_temps);
+    end;
+{$endif newra}
 
 {****************************************************************************
                                   TReference
@@ -2060,7 +2463,10 @@ end.
 
 {
   $Log$
-  Revision 1.48  2003-06-01 21:38:06  peter
+  Revision 1.49  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.48  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/symdef.pas

@@ -764,7 +764,8 @@ implementation
 {$endif GDB}
        fmodule,
        { other }
-       gendef
+       gendef,
+       rgobj
        ;
 
 
@@ -3420,7 +3421,7 @@ implementation
           end;
          lastref:=defref;
        { first, we assume that all registers are used }
-         usedintregisters:=ALL_INTREGISTERS;
+         usedintregisters:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
          usedotherregisters:=ALL_REGISTERS;
          forwarddef:=true;
          interfacedef:=false;
@@ -3555,7 +3556,7 @@ implementation
          { set all registers to used for simplified compilation PM }
          if simplify_ppu then
            begin
-             usedintregisters:=ALL_INTREGISTERS;
+             usedintregisters:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
              usedotherregisters:=ALL_REGISTERS;
            end;
 
@@ -5740,7 +5741,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.147  2003-06-02 22:55:28  florian
+  Revision 1.148  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.147  2003/06/02 22:55:28  florian
     * classes and interfaces can be stored in integer registers
 
   Revision 1.146  2003/05/26 21:17:18  peter

compiler/tgobj.pas

@@ -66,8 +66,8 @@ unit tgobj;
        private
           { contains all free temps using nextfree links }
           tempfreelist  : ptemprecord;
-          function AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
-          procedure FreeTemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
+          function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
+          procedure freetemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
        public
           { contains all temps }
           templist      : ptemprecord;
@@ -88,11 +88,11 @@ unit tgobj;
           procedure setfirsttemp(l : longint);
           function gettempsize : longint;
 
-          procedure GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
-          procedure UnGetTemp(list: taasmoutput; const ref : treference);
+          procedure gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
+          procedure ungettemp(list: taasmoutput; const ref : treference);
 
-          function SizeOfTemp(list: taasmoutput; const ref: treference): longint;
-          function ChangeTempType(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean;
+          function sizeoftemp(list: taasmoutput; const ref: treference): longint;
+          function changetemptype(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean;
 
           {# Returns TRUE if the reference ref is allocated in temporary volatile memory space,
              otherwise returns FALSE.
@@ -244,7 +244,7 @@ unit tgobj;
          if freetype=tt_none then
           internalerror(200208201);
          { Align needed size on 4 bytes }
-         size:=Align(size,4);
+         size:=align(size,4);
          { First check the tmpfreelist, but not when
            we don't want to reuse an already allocated block }
          if assigned(tempfreelist) and
@@ -438,7 +438,7 @@ unit tgobj;
       end;
 
 
-    procedure ttgobj.GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
+    procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
 
     begin
       reference_reset_base(ref,current_procinfo.framepointer,alloctemp(list,size,temptype));
@@ -471,7 +471,7 @@ unit tgobj;
       end;
 
 
-    function ttgobj.SizeOfTemp(list: taasmoutput; const ref: treference): longint;
+    function ttgobj.sizeoftemp(list: taasmoutput; const ref: treference): longint;
       var
          hp : ptemprecord;
       begin
@@ -481,13 +481,13 @@ unit tgobj;
            begin
              if (hp^.pos=ref.offset) then
                begin
-                 SizeOfTemp := hp^.size;
+                 sizeoftemp := hp^.size;
                  exit;
                end;
              hp := hp^.next;
            end;
 {$ifdef EXTDEBUG}
-         Comment(V_Debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.offset)+' not found !');
+         comment(v_debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.offset)+' not found !');
          list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found'));
 {$endif}
       end;
@@ -554,7 +554,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.34  2003-05-17 13:30:08  jonas
+  Revision 1.35  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.34  2003/05/17 13:30:08  jonas
     * changed tt_persistant to tt_persistent :)
     * tempcreatenode now doesn't accept a boolean anymore for persistent
       temps, but a ttemptype, so you can also create ansistring temps etc

compiler/x86/aasmcpu.pas

@@ -194,6 +194,14 @@ interface
          function  Pass1(offset:longint):longint;virtual;
          procedure Pass2(sec:TAsmObjectdata);virtual;
          procedure SetOperandOrder(order:TOperandOrder);
+         function is_nop:boolean;override;
+         function is_move:boolean;override;
+         function spill_registers(list:Taasmoutput;
+                                  rgget:Trggetproc;
+                                  rgunget:Trgungetproc;
+                                  r:Tsupregset;
+                                  var unusedregsint:Tsupregset;
+                                  const spilltemplist:Tspill_temp_list):boolean;override;
       protected
          procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
          procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
@@ -212,10 +220,8 @@ interface
          function  NeedAddrPrefix(opidx:byte):boolean;
          procedure Swapoperands;
     {$endif NOAG386BIN}
-         function is_nop:boolean;override;
       end;
 
-
     procedure InitAsm;
     procedure DoneAsm;
 
@@ -1968,12 +1974,373 @@ implementation
 
     begin
       {We do not check the number of operands; we assume that nobody constructs
-       a mov or xchg instruction with less than 2 operands.}
+       a mov or xchg instruction with less than 2 operands. (DM)}
       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;
 
+    function Taicpu.is_move:boolean;
+
+    begin
+      {We do not check the number of operands; we assume that nobody constructs
+       a mov, movzx or movsx instruction with less than 2 operands. Note that
+       a move between a reference and a register is not a move that is of
+       interrest to the register allocation, therefore we only return true
+       for a move between two registers. (DM)}
+      is_move:=((opcode=A_MOV) or (opcode=A_MOVZX) or (opcode=A_MOVSX)) and
+        ((oper[0].typ=top_reg) and (oper[1].typ=top_reg));
+    end;
+
+    function Taicpu.spill_registers(list:Taasmoutput;
+                                    rgget:Trggetproc;
+                                    rgunget:Trgungetproc;
+                                    r:Tsupregset;
+                                    var unusedregsint:Tsupregset;
+                                    const spilltemplist:Tspill_temp_list):boolean;
+
+    {Spill the registers in r in this instruction. Returns true if any help
+     registers are used. This procedure has become one big hack party, because
+     of the huge amount of situations you can have. The irregularity of the i386
+     instruction set doesn't help either. (DM)}
+
+
+      function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
+
+      var back:Tsupregset;
+
+      begin
+        back:=unusedregsint;
+        get_insert_pos:=p;
+        while (p<>nil) and (p.typ=ait_regalloc) do
+          begin
+            {Rewind the register allocation.}
+            if Tai_regalloc(p).allocation then
+              include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
+            else
+              begin
+                exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
+                if Tai_regalloc(p).reg.number shr 8=huntfor1 then
+                  begin
+                    get_insert_pos:=Tai(p.previous);
+                    back:=unusedregsint;
+                  end;
+                if Tai_regalloc(p).reg.number shr 8=huntfor2 then
+                  begin
+                    get_insert_pos:=Tai(p.previous);
+                    back:=unusedregsint;
+                  end;
+                if Tai_regalloc(p).reg.number shr 8=huntfor3 then
+                  begin
+                    get_insert_pos:=Tai(p.previous);
+                    back:=unusedregsint;
+                  end;
+              end;
+            p:=Tai(p.previous);
+          end;
+        unusedregsint:=back;
+      end;
+
+      procedure forward_allocation(p:Tai);
+
+      begin
+        {Forward the register allocation again.}
+        while (p<>self) do
+          begin
+            if p.typ<>ait_regalloc then
+              internalerror(200305311);
+            if Tai_regalloc(p).allocation then
+              exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
+            else
+              include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
+            p:=Tai(p.next);
+          end;
+      end;
+
+    var i:byte;
+        supreg:Tsuperregister;
+        subreg:Tsubregister;
+        helpreg:Tregister;
+        helpins:Taicpu;
+        op:Tasmop;
+        hopsize:Topsize;
+        pos:Tai;
+
+    begin
+      {Situation examples are in intel notation, so operand order:
+       mov    eax       ,    ebx
+              ^^^            ^^^
+              oper[1]        oper[0]
+      (DM)}
+      spill_registers:=false;
+      case ops of
+        1:
+          begin
+            if oper[0].typ=top_reg then
+              begin
+                supreg:=oper[0].reg.number shr 8;
+                if supreg in r then
+                  begin
+                    {Situation example:
+                     push r20d              ; r20d must be spilled into [ebp-12]
+
+                    Change into:
+                     push [ebp-12]          ; Replace register by reference }
+{                    hopsize:=reg2opsize(oper[0].reg);}
+                    oper[0].typ:=top_ref;
+                    new(oper[0].ref);
+                    oper[0].ref^:=spilltemplist[supreg];
+{                    oper[0].ref^.size:=hopsize;}
+                  end;
+              end;
+            if oper[0].typ=top_ref then
+              begin
+                supreg:=oper[0].ref^.base.number shr 8;
+                if supreg in r then
+                  begin
+                    {Situation example:
+                     push [r21d+4*r22d]        ; r21d must be spilled into [ebp-12]
+
+                     Change into:
+
+                     mov r23d,[ebp-12]         ; Use a help register
+                     push [r23d+4*r22d]       ; Replace register by helpregister }
+                    subreg:=oper[0].ref^.base.number and $ff;
+                    if oper[0].ref^.index.number=NR_NO then
+                      pos:=Tai(previous)
+                    else
+                      pos:=get_insert_pos(Tai(previous),oper[0].ref^.index.number shr 8,0,0);
+                    rgget(list,pos,subreg,helpreg);
+                    spill_registers:=true;
+                    helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].ref^.base),spilltemplist[supreg],helpreg);
+                    if pos=nil then
+                      list.insertafter(helpins,list.first)
+                    else
+                      list.insertafter(helpins,pos.next);
+                    rgunget(list,helpins,helpreg);
+                    forward_allocation(Tai(helpins.next));
+                    oper[0].ref^.base:=helpreg;
+                  end;
+                supreg:=oper[0].ref^.index.number shr 8;
+                if supreg in r then
+                  begin
+                    {Situation example:
+                     push [r21d+4*r22d]        ; r22d must be spilled into [ebp-12]
+
+                     Change into:
+
+                     mov r23d,[ebp-12]         ; Use a help register
+                     push [r21d+4*r23d]        ; Replace register by helpregister }
+                    subreg:=oper[0].ref^.index.number and $ff;
+                    if oper[0].ref^.base.number=NR_NO then
+                      pos:=Tai(previous)
+                    else
+                      pos:=get_insert_pos(Tai(previous),oper[0].ref^.base.number shr 8,0,0);
+                    rgget(list,pos,subreg,helpreg);
+                    spill_registers:=true;
+                    helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].ref^.index),spilltemplist[supreg],helpreg);
+                    if pos=nil then
+                      list.insertafter(helpins,list.first)
+                    else
+                      list.insertafter(helpins,pos.next);
+                    rgunget(list,helpins,helpreg);
+                    forward_allocation(Tai(helpins.next));
+                    oper[0].ref^.index:=helpreg;
+                  end;
+                end;
+          end;
+        2:
+          begin
+            if oper[0].typ=top_reg then
+              begin
+                supreg:=oper[0].reg.number shr 8;
+                subreg:=oper[0].reg.number and $ff;
+                if supreg in r then
+                  if oper[1].typ=top_ref then
+                    begin
+                      {Situation example:
+                       add [r20d],r21d      ; r21d must be spilled into [ebp-12]
+
+                       Change into:
+
+                       mov r22d,[ebp-12]    ; Use a help register
+                       add [r20d],r22d      ; Replace register by helpregister }
+                      pos:=get_insert_pos(Tai(previous),oper[0].reg.number shr 8,
+                                          oper[1].ref^.base.number shr 8,oper[1].ref^.index.number shr 8);
+                      rgget(list,pos,subreg,helpreg);
+                      spill_registers:=true;
+                      helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].reg),spilltemplist[supreg],helpreg);
+                      if pos=nil then
+                        list.insertafter(helpins,list.first)
+                      else
+                        list.insertafter(helpins,pos.next);
+                      oper[0].reg:=helpreg;
+                      rgunget(list,helpins,helpreg);
+                      forward_allocation(Tai(helpins.next));
+                    end
+                  else
+                    begin
+                      {Situation example:
+                       add r20d,r21d        ; r21d must be spilled into [ebp-12]
+
+                       Change into:
+
+                       add r20d,[ebp-12]    ; Replace register by reference }
+                      oper[0].typ:=top_ref;
+                      new(oper[0].ref);
+                      oper[0].ref^:=spilltemplist[supreg];
+                    end;
+              end;
+            if oper[1].typ=top_reg then
+              begin
+                supreg:=oper[1].reg.number shr 8;
+                subreg:=oper[1].reg.number and $ff;
+                if supreg in r then
+                  begin
+                    if oper[0].typ=top_ref then
+                      begin
+                        {Situation example:
+                         add r20d,[r21d]      ; r20d must be spilled into [ebp-12]
+  
+                         Change into:
+  
+                         mov r22d,[r21d]      ; Use a help register
+                         add [ebp-12],r22d    ; Replace register by helpregister }
+                        pos:=get_insert_pos(Tai(previous),oper[0].ref^.base.number shr 8,
+                                            oper[0].ref^.index.number shr 8,0);
+                        rgget(list,pos,subreg,helpreg);
+                        spill_registers:=true;
+                        op:=A_MOV;
+                        hopsize:=opsize;  {Save old value...}
+                        if (opcode=A_MOVZX) or (opcode=A_MOVSX) or (opcode=A_LEA) then
+                          begin
+                            {Because 'movzx memory,register' does not exist...}
+                            op:=opcode;
+                            opcode:=A_MOV;
+                            opsize:=reg2opsize(oper[1].reg);
+                          end;
+                        helpins:=Taicpu.op_ref_reg(op,hopsize,oper[0].ref^,helpreg);
+                        if pos=nil then
+                          list.insertafter(helpins,list.first)
+                        else
+                          list.insertafter(helpins,pos.next);
+                        dispose(oper[0].ref);
+                        oper[0].typ:=top_reg;
+                        oper[0].reg:=helpreg;
+                        oper[1].typ:=top_ref;
+                        new(oper[1].ref);
+                        oper[1].ref^:=spilltemplist[supreg];
+                        rgunget(list,helpins,helpreg);
+                        forward_allocation(Tai(helpins.next));
+                      end
+                    else
+                      begin
+                        {Situation example:
+                         add r20d,r21d        ; r20d must be spilled into [ebp-12]
+  
+                         Change into:
+  
+                         add [ebp-12],r21d    ; Replace register by reference }
+                        oper[1].typ:=top_ref;
+                        new(oper[1].ref);
+                        oper[1].ref^:=spilltemplist[supreg];
+                      end;
+                    {The i386 instruction set never gets boring... IMUL does
+                     not support a memory location as destination. Check if
+                     the opcode is IMUL and fix it. (DM)}
+                    if opcode=A_IMUL then
+                      begin
+                        {Yikes! We just changed the destination register into
+                         a memory location above here.
+
+                         Situation example:
+
+                         imul [ebp-12],r21d   ; We need a help register
+
+                         Change into:
+
+                         mov r22d,[ebp-12]    ; Use a help instruction (only for IMUL)
+                         imul r22d,r21d       ; Replace reference by helpregister
+                         mov [ebp-12],r22d    ; Use another help instruction}
+                        rgget(list,Tai(previous),subreg,helpreg);
+                        {First help instruction.}
+                        helpins:=Taicpu.op_ref_reg(A_MOV,opsize,oper[1].ref^,helpreg);
+                        if previous=nil then
+                          list.insert(helpins)
+                        else
+                          list.insertafter(helpins,previous);
+                        {Second help instruction.}
+                        helpins:=Taicpu.op_reg_ref(A_MOV,opsize,helpreg,oper[1].ref^);
+                        dispose(oper[1].ref);
+                        oper[1].typ:=top_reg;
+                        oper[1].reg:=helpreg;
+                        list.insertafter(helpins,self);
+                      end;
+                  end;
+              end;
+            for i:=0 to 1 do
+              if oper[i].typ=top_ref then
+                begin
+                  supreg:=oper[i].ref^.base.number shr 8;
+                  if supreg in r then
+                    begin
+                      {Situation example:
+                       add r20d,[r21d+4*r22d]    ; r21d must be spilled into [ebp-12]
+
+                       Change into:
+
+                       mov r23d,[ebp-12]         ; Use a help register
+                       add r20d,[r23d+4*r22d]    ; Replace register by helpregister }
+                      subreg:=oper[i].ref^.base.number and $ff;
+                      if i=1 then
+                        pos:=get_insert_pos(Tai(previous),oper[i].ref^.index.number shr 8,oper[0].reg.number shr 8,0)
+                      else
+                        pos:=get_insert_pos(Tai(previous),oper[i].ref^.index.number shr 8,0,0);
+                      rgget(list,pos,subreg,helpreg);
+                      spill_registers:=true;
+                      helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[i].ref^.base),spilltemplist[supreg],helpreg);
+                      if pos=nil then
+                        list.insertafter(helpins,list.first)
+                      else
+                        list.insertafter(helpins,pos.next);
+                      oper[i].ref^.base:=helpreg;
+                      rgunget(list,helpins,helpreg);
+                      forward_allocation(Tai(helpins.next));
+                  end;
+                  supreg:=oper[i].ref^.index.number shr 8;
+                  if supreg in r then
+                    begin
+                      {Situation example:
+                       add r20d,[r21d+4*r22d]    ; r22d must be spilled into [ebp-12]
+
+                       Change into:
+
+                       mov r23d,[ebp-12]         ; Use a help register
+                       add r20d,[r21d+4*r23d]    ; Replace register by helpregister }
+                      subreg:=oper[i].ref^.index.number and $ff;
+                      if i=1 then
+                        pos:=get_insert_pos(Tai(previous),oper[i].ref^.base.number shr 8,oper[0].reg.number shr 8,0)
+                      else
+                        pos:=get_insert_pos(Tai(previous),oper[i].ref^.base.number shr 8,0,0);
+                      rgget(list,pos,subreg,helpreg);
+                      spill_registers:=true;
+                      helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[i].ref^.index),spilltemplist[supreg],helpreg);
+                      if pos=nil then
+                        list.insertafter(helpins,list.first)
+                      else
+                        list.insertafter(helpins,pos.next);
+                      oper[i].ref^.index:=helpreg;
+                      rgunget(list,helpins,helpreg);
+                      forward_allocation(Tai(helpins.next));
+                    end;
+                end;
+          end;
+        3:
+          begin
+            {$warning todo!!}
+          end;
+      end;
+    end;
 
 {*****************************************************************************
                               Instruction table
@@ -2024,7 +2391,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2003-05-30 23:57:08  peter
+  Revision 1.5  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.4  2003/05/30 23:57:08  peter
     * more sparc cleanup
     * accumulator removed, splitted in function_return_reg (called) and
       function_result_reg (caller)

compiler/x86/cgx86.pas

@@ -1800,21 +1800,33 @@ unit cgx86;
     var r,rsp:Tregister;
 
     begin
-        r.enum:=R_INTREGISTER;
-        r.number:=NR_EBP;
-        rsp.enum:=R_INTREGISTER;
-        rsp.number:=NR_ESP;
-        list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
-        list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,rsp,r));
-        if localsize>0 then
-          g_stackpointer_alloc(list,localsize);
+      r.enum:=R_INTREGISTER;
+      r.number:=NR_EBP;
+    {$ifdef newra}
+      list.concat(tai_regalloc.alloc(r));
+      include(rg.savedbyproc,RS_EBP);
+    {$endif}
+      rsp.enum:=R_INTREGISTER;
+      rsp.number:=NR_ESP;
+      list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
+      list.concat(Taicpu.op_reg_reg(A_MOV,S_L,rsp,r));
+      if localsize>0 then
+        g_stackpointer_alloc(list,localsize);
     end;
 
 
     procedure tcgx86.g_restore_frame_pointer(list : taasmoutput);
-      begin
-        list.concat(Taicpu.Op_none(A_LEAVE,S_NO));
-      end;
+
+    var r:Tregister;
+
+    begin
+    {$ifdef newra}
+      r.enum:=R_INTREGISTER;
+      r.number:=NR_EBP;
+      list.concat(tai_regalloc.dealloc(r));
+    {$endif}
+      list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+    end;
 
 
     procedure tcgx86.g_return_from_proc(list : taasmoutput;parasize : aword);
@@ -1847,14 +1859,19 @@ unit cgx86;
     var r:Tregister;
 
     begin
-        r.enum:=R_INTREGISTER;
-        r.number:=NR_EBX;
-        if (RS_EBX in usedinproc) then
-          list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
-        r.number:=NR_ESI;
-        list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
-        r.number:=NR_EDI;
-        list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
+      r.enum:=R_INTREGISTER;
+      r.number:=NR_EBX;
+      if (RS_EBX in usedinproc) then
+        list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
+      r.number:=NR_ESI;
+      list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
+      r.number:=NR_EDI;
+      list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
+    {$ifdef newra}
+      include(rg.savedbyproc,RS_EBX);
+      include(rg.savedbyproc,RS_ESI);
+      include(rg.savedbyproc,RS_EDI);
+    {$endif}
     end;
 
 
@@ -1936,7 +1953,10 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.49  2003-06-01 21:38:07  peter
+  Revision 1.50  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.49  2003/06/01 21:38:07  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/x86/cpubase.pas

@@ -170,7 +170,11 @@ uses
 
       {Number of first and last superregister.}
       first_supreg    = $01;
+{$ifdef x86_64}
       last_supreg     = $10;
+{$else}
+      last_supreg     = $08;
+{$endif}
       {Number of first and last imaginary register.}
       first_imreg     = $12;
       last_imreg      = $ff;
@@ -712,7 +716,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2003-05-30 23:57:08  peter
+  Revision 1.6  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.5  2003/05/30 23:57:08  peter
     * more sparc cleanup
     * accumulator removed, splitted in function_return_reg (called) and
       function_result_reg (caller)

compiler/x86_64/cpubase.inc

@@ -165,6 +165,8 @@ const
       {# Stack pointer register }
       NR_STACK_POINTER_REG = NR_RSP;
       {# Frame pointer register }
+      frame_pointer_reg = R_RBP;
+      RS_FRAME_POINTER_REG = RS_EBP;
       NR_FRAME_POINTER_REG = NR_RBP;
       { Register for addressing absolute data in a position independant way,
         such as in PIC code. The exact meaning is ABI specific. For
@@ -205,7 +207,10 @@ const
 
 {
   $Log$
-  Revision 1.5  2003-05-31 15:05:28  peter
+  Revision 1.6  2003-06-03 13:01:59  daniel
+    * Register allocator finished
+
+  Revision 1.5  2003/05/31 15:05:28  peter
     * FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
 
   Revision 1.4  2003/05/30 23:57:08  peter