* newra compiles for sparc

compiler/cgbase.pas

@@ -114,10 +114,14 @@ unit cgbase;
           constructor create(aparent:tprocinfo);virtual;
           destructor destroy;override;
 
-          procedure allocate_interrupt_stackframe;virtual;
+          procedure allocate_interrupt_parameter;virtual;
 
           procedure allocate_implicit_parameter;virtual;
 
+          { Allocate framepointer so it can not be used by the
+            register allocator }
+          procedure allocate_framepointer;virtual;
+
           { Does the necessary stuff before a procedure body is compiled }
           procedure handle_body_start;virtual;
 
@@ -336,7 +340,12 @@ implementation
       end;
 
 
-    procedure tprocinfo.allocate_interrupt_stackframe;
+    procedure tprocinfo.allocate_interrupt_parameter;
+      begin
+      end;
+
+
+    procedure tprocinfo.allocate_framepointer;
       begin
       end;
 
@@ -539,7 +548,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2003-06-09 12:23:29  peter
+  Revision 1.55  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.54  2003/06/09 12:23:29  peter
     * init/final of procedure data splitted from genentrycode
     * use asmnode getposition to insert final at the correct position
       als for the implicit try...finally

compiler/cgobj.pas

@@ -1269,7 +1269,7 @@ unit cgobj;
             begin
 {$ifdef newra}
               tmpreg := rg.getregisterint(list,size);
-              a_load_ref_reg(list,size,loc.reference,tmpreg);
+              a_load_ref_reg(list,size,size,loc.reference,tmpreg);
               a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
               rg.ungetregisterint(list,tmpreg);
 {$else newra}
@@ -1718,7 +1718,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.109  2003-06-07 18:57:04  jonas
+  Revision 1.110  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.109  2003/06/07 18:57:04  jonas
     + added freeintparaloc
     * ppc get/freeintparaloc now check whether the parameter regs are
       properly allocated/deallocated (and get an extra list para)

compiler/i386/cpupi.pas

@@ -34,6 +34,7 @@ unit cpupi;
     type
        ti386procinfo = class(tcgprocinfo)
           procedure allocate_interrupt_stackframe;override;
+          procedure allocate_framepointer;override;
        end;
 
 
@@ -50,12 +51,28 @@ unit cpupi;
          inc(procdef.parast.address_fixup,8+6*4+4*2);
       end;
 
+
+    procedure ti386procinfo.allocate_framepointer;
+      begin
+        if 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;
+      end;
+
+
 begin
    cprocinfo:=ti386procinfo;
 end.
 {
   $Log$
-  Revision 1.5  2003-05-25 10:26:15  peter
+  Revision 1.6  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.5  2003/05/25 10:26:15  peter
     * fix interrupt stack allocation
 
   Revision 1.4  2003/05/22 21:32:29  peter

compiler/ncgadd.pas

@@ -96,13 +96,17 @@ interface
         secondpass(left);
 
         { are too few registers free? }
+{$ifndef newra}
         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+{$endif}
         if location.loc=LOC_FPUREGISTER then
           pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
         else
           pushedfpu:=false;
         secondpass(right);
+{$ifndef newra}
         maybe_restore(exprasmlist,left.location,pushedregs);
+{$endif}
         if pushedfpu then
           begin
             tmpreg := rg.getregisterfpu(exprasmlist,left.location.size);
@@ -240,7 +244,11 @@ interface
                       left.location.register,location.register)
                   else
                     begin
+{$ifdef newra}
+                      tmpreg := rg.getregisterint(exprasmlist,size);
+{$else}
                       tmpreg := cg.get_scratch_reg_int(exprasmlist,size);
+{$endif}
                       cg.a_load_const_reg(exprasmlist,OS_INT,1,tmpreg);
                       cg.a_op_reg_reg(exprasmlist,OP_SHL,OS_INT,
                         right.location.register,tmpreg);
@@ -250,7 +258,11 @@ interface
                       else
                         cg.a_op_const_reg_reg(exprasmlist,OP_OR,OS_INT,
                           aword(left.location.value),tmpreg,location.register);
+{$ifdef newra}
+                      rg.ungetregisterint(exprasmlist,tmpreg);
+{$else}
                       cg.free_scratch_reg(exprasmlist,tmpreg);
+{$endif}
                     end;
                   opdone := true;
                 end
