Просмотр исходного кода

* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419

mazen 23 лет назад
Родитель
Сommit
3d9be081b9
3 измененных файлов с 302 добавлено и 107 удалено
  1. 88 54
      compiler/sparc/cgcpu.pas
  2. 209 51
      compiler/sparc/cpupara.pas
  3. 5 2
      compiler/systems/i_linux.pas

+ 88 - 54
compiler/sparc/cgcpu.pas

@@ -38,7 +38,6 @@ USES
 TYPE
   tcgSPARC=CLASS(tcg)
 		FreeParamRegSet:TRegisterSet;
-		constructor Create;
 {This method is used to pass a parameter, which is located in a register, to a
 routine. It should give the parameter to the routine, as required by the
 specific processor ABI. It is overriden for each CPU target.
@@ -48,7 +47,7 @@ specific processor ABI. It is overriden for each CPU target.
          from one from left to right}
     procedure a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;const LocPara:TParaLocation);override;
     PROCEDURE a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);override;
-    PROCEDURE a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);override;
+    procedure a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);override;
     PROCEDURE a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);override;
     PROCEDURE a_call_name(list:TAasmOutput;CONST s:string);override;
     PROCEDURE a_call_ref(list:TAasmOutput;CONST ref:TReference);override;
@@ -111,7 +110,7 @@ USES
   globtype,globals,verbose,systems,cutils,
   symdef,symsym,defbase,paramgr,
   rgobj,tgobj,rgcpu;
-function GetFreeParamReg(var FreeParamRegSet:TRegisterSet):TRegister;
+{function GetFreeParamReg(var FreeParamRegSet:TRegisterSet):TRegister;
 	begin
 		if FreeParamRegSet=[]
 		then
@@ -126,7 +125,7 @@ constructor tcgSPARC.Create;
 	begin
 		inherited Create;
 		FreeParamRegSet:=[R_O0..R_O5];
-	end;
+	end;}
     { we implement the following routines because otherwise we can't }
     { instantiate the class since it's abstract                      }
 PROCEDURE tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation);
@@ -145,16 +144,40 @@ PROCEDURE tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST Loc
   END;
 procedure tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;const r:TReference;const LocPara:TParaLocation);
 	var
+		ref: treference;
 		tmpreg:TRegister;
 	begin
-		if((Size=OS_32)and(Size=OS_S32))
+		if Size<>OS_32
 		then
-			InternalError(2002032214);
-		tmpReg:=GetFreeParamReg(FreeParamRegSet);
-		if tmpReg=R_NONE
+			InternalError(2002100400);
+		case locpara.loc of
+			LOC_REGISTER,LOC_CREGISTER:
+				a_load_ref_reg(list,size,r,locpara.register);
+			LOC_REFERENCE:
+				begin
+					reference_reset(ref);
+					ref.base:=locpara.reference.index;
+					ref.offset:=locpara.reference.offset;
+					tmpreg := get_scratch_reg_int(list);
+					a_load_ref_reg(list,size,r,tmpreg);
+					a_load_reg_ref(list,size,tmpreg,ref);
+					free_scratch_reg(list,tmpreg);
+				end;
+			LOC_FPUREGISTER,LOC_CFPUREGISTER:
+				case size of
+					OS_32:
+						a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
+					OS_64:
+						a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
+				else
+					internalerror(2002072801);
+				end;
+		else
+			internalerror(2002081103);
+		end;
+		if locpara.sp_fixup<>0
 		then
-			InternalError(200210030020);
-		list.concat(taicpu.op_ref_reg(A_LD,S_L,r,tmpReg));
+			internalerror(2002081104);
   end;
 PROCEDURE tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
   VAR
@@ -221,15 +244,14 @@ PROCEDURE tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CO
   BEGIN
     list.concat(taicpu.op_reg_ref(A_LD,TCGSize2OpSize[size],reg,ref));
   END;
-PROCEDURE tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
-  VAR
-    op:tasmop;
-    s:topsize;
-  begin
-        sizes2load(size,S_L,op,s);
-        list.concat(taicpu.op_ref_reg(op,s,ref,reg));
-      end;
-
+procedure tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;const ref:TReference;reg:tregister);
+	var
+		op:tasmop;
+		s:topsize;
+	begin
+		sizes2load(size,S_L,op,s);
+		list.concat(taicpu.op_ref_reg(op,s,ref,reg));
+	end;
 
     PROCEDURE tcgSPARC.a_load_reg_reg(list:TAasmOutput;fromsize,size:tcgsize;reg1,reg2:tregister);
 
