Bladeren bron

* issameref() to test if two references are the same (then emit no opcodes)
+ ret_in_reg to replace ret_in_acc
(fix some register allocation bugs at the same time)
+ save_std_register now has an extra parameter which is the
usedinproc registers

carl 23 jaren geleden
bovenliggende
commit
745efb2c47
11 gewijzigde bestanden met toevoegingen van 372 en 128 verwijderingen
  1. 60 26
      compiler/cgobj.pas
  2. 32 14
      compiler/m68k/cgcpu.pas
  3. 30 23
      compiler/ncal.pas
  4. 82 27
      compiler/ncgutil.pas
  5. 86 3
      compiler/paramgr.pas
  6. 12 5
      compiler/powerpc/cgcpu.pas
  7. 19 8
      compiler/pstatmnt.pas
  8. 18 9
      compiler/psub.pas
  9. 9 2
      compiler/rautils.pas
  10. 10 4
      compiler/symsym.pas
  11. 14 7
      compiler/x86/cgx86.pas

+ 60 - 26
compiler/cgobj.pas

@@ -98,18 +98,11 @@ unit cgobj;
              was previously allocated using @link(get_scratch_reg).
              was previously allocated using @link(get_scratch_reg).
           }
           }
           procedure free_scratch_reg(list : taasmoutput;r : tregister);
           procedure free_scratch_reg(list : taasmoutput;r : tregister);