@@ -280,13 +292,21 @@ interface
                 begin
                   if left.location.loc = LOC_CONSTANT then
                     begin
+{$ifdef newra}
+                      tmpreg := rg.getregisterint(exprasmlist,OS_INT);
+{$else}
                       tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+{$endif}
                       cg.a_load_const_reg(exprasmlist,OS_INT,
                         aword(left.location.value),tmpreg);
                       cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_INT,right.location.register,right.location.register);
                       cg.a_op_reg_reg(exprasmlist,OP_AND,OS_INT,right.location.register,tmpreg);
                       cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,tmpreg,location.register);
+{$ifdef newra}
+                      rg.ungetregisterint(exprasmlist,tmpreg);
+{$else}
                       cg.free_scratch_reg(exprasmlist,tmpreg);
+{$endif}
                     end
                   else
                     begin
@@ -375,7 +395,9 @@ interface
                falselabel:=ofl;
              end;
 
+{$ifndef newra}
             maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+{$endif}
             isjump:=(right.location.loc=LOC_JUMP);
             if isjump then
               begin
@@ -385,7 +407,9 @@ interface
                  objectlibrary.getlabel(falselabel);
               end;
             secondpass(right);
+{$ifndef newra}
             maybe_restore(exprasmlist,left.location,pushedregs);
+{$endif}
             if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
              location_force_reg(exprasmlist,right.location,cgsize,false);
             if isjump then
@@ -730,12 +754,20 @@ interface
             end
           else
             begin
+{$ifdef newra}
+              tmpreg := rg.getregisterint(exprasmlist,OS_INT);
+{$else}
               tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+{$endif}
               cg.a_load_const_reg(exprasmlist,OS_INT,
                 aword(left.location.value),tmpreg);
               cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT,
                 right.location.register,tmpreg,location.register);
+{$ifdef newra}
+              rg.ungetregisterint(exprasmlist,tmpreg);
+{$else}
               cg.free_scratch_reg(exprasmlist,tmpreg);
+{$endif}
             end;
         end;
 
@@ -797,7 +829,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2003-06-10 20:46:17  mazen
+  Revision 1.13  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.12  2003/06/10 20:46:17  mazen
   * fixing a general compile problem related to
     cg.g_overflowcheck declaration that has
     changed

compiler/ncgld.pas

@@ -153,7 +153,7 @@ implementation
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
                     {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,hregister);
-                       r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
+                       r:=rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
                     {$endif}
                        { the called procedure isn't allowed to change }
                        { any register except EAX                    }
@@ -953,7 +953,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.69  2003-06-09 16:41:52  jonas
+  Revision 1.70  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.69  2003/06/09 16:41:52  jonas
     * fixed regvar optimization for call_by_reference parameters (no need
       to load address in another register)
 

compiler/pass_2.pas

@@ -205,6 +205,7 @@ implementation
                  Comment(V_Warning,'Location is different in secondpass: '+nodetype2str[p.nodetype]);
              end;
 
+{$ifndef newra}
             { check if all scratch registers are freed }
             for i:=1 to max_scratch_regs do
               if not(scratch_regs[i] in cg.unusedscratchregisters) then
@@ -212,6 +213,7 @@ implementation
                    printnode(stdout,p);
                    internalerror(2003042201);
                 end;
+{$endif newra}
 {$endif EXTDEBUG}
             if codegenerror then
               include(p.flags,nf_error);
@@ -287,15 +289,8 @@ 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}
+
+              current_procinfo.allocate_framepointer;
 
               do_secondpass(p);
 
@@ -309,7 +304,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.55  2003-06-09 12:23:30  peter
+  Revision 1.56  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.55  2003/06/09 12:23:30  peter
     * init/final of procedure data splitted from genentrycode
     * use asmnode getposition to insert final at the correct position
       als for the implicit try...finally

compiler/psub.pas

@@ -1090,11 +1090,10 @@ implementation
 
              { Update parameter information }
              current_procinfo.allocate_implicit_parameter;
-{$ifdef i386}
+
              { add implicit pushes for interrupt routines }
              if (po_interrupt in pd.procoptions) then
-               current_procinfo.allocate_interrupt_stackframe;
-{$endif i386}
+               current_procinfo.allocate_interrupt_parameter;
 
              { Calculate offsets }
              current_procinfo.after_header;