@@ -1001,40 +1023,49 @@ PROCEDURE tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tr
 
 
 {***************** This is private property, keep out! :) *****************}
-PROCEDURE tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;VAR op:tasmop;VAR s3:topsize);
-  BEGIN
-{         case s2 of
-           S_B:
-             if S1 in [OS_8,OS_S8] then
-               s3 := S_B
-             else internalerror(200109221);
-           S_W:
-             case s1 of
-               OS_8,OS_S8:
-                 s3 := S_BW;
-               OS_16,OS_S16:
-                 s3 := S_W;
-               else internalerror(200109222);
-             end;
-           S_L:
-             case s1 of
-               OS_8,OS_S8:
-                 s3 := S_BL;
-               OS_16,OS_S16:
-                 s3 := S_WL;
-               OS_32,OS_S32:
-                 s3 := S_L;
-               else internalerror(200109223);
-             end;
-           else internalerror(200109227);
-         end;
-         if s3 in [S_B,S_W,S_L] then
-           op := A_NONE
-         else if s1 in [OS_8,OS_16,OS_32] then
-           op := A_NONEZX
-         else
-           op := A_NONESX;}
-  END;
+procedure tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
+	begin
+		case s2 of
+			S_B:
+				if S1 in [OS_8,OS_S8]
+				then
+					s3 := S_B
+				else
+					internalerror(200109221);
+			S_W:
+				case s1 of
+					OS_8,OS_S8:
+						s3 := S_BW;
+					OS_16,OS_S16:
+						s3 := S_W;
+				else
+					internalerror(200109222);
+				end;
+			S_L:
+				case s1 of
+					OS_8,OS_S8:
+						s3 := S_BL;
+					OS_16,OS_S16:
+						s3 := S_WL;
+					OS_32,OS_S32:
+						s3 := S_L;
+					else
+						internalerror(200109223);
+				end;
+			else internalerror(200109227);
+		end;
+		if s3 in [S_B,S_W,S_L]
+		then
+			op := A_LD
+{		else if s3=S_DW
+		then
+		  op:=A_LDD
+		else if s3 in [OS_8,OS_16,OS_32]
+		then
+			op := A_NONE}
+		else
+			op := A_NONE;
+	end;
 PROCEDURE tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
   BEGIN
 (*         case t of
@@ -1104,7 +1135,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.9  2002-10-02 22:20:28  mazen
+  Revision 1.10  2002-10-04 21:57:42  mazen
+  * register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
+
+  Revision 1.9  2002/10/02 22:20:28  mazen
   + out registers allocator for the first 6 scalar parameters which must be passed into %o0..%o5
 
   Revision 1.8  2002/10/01 21:35:58  mazen

+ 209 - 51
compiler/sparc/cpupara.pas

@@ -27,47 +27,51 @@
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  ****************************************************************************}
-UNIT cpupara;
+unit cpupara;
 {SPARC specific calling conventions are handled by this unit}
 {$INCLUDE fpcdefs.inc}
-INTERFACE
-USES
-  cpubase,
-  symconst,symbase,symdef,paramgr;
-TYPE
-  TSparcParaManager=CLASS(TParaManager)
-    FUNCTION getintparaloc(nr:longint):tparalocation;OVERRIDE;
-    PROCEDURE create_param_loc_info(p:tabstractprocdef);OVERRIDE;
-    FUNCTION GetSelfLocation(p:tabstractprocdef):tparalocation;OVERRIDE;
-  end;
-IMPLEMENTATION
-USES
-  verbose,
-  cpuinfo,
-  symtype;
-FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
-  BEGIN
-    fillchar(result,sizeof(tparalocation),0);
-    if nr<1
-    then
-      internalerror(2002070801)
-    else if nr<=8
-    then
-      BEGIN
-        result.loc:=LOC_REGISTER;
-        result.register:=tregister(longint(R_O0)+nr);
-      end
-    else
-           BEGIN
+interface
+uses
+	cpubase,
+	symconst,symbase,symtype,symdef,paramgr;
+type
+	tSparcparamanager = class(tparamanager)
+          function getintparaloc(nr : longint) : tparalocation;override;
+          procedure create_param_loc_info(p : tabstractprocdef);override;
+          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
+	end;
+implementation
+uses
+	verbose,
+	globtype,
+	cpuinfo,cginfo,cgbase,
+	defbase;
+
+    function tSparcparamanager.getintparaloc(nr : longint) : tparalocation;
+
+      begin
+         fillchar(result,sizeof(tparalocation),0);
+         if nr<1 then
+           internalerror(2002070801)
+         else if nr<=8 then
+           begin
+              result.loc:=LOC_REGISTER;
+              result.register:=tregister(longint(R_O0)+nr);
+           end
+         else
+           begin
               result.loc:=LOC_REFERENCE;
               result.reference.index:=stack_pointer_reg;
               result.reference.offset:=(nr-8)*4;
            end;
       end;
 