-
-          { passing parameters, per default the parameter is pushed }
-          { nr gives the number of the parameter (enumerated from   }
-          { left to right), this allows to move the parameter to    }
-          { register, if the cpu supports register calling          }
-          { conventions                                             }
-
           {# Pass a parameter, which is located in a register, to a routine.
           {# Pass a parameter, which is located in a register, to a routine.
 
 
              This routine should push/send the parameter to the routine, as
              This routine should push/send the parameter to the routine, as
-             required by the specific processor ABI. This must be overriden for
-             each CPU target.
+             required by the specific processor ABI and routine modifiers. 
+             This must be overriden for each CPU target.
 
 
              @param(size size of the operand in the register)
              @param(size size of the operand in the register)
              @param(r register source of the operand)
              @param(r register source of the operand)
@@ -118,7 +111,9 @@ unit cgobj;
           procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
           procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);virtual;
           {# Pass a parameter, which is a constant, to a routine.
           {# Pass a parameter, which is a constant, to a routine.
 
 
-             A generic version is provided.
+             A generic version is provided. This routine should
+             be overriden for optimization purposes if the cpu
+             permits directly sending this type of parameter.
 
 
              @param(size size of the operand in constant)
              @param(size size of the operand in constant)
              @param(a value of constant to send)
              @param(a value of constant to send)
@@ -127,7 +122,9 @@ unit cgobj;
           procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
           procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
           {# Pass the value of a parameter, which is located in memory, to a routine.
           {# Pass the value of a parameter, which is located in memory, to a routine.
 
 
-             A generic version is provided.
+             A generic version is provided. This routine should
+             be overriden for optimization purposes if the cpu
+             permits directly sending this type of parameter.
 
 
              @param(size size of the operand in constant)
              @param(size size of the operand in constant)
              @param(r Memory reference of value to send)
              @param(r Memory reference of value to send)
@@ -148,17 +145,16 @@ unit cgobj;
              will calculate the address of the reference, and pass this
              will calculate the address of the reference, and pass this
              calculated address as a parameter.
              calculated address as a parameter.
 
 
-             A generic version is provided.
+             A generic version is provided. This routine should
+             be overriden for optimization purposes if the cpu
+             permits directly sending this type of parameter.
 
 
              @param(r reference to get address from)
              @param(r reference to get address from)
              @param(nr parameter number (starting from one) of routine (from left to right))
              @param(nr parameter number (starting from one) of routine (from left to right))
           }
           }
           procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
           procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
 
 
-          {**********************************}
-          { these methods must be overriden: }
-
-          { Remarks:
+          (* Remarks:
             * If a method specifies a size you have only to take care
             * If a method specifies a size you have only to take care
               of that number of bits, i.e. load_const_reg with OP_8 must
               of that number of bits, i.e. load_const_reg with OP_8 must
               only load the lower 8 bit of the specified register
               only load the lower 8 bit of the specified register
@@ -173,7 +169,7 @@ unit cgobj;
             * the procedures without fpu/mm are only for integer usage
             * the procedures without fpu/mm are only for integer usage
             * normally the first location is the source and the
             * normally the first location is the source and the
               second the destination
               second the destination
-          }
+          *)
 
 
           {# Emits instruction to call the method specified by symbol name.
           {# Emits instruction to call the method specified by symbol name.
              This routine must be overriden for each new target cpu.
              This routine must be overriden for each new target cpu.
@@ -266,7 +262,8 @@ unit cgobj;
              save should be done either to a temp (pointed to by href).
              save should be done either to a temp (pointed to by href).
              or on the stack (pushing the value on the stack).
              or on the stack (pushing the value on the stack).
 
 
-             The size of the value to save is OS_S32.
+             The size of the value to save is OS_S32. The default version
+             saves the exception reason to a temp. memory area.
           }
           }
          procedure g_exception_reason_save(list : taasmoutput; const href : treference);virtual;
          procedure g_exception_reason_save(list : taasmoutput; const href : treference);virtual;
          {#
          {#
@@ -275,7 +272,8 @@ unit cgobj;
              save should be done either to a temp (pointed to by href).
              save should be done either to a temp (pointed to by href).
              or on the stack (pushing the value on the stack).
              or on the stack (pushing the value on the stack).
 
 
-             The size of the value to save is OS_S32
+             The size of the value to save is OS_S32. The default version
+             saves the exception reason to a temp. memory area.
           }
           }
          procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);virtual;
          procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);virtual;
          {#
          {#
@@ -284,7 +282,8 @@ unit cgobj;
              should either be in the temp. area (pointed to by href , href should
              should either be in the temp. area (pointed to by href , href should
              *NOT* be freed) or on the stack (the value should be popped).
              *NOT* be freed) or on the stack (the value should be popped).
 
 
-             The size of the value to restore is OS_S32.
+             The size of the value to save is OS_S32. The default version
+             saves the exception reason to a temp. memory area.
           }
           }
          procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
          procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
 
 
@@ -344,9 +343,6 @@ unit cgobj;
           {# Generates overflow checking code for a node }
           {# Generates overflow checking code for a node }
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
           procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
 
 
-          {**********************************}
-          {    entry/exit code helpers       }
-
           procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); virtual; abstract;
           procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); virtual; abstract;
           {# Emits instructions which should be emitted when entering
           {# Emits instructions which should be emitted when entering
              a routine declared as @var(interrupt). The default
              a routine declared as @var(interrupt). The default
@@ -386,10 +382,31 @@ unit cgobj;
           procedure g_call_constructor_helper(list : taasmoutput);virtual;
           procedure g_call_constructor_helper(list : taasmoutput);virtual;
           procedure g_call_destructor_helper(list : taasmoutput);virtual;
           procedure g_call_destructor_helper(list : taasmoutput);virtual;
           procedure g_call_fail_helper(list : taasmoutput);virtual;
           procedure g_call_fail_helper(list : taasmoutput);virtual;
-          procedure g_save_standard_registers(list : taasmoutput);virtual;abstract;
-          procedure g_restore_standard_registers(list : taasmoutput);virtual;abstract;
+          {# This routine is called when generating the code for the entry point
+             of a routine. It should save all registers which are not used in this
+             routine, and which should be declared as saved in the std_saved_registers
+             set. 
+             
+             This routine is mainly used when linking to code which is generated
+             by ABI-compliant compilers (like GCC), to make sure that the reserved
+             registers of that ABI are not clobbered.
+             
+             @param(usedinproc Registers which are used in the code of this routine)
+          }             
+          procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);virtual;abstract;
+          {# This routine is called when generating the code for the exit point
+             of a routine. It should restore all registers which were previously 
+             saved in @var(g_save_standard_registers).
+
+             @param(usedinproc Registers which are used in the code of this routine)
+          }             
+          procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);virtual;abstract;
           procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
           procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;abstract;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;abstract;
+          {# This routine verifies if two references are the same, and
+             if so, returns TRUE, otherwise returns false.
+          }
+          function issameref(const sref, dref : treference):boolean; 
        end;
        end;
 
 
     {# @abstract(Abstract code generator for 64 Bit operations)
     {# @abstract(Abstract code generator for 64 Bit operations)
@@ -621,6 +638,9 @@ unit cgobj;
 {$endif i386}
 {$endif i386}
 
 
       begin
       begin
+        { verify if we have the same reference }
+        if issameref(sref,dref) then
+          exit;
 {$ifdef i386}
 {$ifdef i386}
         { the following is done with defines to avoid a speed penalty,  }
         { the following is done with defines to avoid a speed penalty,  }
         { since all this is only necessary for the 80x86 (because EDI   }
         { since all this is only necessary for the 80x86 (because EDI   }
@@ -1508,6 +1528,13 @@ unit cgobj;
      end;
      end;
 
 
 
 
+    function tcg.issameref(const sref, dref : treference):boolean; 
+      begin
+        if CompareByte(sref,dref,sizeof(treference))=0 then
+          issameref := true
+        else
+          issameref := false;
+      end;
 
 
 
 
 
 
@@ -1533,7 +1560,14 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.49  2002-08-15 08:13:54  carl
+  Revision 1.50  2002-08-16 14:24:57  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.49  2002/08/15 08:13:54  carl
     - a_load_sym_ofs_reg removed
     - a_load_sym_ofs_reg removed
     * loadvmt now calls loadaddr_ref_reg instead
     * loadvmt now calls loadaddr_ref_reg instead
 
 

+ 32 - 14
compiler/m68k/cgcpu.pas

@@ -69,12 +69,9 @@ unit cgcpu;
           procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
           procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
           { restores the previous frame pointer at procedure exit }
           { restores the previous frame pointer at procedure exit }
           procedure g_restore_frame_pointer(list : taasmoutput);override;
           procedure g_restore_frame_pointer(list : taasmoutput);override;
-          { This routine should update the stack pointer so that parasize are freed
-            from the stack. It should also emit the return instruction
-          }  
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
           procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
-          procedure g_save_standard_registers(list : taasmoutput);override;
-          procedure g_restore_standard_registers(list : taasmoutput);override;
+          procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
+          procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
           procedure g_save_all_registers(list : taasmoutput);override;
           procedure g_save_all_registers(list : taasmoutput);override;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
      protected
      protected
@@ -113,7 +110,7 @@ Implementation
     uses
     uses
        globtype,globals,verbose,systems,cutils,
        globtype,globals,verbose,systems,cutils,
        symdef,symsym,defbase,paramgr,
        symdef,symsym,defbase,paramgr,
-       rgobj,tgobj,rgcpu;
+       rgobj,tgobj,rgcpu,cg64f32;
 
 
          
          
     const     
     const     
@@ -365,11 +362,11 @@ Implementation
               end;
               end;
           OP_DIV :
           OP_DIV :
               Begin
               Begin
-{$warning To complete DIV opcode}              
+                 internalerror(20020816);
               end;
               end;
           OP_IDIV :
           OP_IDIV :
               Begin
               Begin
-{$warning To complete IDIV opcode}              
+                 internalerror(20020816);
               end;
               end;
           OP_IMUL :
           OP_IMUL :
               Begin
               Begin
@@ -551,11 +548,11 @@ Implementation
               end;
               end;
           OP_DIV :
           OP_DIV :
               Begin
               Begin
-{$warning DIV to complete}              
+                 internalerror(20020816);
               end;
               end;
           OP_IDIV :
           OP_IDIV :
               Begin
               Begin
-{$warning IDIV to complete}              
+                 internalerror(20020816);
               end;
               end;
           OP_IMUL :
           OP_IMUL :
               Begin
               Begin
@@ -1016,12 +1013,26 @@ Implementation
       
       
       end;
       end;
       
       
-    procedure tcg68k.g_save_standard_registers(list : taasmoutput);
+    procedure tcg68k.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
+      var
+        tosave : tregisterlist;
       begin
       begin
+         tosave:=std_saved_registers;
+         { only save the registers which are not used and must be saved }
+         tosave:=tosave*usedinproc;
+         if tosave<>[] then
+           list.concat(taicpu.op_reglist_reg(A_MOVEM,S_L,tosave,R_SPPUSH));
       end;
       end;
       
       
-    procedure tcg68k.g_restore_standard_registers(list : taasmoutput);
+    procedure tcg68k.g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);
+      var
+       torestore : tregisterset;
       begin
       begin
+         torestore:=std_saved_registers;
+         { should be intersected with used regs, no ? }
+         torestore:=torestore*usedinproc;
+         if torestore<>[] then
+           list.concat(taicpu.op_reg_reglist(A_MOVEM,S_L,R_SPPULL,torestore));
       end;
       end;
       
       
     procedure tcg68k.g_save_all_registers(list : taasmoutput);
     procedure tcg68k.g_save_all_registers(list : taasmoutput);
@@ -1092,12 +1103,19 @@ Implementation
 
 
 begin
 begin
   cg := tcg68k.create;
   cg := tcg68k.create;
-{  cg64 :=tcg64fppc.create;}
+  cg64 :=tcg64f32.create;
 end.
 end.
 
 
 { 
 { 
   $Log$
   $Log$
-  Revision 1.3  2002-08-15 08:13:54  carl
+  Revision 1.4  2002-08-16 14:24:59  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.3  2002/08/15 08:13:54  carl
     - a_load_sym_ofs_reg removed
     - a_load_sym_ofs_reg removed
     * loadvmt now calls loadaddr_ref_reg instead
     * loadvmt now calls loadaddr_ref_reg instead
 
 

+ 30 - 23
compiler/ncal.pas

@@ -1506,10 +1506,10 @@ implementation
          else
          else
            resulttype:=restype;
            resulttype:=restype;
 
 
-         { get a register for the return value }
+         { modify the exit code, in case of special cases }
          if (not is_void(resulttype.def)) then
          if (not is_void(resulttype.def)) then
           begin
           begin
-            if paramanager.ret_in_acc(resulttype.def) then
+            if paramanager.ret_in_reg(resulttype.def) then
              begin
              begin
                { wide- and ansistrings are returned in EAX    }
                { wide- and ansistrings are returned in EAX    }
                { but they are imm. moved to a memory location }
                { but they are imm. moved to a memory location }
@@ -1786,28 +1786,28 @@ implementation
     function Tcallnode.track_state_pass(exec_known:boolean):boolean;
     function Tcallnode.track_state_pass(exec_known:boolean):boolean;
 
 
     var hp:Tcallparanode;
     var hp:Tcallparanode;
-	value:Tnode;
+  value:Tnode;
 
 
     begin
     begin
-	track_state_pass:=false;
-	hp:=Tcallparanode(left);
-	while assigned(hp) do
-	    begin
-		if left.track_state_pass(exec_known) then
-		    begin
-			left.resulttype.def:=nil;
-			do_resulttypepass(left);
-		    end;
-		value:=aktstate.find_fact(hp.left);
-		if value<>nil then
-		    begin
-			track_state_pass:=true;
-			hp.left.destroy;
-			hp.left:=value.getcopy;
-			do_resulttypepass(hp.left);
-		    end;
-		hp:=Tcallparanode(hp.right);
-	    end;
+  track_state_pass:=false;
+  hp:=Tcallparanode(left);
+  while assigned(hp) do
+      begin
+    if left.track_state_pass(exec_known) then
+        begin
+      left.resulttype.def:=nil;
+      do_resulttypepass(left);
+        end;
+    value:=aktstate.find_fact(hp.left);
+    if value<>nil then
+        begin
+      track_state_pass:=true;
+      hp.left.destroy;
+      hp.left:=value.getcopy;
+      do_resulttypepass(hp.left);
+        end;
+    hp:=Tcallparanode(hp.right);
+      end;
     end;
     end;
 {$endif}
 {$endif}
 
 
@@ -1904,7 +1904,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.83  2002-07-20 11:57:53  florian
+  Revision 1.84  2002-08-16 14:24:57  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.83  2002/07/20 11:57:53  florian
     * types.pas renamed to defbase.pas because D6 contains a types
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added
     + Willamette/SSE2 instructions to assembler added

+ 82 - 27
compiler/ncgutil.pas

@@ -30,7 +30,7 @@ interface
       node,cpuinfo,
       node,cpuinfo,
       cpubase,cpupara,
       cpubase,cpupara,
       aasmbase,aasmtai,aasmcpu,
       aasmbase,aasmtai,aasmcpu,
-      cginfo,
+      cginfo,symbase,symdef,symtype,
       rgobj;
       rgobj;
 
 
     type
     type
@@ -65,27 +65,36 @@ interface
    procedure genimplicitunitinit(list : TAAsmoutput);
    procedure genimplicitunitinit(list : TAAsmoutput);
    procedure genimplicitunitfinal(list : TAAsmoutput);
    procedure genimplicitunitfinal(list : TAAsmoutput);
 
 
-          {#
-              Allocate the buffers for exception management and setjmp environment.
-              Return a pointer to these buffers, send them to the utility routine
-              so they are registered, and then call setjmp.
+   {#
+      Allocate the buffers for exception management and setjmp environment.
+      Return a pointer to these buffers, send them to the utility routine
+      so they are registered, and then call setjmp.
 
 
-              Then compare the result of setjmp with 0, and if not equal
-              to zero, then jump to exceptlabel.
-
-              Also store the result of setjmp to a temporary space by calling g_save_exception_reason
-
-              It is to note that this routine may be called *after* the stackframe of a
-              routine has been called, therefore on machines where the stack cannot
-              be modified, all temps should be allocated on the heap instead of the
-              stack.
-          }
-          procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
-              a : aword; exceptlabel : tasmlabel);
-          procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
-           a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
+      Then compare the result of setjmp with 0, and if not equal
+      to zero, then jump to exceptlabel.
 
 
+      Also store the result of setjmp to a temporary space by calling g_save_exception_reason
 
 
+      It is to note that this routine may be called *after* the stackframe of a
+      routine has been called, therefore on machines where the stack cannot
+      be modified, all temps should be allocated on the heap instead of the
+      stack.
+    }
+    procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
+      a : aword; exceptlabel : tasmlabel);
+    procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
+      a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
+
+   {#
+      This routine returns the registers which will be used in
+      function results , depending on the return definition
+      type.
+      
+      An empty set can be returned if this function does not return
+      anything in registers.
+   }
+    function getfuncusedregisters(def : tdef): tregisterset;
+      
 
 
 implementation
 implementation
 
 
@@ -96,7 +105,7 @@ implementation
     strings,
     strings,
 {$endif}
 {$endif}
     cutils,cclasses,globtype,globals,systems,verbose,
     cutils,cclasses,globtype,globals,systems,verbose,
-    symbase,symconst,symtype,symsym,symdef,symtable,defbase,paramgr,
+    symconst,symsym,symtable,defbase,paramgr,
     fmodule,
     fmodule,
     cgbase,regvars,
     cgbase,regvars,
 {$ifdef GDB}
 {$ifdef GDB}
@@ -1039,7 +1048,8 @@ implementation
       end;
       end;
 
 
 
 
-    procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi : boolean);
+
+    procedure handle_return_value(list:TAAsmoutput; inlined : boolean;var uses_acc,uses_acchi,uses_fpu : boolean);
       var
       var
         href : treference;
         href : treference;
         hreg : tregister;
         hreg : tregister;
@@ -1072,6 +1082,7 @@ implementation
                end;
                end;
              floatdef :
              floatdef :
                begin
                begin
+                 uses_fpu := true;
                  cg.a_loadfpu_ref_reg(list,cgsize,href,FPU_RESULT_REG);
                  cg.a_loadfpu_ref_reg(list,cgsize,href,FPU_RESULT_REG);
                end;
                end;
              else
              else
@@ -1086,7 +1097,7 @@ implementation
            end;
            end;
          end;
          end;
       end;
       end;
-
+      
 
 
     procedure handle_fast_exit_return_value(list:TAAsmoutput);
     procedure handle_fast_exit_return_value(list:TAAsmoutput);
       var
       var
@@ -1124,6 +1135,43 @@ implementation
       end;
       end;
 
 
 
 
+    function getfuncusedregisters(def : tdef): tregisterset;
+     var
+       paramloc : tparalocation;
+       regset : tregisterset;
+     begin
+       regset:=[];
+       getfuncusedregisters:=[];
+       { if nothing is returned in registers,
+         its useless to continue on in this
+         routine
+       }  
+       if not paramanager.ret_in_reg(def) then
+         exit;
+       paramloc := paramanager.getfuncresultlocreg(def);
+       case paramloc.loc of 
+         LOC_FPUREGISTER, 
+         LOC_CFPUREGISTER, 
+{$ifdef SUPPORT_MMX}         
+         LOC_MMREGISTER, 
+         LOC_CMMREGISTER,
+{$endif}         
+         LOC_REGISTER,LOC_CREGISTER :
+             begin
+               regset := regset + [paramloc.register];
+               if ((paramloc.size in [OS_S64,OS_64]) and
+                  (sizeof(aword) < 8))
+               then
+                 begin
+                    regset := regset + [paramloc.registerhigh];
+                 end;
+             end;
+       else
+         internalerror(20020816);
+      end;
+      getfuncusedregisters:=regset;
+     end;
+
 
 
     procedure genentrycode(list : TAAsmoutput;
     procedure genentrycode(list : TAAsmoutput;
                            make_global:boolean;
                            make_global:boolean;
@@ -1157,7 +1205,7 @@ implementation
         else
         else
          { should we save edi,esi,ebx like C ? }
          { should we save edi,esi,ebx like C ? }
          if (po_savestdregs in aktprocdef.procoptions) then
          if (po_savestdregs in aktprocdef.procoptions) then
-           cg.g_save_standard_registers(list);
+           cg.g_save_standard_registers(list,aktprocdef.usedregisters);
 
 
         { a constructor needs a help procedure }
         { a constructor needs a help procedure }
         if (aktprocdef.proctypeoption=potype_constructor) then
         if (aktprocdef.proctypeoption=potype_constructor) then
@@ -1392,7 +1440,7 @@ implementation
         href : treference;
         href : treference;
         usesacc,
         usesacc,
         usesacchi,
         usesacchi,
-        usesself : boolean;
+        usesself,usesfpu : boolean;
         pd : tprocdef;
         pd : tprocdef;
       begin
       begin
         if aktexit2label.is_used and
         if aktexit2label.is_used and
@@ -1524,7 +1572,7 @@ implementation
             (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
             (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
           begin
           begin
             if (aktprocdef.proctypeoption<>potype_constructor) then
             if (aktprocdef.proctypeoption<>potype_constructor) then
-              handle_return_value(list,inlined,usesacc,usesacchi)
+              handle_return_value(list,inlined,usesacc,usesacchi,usesfpu)
             else
             else
               begin
               begin
                 { successful constructor deletes the zero flag }
                 { successful constructor deletes the zero flag }
@@ -1571,7 +1619,7 @@ implementation
         else
         else
          { should we restore edi ? }
          { should we restore edi ? }
          if (po_savestdregs in aktprocdef.procoptions) then
          if (po_savestdregs in aktprocdef.procoptions) then
-           cg.g_restore_standard_registers(list);
+           cg.g_restore_standard_registers(list,aktprocdef.usedregisters);
 
 
         { remove stackframe }
         { remove stackframe }
         if not inlined then
         if not inlined then
@@ -1731,7 +1779,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.37  2002-08-15 15:15:55  carl
+  Revision 1.38  2002-08-16 14:24:57  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.37  2002/08/15 15:15:55  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * more generic nodes for maths
     * more generic nodes for maths
     * several fixes for better m68k support
     * several fixes for better m68k support

+ 86 - 3
compiler/paramgr.pas

@@ -39,6 +39,12 @@ unit paramgr;
        tparamanager = class
        tparamanager = class
           {# Returns true if the return value can be put in accumulator }
           {# Returns true if the return value can be put in accumulator }
           function ret_in_acc(def : tdef) : boolean;virtual;
           function ret_in_acc(def : tdef) : boolean;virtual;
+          {# Returns true if the return value is put in a register 
+             
+             Either a floating point register, or a general purpose
+             register.
+          }
+          function ret_in_reg(def : tdef) : boolean;virtual;
 
 
           {# Returns true if the return value is actually a parameter
           {# Returns true if the return value is actually a parameter
              pointer.
              pointer.
@@ -70,6 +76,14 @@ unit paramgr;
             generating the wrappers for implemented interfaces.
             generating the wrappers for implemented interfaces.
           }
           }
           function getselflocation(p : tabstractprocdef) : tparalocation;virtual;abstract;
           function getselflocation(p : tabstractprocdef) : tparalocation;virtual;abstract;
+          {# 
+            Returns the location of the result if the result is in
+            a register, the register(s) return depend on the type of
+            the result. 
+            
+            @param(def The definition of the result type of the function)
+          }
+          function getfuncresultlocreg(def : tdef): tparalocation; virtual;
        end;
        end;
 
 
     procedure setparalocs(p : tprocdef);
     procedure setparalocs(p : tprocdef);
@@ -81,10 +95,10 @@ unit paramgr;
   implementation
   implementation
 
 
     uses
     uses
-       cpuinfo,
+       cpuinfo,globals,globtype,
        symconst,symbase,symsym,
        symconst,symbase,symsym,
        rgobj,
        rgobj,
-       defbase;
+       defbase,cgbase,cginfo,verbose;
 
 
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     function tparamanager.ret_in_acc(def : tdef) : boolean;
     function tparamanager.ret_in_acc(def : tdef) : boolean;
@@ -96,6 +110,12 @@ unit paramgr;
                      ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
                      ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
       end;
       end;
 
 
+    function tparamanager.ret_in_reg(def : tdef) : boolean;
+      begin
+        ret_in_reg:=ret_in_acc(def) or (def.deftype=floatdef);
+      end;
+    
+
 
 
     { true if uses a parameter as return value }
     { true if uses a parameter as return value }
     function tparamanager.ret_in_param(def : tdef) : boolean;
     function tparamanager.ret_in_param(def : tdef) : boolean;
@@ -147,6 +167,62 @@ unit paramgr;
            end;
            end;
          end;
          end;
       end;
       end;
+      
+    function tparamanager.getfuncresultlocreg(def : tdef): tparalocation; 
+      begin
+         fillchar(result,sizeof(tparalocation),0);
+         if is_void(def) then exit;
+         
+         result.size := def_cgsize(def);
+         case aktprocdef.rettype.def.deftype of
+           orddef,
+           enumdef :
+             begin
+               result.loc := LOC_REGISTER;
+               if result.size in [OS_64,OS_S64] then
+                begin
+                  result.registerhigh:=accumulatorhigh;
+                  result.register:=accumulator;
+                end
+               else
+                  result.register:=accumulator;
+             end;
+           floatdef :
+             begin
+               result.loc := LOC_FPUREGISTER;
+               if cs_fp_emulation in aktmoduleswitches then
+                  result.register := accumulator
+               else
+                  result.register := FPU_RESULT_REG;
+             end;
+          else
+             begin
+                if ret_in_acc(def) then
+                  begin
+                    result.loc := LOC_REGISTER;
+                    result.register := accumulator;
+                  end
+                else
+                   begin
+                     result.loc := LOC_REFERENCE;
+                     internalerror(2002081602);
+(*                     
+{$ifdef EXTDEBUG}
+                     { it is impossible to have the
+                       return value with an index register
+                       and a symbol!
+                     }
+                     if (ref.index <> R_NO) or (assigned(ref.symbol)) then
+                        internalerror(2002081602);
+{$endif}
+                     result.reference.index := ref.base;
+                     result.reference.offset := ref.offset;
+*)                     
+                   end;
+             end;
+          end;
+      end;
+      
 
 
     procedure setparalocs(p : tprocdef);
     procedure setparalocs(p : tprocdef);
 
 
@@ -190,7 +266,14 @@ end.
 
 
 {
 {
    $Log$
    $Log$
-   Revision 1.11  2002-08-12 15:08:40  carl
+   Revision 1.12  2002-08-16 14:24:58  carl
+     * issameref() to test if two references are the same (then emit no opcodes)
+     + ret_in_reg to replace ret_in_acc
+       (fix some register allocation bugs at the same time)
+     + save_std_register now has an extra parameter which is the
+       usedinproc registers
+
+   Revision 1.11  2002/08/12 15:08:40  carl
      + stab register indexes for powerpc (moved from gdb to cpubase)
      + stab register indexes for powerpc (moved from gdb to cpubase)
      + tprocessor enumeration moved to cpuinfo
      + tprocessor enumeration moved to cpuinfo
      + linker in target_info is now a class
      + linker in target_info is now a class

+ 12 - 5
compiler/powerpc/cgcpu.pas

@@ -91,8 +91,8 @@ unit cgcpu;
         { that's the case, we can use rlwinm to do an AND operation        }
         { that's the case, we can use rlwinm to do an AND operation        }
         function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
         function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
 
 
-        procedure g_save_standard_registers(list : taasmoutput);override;
-        procedure g_restore_standard_registers(list : taasmoutput);override;
+        procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
+        procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
         procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
 
 
@@ -698,12 +698,12 @@ const
         end;
         end;
 
 
 
 
-     procedure tcgppc.g_save_standard_registers(list : taasmoutput);
+     procedure tcgppc.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
        begin
        begin
          {$warning FIX ME}
          {$warning FIX ME}
        end;
        end;
 
 
-     procedure tcgppc.g_restore_standard_registers(list : taasmoutput);
+     procedure tcgppc.g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);
        begin
        begin
          {$warning FIX ME}
          {$warning FIX ME}
        end;
        end;
@@ -1666,7 +1666,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.41  2002-08-15 08:13:54  carl
+  Revision 1.42  2002-08-16 14:24:59  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.41  2002/08/15 08:13:54  carl
     - a_load_sym_ofs_reg removed
     - a_load_sym_ofs_reg removed
     * loadvmt now calls loadaddr_ref_reg instead
     * loadvmt now calls loadaddr_ref_reg instead
 
 

+ 19 - 8
compiler/pstatmnt.pas

@@ -55,6 +55,7 @@ implementation
        pbase,pexpr,
        pbase,pexpr,
        { codegen }
        { codegen }
        rgobj,cgbase
        rgobj,cgbase
+       ,ncgutil
        ,radirect
        ,radirect
 {$ifdef i386}
 {$ifdef i386}
   {$ifndef NoRa386Int}
   {$ifndef NoRa386Int}
@@ -1092,9 +1093,12 @@ implementation
               { update the symtablesize back to 0 if there were no locals }
               { update the symtablesize back to 0 if there were no locals }
               if not haslocals then
               if not haslocals then
                symtablestack.datasize:=0;
                symtablestack.datasize:=0;
-              { set the used flag for the return }
-              if paramanager.ret_in_acc(aktprocdef.rettype.def) then
-                 include(rg.usedinproc,accumulator);
+              { set the used registers depending on the function result }
+              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
+                begin
+                  rg.usedinproc := rg.usedinproc + 
+                    getfuncusedregisters(aktprocdef.rettype.def);
+                end;
             end;
             end;
          { force the asm statement }
          { force the asm statement }
          if token<>_ASM then
          if token<>_ASM then
@@ -1125,11 +1129,11 @@ implementation
             then
             then
            OptimizeFramePointer(tasmnode(p));
            OptimizeFramePointer(tasmnode(p));
 
 
-        { Flag the result as assigned when it is returned in the
-          accumulator or on the fpu stack }
+        { Flag the result as assigned when it is returned in a
+          register.
+        }  
         if assigned(aktprocdef.funcretsym) and
         if assigned(aktprocdef.funcretsym) and
-           (is_fpu(aktprocdef.rettype.def) or
-           paramanager.ret_in_acc(aktprocdef.rettype.def)) then
+           paramanager.ret_in_reg(aktprocdef.rettype.def) then
           tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
           tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
 
 
         { because the END is already read we need to get the
         { because the END is already read we need to get the
@@ -1142,7 +1146,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.70  2002-08-11 14:32:27  peter
+  Revision 1.71  2002-08-16 14:24:58  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.70  2002/08/11 14:32:27  peter
     * renamed current_library to objectlibrary
     * renamed current_library to objectlibrary
 
 
   Revision 1.69  2002/08/11 13:24:12  peter
   Revision 1.69  2002/08/11 13:24:12  peter

+ 18 - 9
compiler/psub.pas

@@ -106,8 +106,10 @@ implementation
               { insert in local symtable }
               { insert in local symtable }
               symtablestack.insert(aktprocdef.funcretsym);
               symtablestack.insert(aktprocdef.funcretsym);
               akttokenpos:=storepos;
               akttokenpos:=storepos;
-              if paramanager.ret_in_acc(aktprocdef.rettype.def) or
-                 (aktprocdef.rettype.def.deftype=floatdef) then
+              { the result will be returned in a register, then setup
+                the temp. memory for the result
+              }  
+              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
                 procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
                 procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
               { insert result also if support is on }
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
               if (m_result in aktmodeswitches) then
@@ -130,18 +132,18 @@ implementation
          { because we don't know yet where the address is }
          { because we don't know yet where the address is }
          if not is_void(aktprocdef.rettype.def) then
          if not is_void(aktprocdef.rettype.def) then
            begin
            begin
-              if paramanager.ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
+              if paramanager.ret_in_reg(aktprocdef.rettype.def) then
                 begin
                 begin
                    { the space has been set in the local symtable }
                    { the space has been set in the local symtable }
                    procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
                    procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
                    if ((procinfo^.flags and pi_operator)<>0) and
                    if ((procinfo^.flags and pi_operator)<>0) and
                       assigned(otsym) then
                       assigned(otsym) then
                      otsym.address:=-procinfo^.return_offset;
                      otsym.address:=-procinfo^.return_offset;
-                   { eax is modified by a function }
-                   include(rg.usedinproc,accumulator);
-                   if (sizeof(aword) < 8) and
-                      (is_64bitint(aktprocdef.rettype.def)) then
-                     include(rg.usedinproc,accumulatorhigh);
+                   { is the return result in registers? The
+                     set them as used in the routine
+                   }  
+                   rg.usedinproc := rg.usedinproc + 
+                      getfuncusedregisters(aktprocdef.rettype.def);
                 end;
                 end;
            end;
            end;
 
 
@@ -814,7 +816,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.66  2002-08-11 14:32:27  peter
+  Revision 1.67  2002-08-16 14:24:59  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.66  2002/08/11 14:32:27  peter
     * renamed current_library to objectlibrary
     * renamed current_library to objectlibrary
 
 
   Revision 1.65  2002/08/11 13:24:13  peter
   Revision 1.65  2002/08/11 13:24:13  peter

+ 9 - 2
compiler/rautils.pas

@@ -736,7 +736,7 @@ Begin
   if (not is_void(aktprocdef.rettype.def)) then
   if (not is_void(aktprocdef.rettype.def)) then
    begin
    begin
      if (m_tp7 in aktmodeswitches) and
      if (m_tp7 in aktmodeswitches) and
-        paramanager.ret_in_acc(aktprocdef.rettype.def) then
+        paramanager.ret_in_reg(aktprocdef.rettype.def) then
        begin
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
          exit;
@@ -1592,7 +1592,14 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.42  2002-08-13 18:01:52  carl
+  Revision 1.43  2002-08-16 14:24:59  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.42  2002/08/13 18:01:52  carl
     * rename swatoperands to swapoperands
     * rename swatoperands to swapoperands
     + m68k first compilable version (still needs a lot of testing):
     + m68k first compilable version (still needs a lot of testing):
         assembler generator, system information , inline
         assembler generator, system information , inline

+ 10 - 4
compiler/symsym.pas

@@ -1296,9 +1296,8 @@ implementation
          address:=procinfo^.return_offset
          address:=procinfo^.return_offset
         else
         else
          begin
          begin
-           { allocate space in local if ret in acc or in fpu }
-           if paramanager.ret_in_acc(returntype.def) or
-              (returntype.def.deftype=floatdef) then
+           { allocate space in local if ret in register }
+           if paramanager.ret_in_reg(returntype.def) then
             begin
             begin
               l:=returntype.def.size;
               l:=returntype.def.size;
               varalign:=size_2_align(l);
               varalign:=size_2_align(l);
@@ -2672,7 +2671,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.50  2002-08-13 21:40:57  florian
+  Revision 1.51  2002-08-16 14:24:59  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.50  2002/08/13 21:40:57  florian
     * more fixes for ppc calling conventions
     * more fixes for ppc calling conventions
 
 
   Revision 1.49  2002/08/12 15:08:40  carl
   Revision 1.49  2002/08/12 15:08:40  carl

+ 14 - 7
compiler/x86/cgx86.pas

@@ -117,8 +117,8 @@ unit cgx86;
         procedure g_call_destructor_helper(list : taasmoutput);override;
         procedure g_call_destructor_helper(list : taasmoutput);override;
         procedure g_call_fail_helper(list : taasmoutput);override;
         procedure g_call_fail_helper(list : taasmoutput);override;
 {$endif}
 {$endif}
-        procedure g_save_standard_registers(list : taasmoutput);override;
-        procedure g_restore_standard_registers(list : taasmoutput);override;
+        procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
+        procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
         procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
 
 
@@ -1565,20 +1565,20 @@ unit cgx86;
 {$endif}
 {$endif}
 
 
 
 
-    procedure tcgx86.g_save_standard_registers(list : taasmoutput);
+    procedure tcgx86.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
       begin
       begin
-        if (R_EBX in aktprocdef.usedregisters) then
+        if (R_EBX in usedinproc) then
           list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EBX));
           list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EBX));
         list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_ESI));
         list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_ESI));
         list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
         list.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
       end;
       end;
 
 
 
 
-    procedure tcgx86.g_restore_standard_registers(list : taasmoutput);
+    procedure tcgx86.g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);
       begin
       begin
         list.concat(Taicpu.Op_reg(A_POP,S_L,R_EDI));
         list.concat(Taicpu.Op_reg(A_POP,S_L,R_EDI));
         list.concat(Taicpu.Op_reg(A_POP,S_L,R_ESI));
         list.concat(Taicpu.Op_reg(A_POP,S_L,R_ESI));
-        if (R_EBX in aktprocdef.usedregisters) then
+        if (R_EBX in usedinproc) then
          list.concat(Taicpu.Op_reg(A_POP,S_L,R_EBX));
          list.concat(Taicpu.Op_reg(A_POP,S_L,R_EBX));
       end;
       end;
 
 
@@ -1644,7 +1644,14 @@ unit cgx86;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.10  2002-08-15 08:13:54  carl
+  Revision 1.11  2002-08-16 14:25:00  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.10  2002/08/15 08:13:54  carl
     - a_load_sym_ofs_reg removed
     - a_load_sym_ofs_reg removed
     * loadvmt now calls loadaddr_ref_reg instead
     * loadvmt now calls loadaddr_ref_reg instead