@@ -1269,7 +1268,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.125  2003-06-09 12:23:30  peter
+  Revision 1.126  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.125  2003/06/09 12:23:30  peter
     * init/final of procedure data splitted from genentrycode
     * use asmnode getposition to insert final at the correct position
       als for the implicit try...finally

compiler/rgobj.pas

@@ -1238,18 +1238,20 @@ unit rgobj;
 
 
     procedure trgobj.makeregvarint(reg:Tsuperregister);
-    begin
-      dec(countusableregsint);
-    {$ifndef newra}
-      dec(countunusedregsint);
-    {$endif}
-      exclude(usableregsint,reg);
-      exclude(unusedregsint,reg);
-      include(is_reg_var_int,reg);
-{$ifndef i386}
-      include(usedintbyproc,reg);
-{$endif not i386}
-    end;
+      begin
+        dec(countusableregsint);
+      {$ifndef newra}
+        dec(countunusedregsint);
+      {$endif}
+        exclude(usableregsint,reg);
+        exclude(unusedregsint,reg);
+        include(is_reg_var_int,reg);
+{$ifndef newra}
+  {$ifndef i386}
+        include(usedintbyproc,reg);
+  {$endif not i386}
+{$endif newra}
+      end;
 
     procedure trgobj.makeregvarother(reg: tregister);
       begin
@@ -1594,7 +1596,8 @@ unit rgobj;
 
     begin
       d:=degree[m];
-      dec(degree[m]);
+      if degree[m]>0 then
+        dec(degree[m]);
       if d=cpu_registers then
         begin
           {Enable moves for m.}
@@ -2463,7 +2466,10 @@ end.
 
 {
   $Log$
-  Revision 1.51  2003-06-09 14:54:26  jonas
+  Revision 1.52  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.51  2003/06/09 14:54:26  jonas
     * (de)allocation of registers for parameters is now performed properly
       (and checked on the ppc)
     - removed obsolete allocation of all parameter registers at the start

compiler/sparc/aasmcpu.pas

@@ -53,6 +53,8 @@ uses
          constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
          constructor op_sym(op : tasmop;_op1 : tasmsymbol);
          constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+         function is_nop:boolean;override;
+         function is_move:boolean;override;
       end;
 
       tai_align = class(tai_align_abstract)
@@ -228,6 +230,20 @@ implementation
       end;
 
 
+    function taicpu.is_nop:boolean;
+      begin
+        result:=(opcode=A_NOP);
+      end;
+
+
+    function taicpu.is_move:boolean;
+      begin
+        result:=(opcode=A_MOV) and
+                (oper[0].typ=top_reg) and
+                (oper[1].typ=top_reg);
+      end;
+
+
     procedure InitAsm;
       begin
       end;
@@ -240,7 +256,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2003-06-01 01:03:41  peter
+  Revision 1.29  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.28  2003/06/01 01:03:41  peter
     * remove unsupported combinations
     * reg_ref_reg only allowed for refs_lo,refs_hi
 

compiler/sparc/cgcpu.pas

@@ -139,7 +139,11 @@ implementation
            (ref.offset<simm13lo) or
            (ref.offset>simm13hi) then
           begin
+{$ifdef newra}
+            tmpreg:=rg.getregisterint(list,OS_INT);
+{$else}
             tmpreg:=get_scratch_reg_int(list,OS_INT);
+{$endif}
             reference_reset(tmpref);
             tmpref.symbol:=ref.symbol;
             tmpref.offset:=ref.offset;
@@ -175,7 +179,13 @@ implementation
                ((ref.offset<>0) or assigned(ref.symbol)) then
               begin
                 if tmpreg.number=NR_NO then
-                  tmpreg:=get_scratch_reg_int(list,OS_INT);
+                  begin
+{$ifdef newra}
+                    tmpreg:=rg.getregisterint(list,OS_INT);
+{$else}
+                    tmpreg:=get_scratch_reg_int(list,OS_INT);
+{$endif}
+                  end;
                 if (ref.index.number<>NR_NO) then
                   begin
                     list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg));
@@ -188,7 +198,13 @@ implementation
         else
           list.concat(taicpu.op_ref_reg(op,ref,reg));
         if (tmpreg.number<>NR_NO) then