-    FUNCTION getparaloc(p : tdef) : tloc;
+    function getparaloc(p : tdef) : tloc;
 
-      BEGIN
+      begin
+         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
+           if push_addr_param for the def is true
+         }
          case p.deftype of
             orddef:
               getparaloc:=LOC_REGISTER;
@@ -77,26 +81,66 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
               getparaloc:=LOC_REGISTER;
             pointerdef:
               getparaloc:=LOC_REGISTER;
+            formaldef:
+              getparaloc:=LOC_REGISTER;
+            classrefdef:
+              getparaloc:=LOC_REGISTER;
+            recorddef:
+              getparaloc:=LOC_REFERENCE;
+            objectdef:
+              if is_object(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            stringdef:
+              if is_shortstring(p) or is_longstring(p) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            procvardef:
+              if (po_methodpointer in tprocvardef(p).procoptions) then
+                getparaloc:=LOC_REFERENCE
+              else
+                getparaloc:=LOC_REGISTER;
+            filedef:
+              getparaloc:=LOC_REGISTER;
+            arraydef:
+              getparaloc:=LOC_REFERENCE;
+            setdef:
+              if is_smallset(p) then
+                getparaloc:=LOC_REGISTER
+              else
+                getparaloc:=LOC_REFERENCE;
+            variantdef:
+              getparaloc:=LOC_REFERENCE;
+            { avoid problems with errornous definitions }
+            errordef:
+              getparaloc:=LOC_REGISTER;
             else
               internalerror(2002071001);
          end;
       end;
 
-    PROCEDURE TSparcParaManager.create_param_loc_info(p : tabstractprocdef);
+    procedure tSparcparamanager.create_param_loc_info(p : tabstractprocdef);
 
       var
          nextintreg,nextfloatreg,nextmmreg : tregister;
          stack_offset : aword;
          hp : tparaitem;
          loc : tloc;
+         is_64bit: boolean;
 
-      BEGIN
-         nextintreg:=R_G3;
+      begin
+         nextintreg:=R_O3;
          nextfloatreg:=R_F1;
-         nextmmreg:=R_L1;
+         nextmmreg:=R_NONE;
          stack_offset:=0;
          { pointer for structured results ? }
-         { !!!nextintreg:=R_4;              }
+         if not is_void(p.rettype.def) then
+           begin
+              if not(ret_in_reg(p.rettype.def)) then
+                inc(nextintreg);
+           end;
 
          { frame pointer for nested procedures? }
          { inc(nextintreg);                     }
@@ -104,21 +148,97 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
          { destructor? }
          hp:=tparaitem(p.para.last);
          while assigned(hp) do
-           BEGIN
+           begin
               loc:=getparaloc(hp.paratype.def);
+              hp.paraloc.sp_fixup:=0;
               case loc of
                  LOC_REGISTER:
-                   BEGIN
-                      if nextintreg<=R_I7 then
-                        BEGIN
+                   begin
+                      hp.paraloc.size := def_cgsize(hp.paratype.def);
+                      { for things like formaldef }
+                      if hp.paraloc.size = OS_NO then
+                        hp.paraloc.size := OS_ADDR;
+                      is_64bit := hp.paraloc.size in [OS_64,OS_S64];
+                      if nextintreg<=tregister(ord(R_O4)-ord(is_64bit))  then
+                        begin
                            hp.paraloc.loc:=LOC_REGISTER;
-                           hp.paraloc.register:=nextintreg;
+                           hp.paraloc.registerlow:=nextintreg;
                            inc(nextintreg);
+                           if is_64bit then
+                             begin
+                               hp.paraloc.registerhigh:=nextintreg;
+                               inc(nextintreg);
+                             end;
+                        end
+                      else
+                         begin
+                            nextintreg := R_O5;
+                            hp.paraloc.loc:=LOC_REFERENCE;
+                            hp.paraloc.reference.index:=stack_pointer_reg;
+                            hp.paraloc.reference.offset:=stack_offset;
+                            if not is_64bit then
+                              inc(stack_offset,4)
+                            else
+                              inc(stack_offset,8);
+                        end;
+                   end;
+                 LOC_FPUREGISTER:
+                   begin
+                      if hp.paratyp in [vs_var,vs_out] then
+                        begin
+                            if nextintreg<=R_O5 then
+                             begin
+                                hp.paraloc.size:=OS_ADDR;
+                                hp.paraloc.loc:=LOC_REGISTER;
+                                hp.paraloc.register:=nextintreg;
+                                inc(nextintreg);
+                             end
+                           else
+                              begin
+                                 {!!!!!!!}
+                                 hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                                 internalerror(2002071006);
+                             end;
+                        end
+                      else if nextfloatreg<=R_F10 then
+                        begin
+                           hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                           hp.paraloc.loc:=LOC_FPUREGISTER;
+                           hp.paraloc.register:=nextfloatreg;
+                           inc(nextfloatreg);
                         end
                       else
-                         BEGIN
+                         begin
                             {!!!!!!!}
-                            internalerror(2002071003);
+                             hp.paraloc.size:=def_cgsize(hp.paratype.def);
+                            internalerror(2002071004);
+                        end;
+                   end;
+                 LOC_REFERENCE:
+                   begin
+                      hp.paraloc.size:=OS_ADDR;
+                      if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
+                        begin
+                           if nextintreg<=R_O5 then
+                             begin
+                                hp.paraloc.loc:=LOC_REGISTER;
+                                hp.paraloc.register:=nextintreg;
+                                inc(nextintreg);
+                             end
+                           else
+                              begin
+                                 hp.paraloc.loc:=LOC_REFERENCE;
+                                 hp.paraloc.reference.index:=stack_pointer_reg;
+                                 hp.paraloc.reference.offset:=stack_offset;
+                                 inc(stack_offset,4);
+                             end;
+                        end
+                      else
+                        begin
+                           hp.paraloc.loc:=LOC_REFERENCE;
+                           hp.paraloc.reference.index:=stack_pointer_reg;
+                           hp.paraloc.reference.offset:=stack_offset;
+                           inc(stack_offset,hp.paratype.def.size);
                         end;
                    end;
                  else
@@ -128,19 +248,57 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
            end;
       end;
 
-FUNCTION TSparcParaManager.GetSelfLocation(p:tabstractprocdef):tparalocation;
-  BEGIN
-    getselflocation.loc:=LOC_REFERENCE;
-    getselflocation.reference.index:=R_G3{R_ESP};
-    getselflocation.reference.offset:=4;
-  END;
+    function tSparcparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
+      begin
+         case p.rettype.def.deftype of
+            orddef,
+            enumdef:
+              begin
+                getfuncretparaloc.loc:=LOC_REGISTER;
+                getfuncretparaloc.register:=R_O0;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+                if getfuncretparaloc.size in [OS_S64,OS_64] then
+                  getfuncretparaloc.registerhigh:=R_O1;
+              end;
+            floatdef:
+              begin
+                getfuncretparaloc.loc:=LOC_FPUREGISTER;
+                getfuncretparaloc.register:=R_F1;
+                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
+              end;
+            { smallsets are OS_INT in R3, others are OS_ADDR in R3 -> the same }
+            { ugly, I know :) (JM)                                             }
+            setdef,
+            variantdef,
+            pointerdef,
+            formaldef,
+            classrefdef,
+            recorddef,
+            objectdef,
+            stringdef,
+            procvardef,
+            filedef,
+            arraydef,
+            errordef:
+              begin
+                getfuncretparaloc.loc:=LOC_REGISTER;
+                getfuncretparaloc.register:=R_O0;
+                getfuncretparaloc.size:=OS_ADDR;
+              end;
+            else
+              internalerror(2002090903);
+        end;
+      end;
 
 BEGIN
    paramanager:=TSparcParaManager.create;
 end.
 {
   $Log$
-  Revision 1.1  2002-08-21 13:30:07  mazen
+  Revision 1.2  2002-10-04 21:57:42  mazen
+  * register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
+
+  Revision 1.1  2002/08/21 13:30:07  mazen
   *** empty log message ***
 
   Revision 1.2  2002/07/11 14:41:34  florian

+ 5 - 2
compiler/systems/i_linux.pas

@@ -388,7 +388,7 @@ unit i_linux;
             ar           : ar_gnu_ar;
             res          : res_none;
             script       : script_unix;
-            endian       : endian_little;
+            endian       : endian_big;
             alignment    :
               (
                 procalign       : 4;
@@ -446,7 +446,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2002-09-06 15:03:51  carl
+  Revision 1.2  2002-10-04 21:57:42  mazen
+  * register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
+
+  Revision 1.1  2002/09/06 15:03:51  carl
     * moved files to systems directory
 
   Revision 1.3  2002/08/13 18:01:51  carl