-          free_scratch_reg(list,tmpreg);
+          begin
+{$ifdef newra}
+            rg.ungetregisterint(list,tmpreg);
+{$else}
+            free_scratch_reg(list,tmpreg);
+{$endif}
+          end;
       end;
 
 
@@ -199,11 +215,19 @@ implementation
         if (longint(a)<simm13lo) or
            (longint(a)>simm13hi) then
           begin
+{$ifdef newra}
+            tmpreg:=rg.getregisterint(list,OS_INT);
+{$else}
             tmpreg:=get_scratch_reg_int(list,OS_INT);
+{$endif}
             list.concat(taicpu.op_const_reg(A_SETHI,a shr 10,tmpreg));
             list.concat(taicpu.op_reg_const_reg(A_OR,tmpreg,a and aword($3ff),tmpreg));
             list.concat(taicpu.op_reg_reg_reg(op,src,tmpreg,dst));
+{$ifdef newra}
+            rg.ungetregisterint(list,tmpreg);
+{$else}
             free_scratch_reg(list,tmpreg);
+{$endif}
           end
         else
           list.concat(taicpu.op_reg_const_reg(op,src,a,dst));
@@ -260,10 +284,18 @@ implementation
                 reference_reset(ref);
                 ref.base:=locpara.reference.index;
                 ref.offset:=locpara.reference.offset;
+{$ifdef newra}
+                tmpreg:=rg.getregisterint(list,OS_INT);
+{$else}
                 tmpreg := get_scratch_reg_int(list,sz);
+{$endif}
                 a_load_ref_reg(list,sz,sz,r,tmpreg);
                 a_load_reg_ref(list,sz,sz,tmpreg,ref);
+{$ifdef newra}
+                rg.ungetregisterint(list,tmpreg);
+{$else}
                 free_scratch_reg(list,tmpreg);
+{$endif}
               end;
             LOC_FPUREGISTER,LOC_CFPUREGISTER:
               begin
@@ -295,10 +327,18 @@ implementation
               reference_reset(ref);
               ref.base := locpara.reference.index;
               ref.offset := locpara.reference.offset;
+{$ifdef newra}
+              tmpreg:=rg.getaddressregister(list);
+{$else}
               tmpreg := get_scratch_reg_address(list);
+{$endif}
               a_loadaddr_ref_reg(list,r,tmpreg);
               a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
+{$ifdef newra}
+              rg.ungetregisterint(list,tmpreg);
+{$else}
               free_scratch_reg(list,tmpreg);
+{$endif}
             end;
           else
             internalerror(2002080701);
@@ -613,28 +653,32 @@ implementation
       end;
 
 
-procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
-  begin
-    List.Concat(TAiCpu.op_sym(A_BA,objectlibrary.newasmsymbol(l.name)));
-  end;
-procedure TCgSparc.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:TAsmLabel);
-  var
-    ai:TAiCpu;
-  begin
-    ai:=TAiCpu.Op_sym(A_BA,l);
-    ai.SetCondition(TOpCmp2AsmCond[cond]);
-    list.Concat(ai);
-    list.Concat(TAiCpu.Op_none(A_NOP));
-  end;
-procedure TCgSparc.a_jmp_flags(list:TAasmOutput;const f:TResFlags;l:tasmlabel);
-  var
-    ai:taicpu;
-  begin
-    ai := Taicpu.op_sym(A_BA,l);
-    ai.SetCondition(flags_to_cond(f));
-    list.Concat(ai);
-    list.Concat(TAiCpu.Op_none(A_NOP));
-  end;
+    procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
+      begin
+        List.Concat(TAiCpu.op_sym(A_BA,objectlibrary.newasmsymbol(l.name)));
+      end;
+
+
+    procedure TCgSparc.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:TAsmLabel);
+      var
+        ai:TAiCpu;
+      begin
+        ai:=TAiCpu.Op_sym(A_BA,l);
+        ai.SetCondition(TOpCmp2AsmCond[cond]);
+        list.Concat(ai);
+        list.Concat(TAiCpu.Op_none(A_NOP));
+      end;
+
+
+    procedure TCgSparc.a_jmp_flags(list:TAasmOutput;const f:TResFlags;l:tasmlabel);
+      var
+        ai:taicpu;
+      begin
+        ai := Taicpu.op_sym(A_BA,l);
+        ai.SetCondition(flags_to_cond(f));
+        list.Concat(ai);
+        list.Concat(TAiCpu.Op_none(A_NOP));
+      end;
 
 
     procedure TCgSparc.g_flags2reg(list:TAasmOutput;Size:TCgSize;const f:tresflags;reg:TRegister);
@@ -648,100 +692,100 @@ procedure TCgSparc.a_jmp_flags(list:TAasmOutput;const f:TResFlags;l:tasmlabel);
         list.Concat(ai);
         list.Concat(TAiCpu.Op_none(A_NOP));
       end;
-procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);
-  var
-    hl : tasmlabel;
-    r:Tregister;
-  begin
-    if not(cs_check_overflow in aktlocalswitches)
-    then
-      exit;
-    objectlibrary.getlabel(hl);
-    if not((def.deftype=pointerdef)or
-          ((def.deftype=orddef)and
-           (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit])))
-    then
+
+
+    procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef);
+      var
+        hl : tasmlabel;
+        r  : Tregister;
       begin
-        //r.enum:=R_CR7;
-        //list.concat(taicpu.op_reg(A_MCRXR,r));
-        //a_jmp_cond(list,A_BA,C_OV,hl)
-        a_jmp_always(list,hl)
-      end
-    else
-      a_jmp_cond(list,OC_AE,hl);
-    a_call_name(list,'FPC_OVERFLOW');
-    a_label(list,hl);
-  end;
+        if not(cs_check_overflow in aktlocalswitches) then
+          exit;
+        objectlibrary.getlabel(hl);
+        if not((def.deftype=pointerdef)or
+              ((def.deftype=orddef)and
+               (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
+          begin
+            //r.enum:=R_CR7;
+            //list.concat(taicpu.op_reg(A_MCRXR,r));
+            //a_jmp_cond(list,A_BA,C_OV,hl)
+            a_jmp_always(list,hl)
+          end
+        else
+          a_jmp_cond(list,OC_AE,hl);
+        a_call_name(list,'FPC_OVERFLOW');
+        a_label(list,hl);
+      end;
 
   { *********** entry/exit code and address loading ************ }
 
-  procedure TCgSparc.g_stackframe_entry(list:TAasmOutput;LocalSize:LongInt);
-    var
-      r : tregister;
-    begin
-      { Althogh the SPARC architecture require only word alignment, software
-        convention and the operating system require every stack frame to be double word
-        aligned }
-      LocalSize:=align(LocalSize,8);
-      { Execute the SAVE instruction to get a new register window and create a new
-        stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state
-        before execution of the SAVE instrucion so it is the caller %i6, when the %i6
-        after execution of that instruction is the called function stack pointer}
-      r.enum:=R_INTREGISTER;
-      r.number:=NR_STACK_POINTER_REG;
-      list.concat(Taicpu.Op_reg_const_reg(A_SAVE,r,aword(-LocalSize),r));
-    end;
-
-
-  procedure TCgSparc.g_restore_all_registers(list:TaasmOutput;accused,acchiused:boolean);
-    begin
-      { The sparc port uses the sparc standard calling convetions so this function has no used }
-    end;
-
-
-  procedure TCgSparc.g_restore_frame_pointer(list:TAasmOutput);
-    begin
-       { This function intontionally does nothing as frame pointer is restored in the
-         delay slot of the return instrucion done in g_return_from_proc}
-    end;
-
-
-  procedure TCgSparc.g_restore_standard_registers(list:taasmoutput;usedinproc:Tsupregset);
-    begin
-      { The sparc port uses the sparc standard calling convetions so this function has no used }
-    end;
-
-
-  procedure TCgSparc.g_return_from_proc(list:TAasmOutput;parasize:aword);
-    begin
-      { According to the SPARC ABI, the stack is cleared using the RESTORE instruction
-        which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
-        real RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
-        delay slot, so an inversion is possible such as
-        RET      (=JMPL  %i7+8,%g0)
-        RESTORE  (=RESTORE %g0,0,%g0)
-        If no inversion we can use just
-        RESTORE  (=RESTORE %g0,0,%g0)
-        RET      (=JMPL  %i7+8,%g0)
-        NOP
-      }
-      list.concat(Taicpu.op_none(A_RET));
-      { We use trivial restore in the delay slot of the JMPL instruction, as we
-        already set result onto %i0 }
-      list.concat(Taicpu.op_none(A_RESTORE));
-    end;
-
-
-  procedure TCgSparc.g_save_all_registers(list : taasmoutput);
-    begin
-      { The sparc port uses the sparc standard calling convetions so this function has no used }
-    end;
-
-
-  procedure TCgSparc.g_save_standard_registers(list : taasmoutput; usedinproc:Tsupregset);
-    begin
-      { The sparc port uses the sparc standard calling convetions so this function has no used }
-    end;
+    procedure TCgSparc.g_stackframe_entry(list:TAasmOutput;LocalSize:LongInt);
+      var
+        r : tregister;
+      begin
+        { Althogh the SPARC architecture require only word alignment, software
+          convention and the operating system require every stack frame to be double word
+          aligned }
+        LocalSize:=align(LocalSize,8);
+        { Execute the SAVE instruction to get a new register window and create a new
+          stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state
+          before execution of the SAVE instrucion so it is the caller %i6, when the %i6
+          after execution of that instruction is the called function stack pointer}
+        r.enum:=R_INTREGISTER;
+        r.number:=NR_STACK_POINTER_REG;
+        list.concat(Taicpu.Op_reg_const_reg(A_SAVE,r,aword(-LocalSize),r));
+      end;
+
+
+    procedure TCgSparc.g_restore_all_registers(list:TaasmOutput;accused,acchiused:boolean);
+      begin
+        { The sparc port uses the sparc standard calling convetions so this function has no used }
+      end;
+
+
+    procedure TCgSparc.g_restore_frame_pointer(list:TAasmOutput);
+      begin
+         { This function intontionally does nothing as frame pointer is restored in the
+           delay slot of the return instrucion done in g_return_from_proc}
+      end;
+
+
+    procedure TCgSparc.g_restore_standard_registers(list:taasmoutput;usedinproc:Tsupregset);
+      begin
+        { The sparc port uses the sparc standard calling convetions so this function has no used }
+      end;
+
+
+    procedure TCgSparc.g_return_from_proc(list:TAasmOutput;parasize:aword);
+      begin
+        { According to the SPARC ABI, the stack is cleared using the RESTORE instruction
+          which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
+          real RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
+          delay slot, so an inversion is possible such as
+          RET      (=JMPL  %i7+8,%g0)
+          RESTORE  (=RESTORE %g0,0,%g0)
+          If no inversion we can use just
+          RESTORE  (=RESTORE %g0,0,%g0)
+          RET      (=JMPL  %i7+8,%g0)
+          NOP
+        }
+        list.concat(Taicpu.op_none(A_RET));
+        { We use trivial restore in the delay slot of the JMPL instruction, as we
+          already set result onto %i0 }
+        list.concat(Taicpu.op_none(A_RESTORE));
+      end;
+
+
+    procedure TCgSparc.g_save_all_registers(list : taasmoutput);
+      begin
+        { The sparc port uses the sparc standard calling convetions so this function has no used }
+      end;
+
+
+    procedure TCgSparc.g_save_standard_registers(list : taasmoutput; usedinproc:Tsupregset);
+      begin
+        { The sparc port uses the sparc standard calling convetions so this function has no used }
+      end;
 
 
     { ************* concatcopy ************ }
@@ -786,7 +830,11 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
         { load the address of source into src.base }
         if loadref then
           begin
+{$ifdef newra}
+            src.base:=rg.getaddressregister(list);
+{$else}
             src.base := get_scratch_reg_address(list);
+{$endif}
             a_load_ref_reg(list,OS_32,OS_32,source,src.base);
             orgsrc := false;
           end
@@ -797,7 +845,11 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
               ((source.offset+longint(len))>high(smallint))
             ) then
            begin
+{$ifdef newra}
+             src.base:=rg.getaddressregister(list);
+{$else}
              src.base := get_scratch_reg_address(list);
+{$endif}
              a_loadaddr_ref_reg(list,source,src.base);
              orgsrc := false;
            end
@@ -815,7 +867,11 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
             ((dest.offset + longint(len)) > high(smallint))
            ) then
           begin
+{$ifdef newra}
+            dst.base:=rg.getaddressregister(list);
+{$else}
             dst.base := get_scratch_reg_address(list);
+{$endif}
             a_loadaddr_ref_reg(list,dest,dst.base);
             orgdst := false;
           end
@@ -836,8 +892,12 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
             inc(src.offset,8);
             list.concat(taicpu.op_reg_const_reg(A_SUB,src.base,8,src.base));
             list.concat(taicpu.op_reg_const_reg(A_SUB,dst.base,8,dst.base));
-            countreg := get_scratch_reg_int(list,OS_32);
-            a_load_const_reg(list,OS_32,count,countreg);
+{$ifdef newra}
+            countreg:=rg.getregisterint(list,OS_INT);
+{$else}
+            countreg := get_scratch_reg_int(list,OS_INT);
+{$endif}
+            a_load_const_reg(list,OS_INT,count,countreg);
             { explicitely allocate R_O0 since it can be used safely here }
             { (for holding date that's being copied)                    }
             r.enum:=R_F0;
@@ -848,7 +908,11 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
             list.concat(taicpu.op_ref_reg(A_LDF,src,r));
             list.concat(taicpu.op_reg_ref(A_STD,r,dst));
             //a_jmp(list,A_BC,C_NE,0,lab);
+{$ifdef newra}
+            rg.ungetregisterint(list,countreg);
+{$else}
             free_scratch_reg(list,countreg);
+{$endif}
             a_reg_dealloc(list,r);
             len := len mod 8;
           end;
@@ -870,35 +934,59 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
           end;
         if (len and 4) <> 0 then
           begin
+{$ifdef newra}
+            r:=rg.getregisterint(list,OS_INT);
+{$else}
             r.enum:=R_INTREGISTER;
             r.number:=NR_O0;
             a_reg_alloc(list,r);
+{$endif}
             a_load_ref_reg(list,OS_32,OS_32,src,r);
             a_load_reg_ref(list,OS_32,OS_32,r,dst);
             inc(src.offset,4);
             inc(dst.offset,4);
+{$ifdef newra}
+            rg.ungetregisterint(list,r);
+{$else}
             a_reg_dealloc(list,r);
+{$endif}
           end;
         { copy the leftovers }
         if (len and 2) <> 0 then
           begin
+{$ifdef newra}
+            r:=rg.getregisterint(list,OS_INT);
+{$else}
             r.enum:=R_INTREGISTER;
             r.number:=NR_O0;
             a_reg_alloc(list,r);
+{$endif}
             a_load_ref_reg(list,OS_16,OS_16,src,r);
             a_load_reg_ref(list,OS_16,OS_16,r,dst);
             inc(src.offset,2);
             inc(dst.offset,2);
+{$ifdef newra}
+            rg.ungetregisterint(list,r);
+{$else}
             a_reg_dealloc(list,r);
+{$endif}
           end;
         if (len and 1) <> 0 then
           begin
+{$ifdef newra}
+            r:=rg.getregisterint(list,OS_INT);
+{$else}
             r.enum:=R_INTREGISTER;
             r.number:=NR_O0;
             a_reg_alloc(list,r);
+{$endif}
             a_load_ref_reg(list,OS_8,OS_8,src,r);
             a_load_reg_ref(list,OS_8,OS_8,r,dst);
+{$ifdef newra}
+            rg.ungetregisterint(list,r);
+{$else}
             a_reg_dealloc(list,r);
+{$endif}
           end;
         if orgsrc then
           begin
@@ -906,9 +994,17 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const Loc:TLocation;def:TDef
               reference_release(list,source);
           end
         else
+{$ifdef newra}
+            rg.ungetregisterint(list,src.base);
+{$else}
           free_scratch_reg(list,src.base);
+{$endif}
         if not orgdst then
+{$ifdef newra}
+            rg.ungetregisterint(list,dst.base);
+{$else}
           free_scratch_reg(list,dst.base);
+{$endif}
       end;
 
 {****************************************************************************
@@ -996,7 +1092,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  2003-06-04 20:59:37  mazen
+  Revision 1.58  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.57  2003/06/04 20:59:37  mazen
   + added size of destination in code gen methods
   + making g_overflowcheck declaration same as
     ancestor's method declaration

compiler/sparc/ncpumat.pas

@@ -78,9 +78,13 @@ implementation
 
       begin
          secondpass(left);
+{$ifndef newra}
          maybe_save(exprasmlist,right.registers32,left.location,saved);
+{$endif}
          secondpass(right);
+{$ifndef newra}
          maybe_restore(exprasmlist,left.location,saved);
+{$endif}
          location_copy(location,left.location);
 
          { put numerator in register }
@@ -97,20 +101,32 @@ implementation
            end;
          if (nodetype = modn) then
            begin
+{$ifdef newra}
+             resultreg := rg.getregisterint(exprasmlist,OS_INT);
+{$else}
              resultreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
+{$endif}
            end;
 
          if (nodetype = divn) and
             (right.nodetype = ordconstn) and
             ispowerof2(tordconstnode(right).value,power) then
            begin
+{$ifdef newra}
+             tmpreg:=rg.getregisterint(exprasmlist,OS_INT);
+{$else}
              tmpreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
+{$endif}
              cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_INT,31,numerator,tmpreg);
              { if signed, tmpreg=right value-1, otherwise 0 }
              cg.a_op_const_reg(exprasmlist,OP_AND,OS_INT,tordconstnode(right).value-1,tmpreg);
              { add to the left value }
              cg.a_op_reg_reg(exprasmlist,OP_ADD,OS_INT,tmpreg,numerator);
+{$ifdef newra}
+             rg.ungetregisterint(exprasmlist,tmpreg);
+{$else}
              cg.free_scratch_reg(exprasmlist,tmpreg);
+{$endif}
              cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_INT,aword(power),numerator,resultreg);
            end
          else
@@ -135,7 +151,11 @@ implementation
                rg.UnGetRegisterInt(exprasmlist,divider);
                exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB,location.register,
                  numerator,resultreg));
+{$ifdef newra}
+               rg.ungetregisterint(exprasmlist,resultreg);
+{$else}
                cg.free_scratch_reg(exprasmlist,resultreg);
+{$endif}
                resultreg := location.register;
              end
            else
@@ -171,9 +191,13 @@ procedure tSparcshlshrnode.pass_2;
     r:Tregister;
   begin
     secondpass(left);
+{$ifndef newra}
     maybe_save(exprasmlist,right.registers32,left.location,saved);
+{$endif}
     secondpass(right);
+{$ifndef newra}
     maybe_restore(exprasmlist,left.location,saved);
+{$endif}
     if is_64bitint(left.resulttype.def)
     then
       begin
@@ -181,8 +205,7 @@ procedure tSparcshlshrnode.pass_2;
         location_copy(location,left.location);
         hregisterhigh := location.registerhigh;
         hregisterlow := location.registerlow;
-        if (location.loc = LOC_CREGISTER)
-        then
+        if (location.loc = LOC_CREGISTER) then
           begin
             location.loc := LOC_REGISTER;
             location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
@@ -228,8 +251,7 @@ procedure tSparcshlshrnode.pass_2;
           begin
             location_force_reg(exprasmlist,right.location,OS_S32,true);
             hregister1 := right.location.register;
-            if nodetype = shln
-            then
+            if nodetype = shln then
               begin
                 asmop1 := A_SLL;
                 asmop2 := A_SRL;
@@ -242,24 +264,7 @@ procedure tSparcshlshrnode.pass_2;
                 location.registerhigh := location.registerlow;
                 location.registerlow := resultreg;
               end;
-            //rg.getexplicitregisterint(exprasmlist,NR_O0);
-            r.enum:=R_INTREGISTER;
-            r.number:=NR_O0;
 {$warning TODO shl 64bit no-const}
-{            exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_0,hregister1,32));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,location.registerhigh,hregisterhigh,hregister1));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(asmop2,R_0,hregisterlow,R_0));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR,location.registerhigh,location.registerhigh,R_0));
-            exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBI,R_0,hregister1,32));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,R_0,hregisterlow,R_0));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR,location.registerhigh,location.registerhigh,R_0));
-            exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,location.registerlow,hregisterlow,hregister1));}
-            rg.UnGetRegisterInt(exprasmlist,r);
-            if right.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]
-            then
-              cg.free_scratch_reg(exprasmlist,hregister1)
-            else
-              rg.UnGetRegisterInt(exprasmlist,hregister1);
           end
       end
     else
@@ -352,7 +357,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2003-06-04 20:59:37  mazen
+  Revision 1.11  2003-06-12 16:43:07  peter
+    * newra compiles for sparc
+
+  Revision 1.10  2003/06/04 20:59:37  mazen
   + added size of destination in code gen methods
   + making g_overflowcheck declaration same as
     ancestor's method declaration