浏览代码

* fixed handling the result value of functions where the result type is
forced to something else by the compiler (internal rtl functions etc),
necessary for the objc branch
* fixed adding all used function result registers to the list of
registers that may need to be saved before a function call

git-svn-id: trunk@13695 -

Jonas Maebe 16 年之前
父节点
当前提交
cc5aeb09de

+ 47 - 34
compiler/arm/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
     uses
        globtype,globals,
        globtype,globals,
        aasmtai,aasmdata,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
 
     type
     type
@@ -41,10 +41,12 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
          private
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
        end;
 
 
   implementation
   implementation
@@ -52,8 +54,7 @@ unit cpupara;
     uses
     uses
        verbose,systems,
        verbose,systems,
        rgobj,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -428,40 +429,40 @@ unit cpupara;
       end;
       end;
 
 
 
 
-    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
-      var
-        cur_stack_offset: aword;
-        curintreg, curfloatreg, curmmreg: tsuperregister;
-        retcgsize  : tcgsize;
+    procedure tarmparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
       begin
       begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
 
 
-        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
 
+    function  tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
+      var
+        retcgsize  : tcgsize;
+      begin
         { Constructors return self instead of a boolean }
         { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
+          retcgsize:=def_cgsize(def);
 
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
+        location_reset(result,LOC_INVALID,OS_NO);
+        result.size:=retcgsize;
 
 
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
               begin
@@ -470,17 +471,17 @@ unit cpupara;
                   OS_F64:
                   OS_F64:
                     begin
                     begin
                       { low }
                       { low }
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                      p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
-                      p.funcretloc[side].size:=OS_64;
+                      result.loc:=LOC_REGISTER;
+                      result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
+                      result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                      result.size:=OS_64;
                     end;
                     end;
                   OS_32,
                   OS_32,
                   OS_F32:
                   OS_F32:
                     begin
                     begin
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-                      p.funcretloc[side].size:=OS_32;
+                      result.loc:=LOC_REGISTER;
+                      result.register:=NR_FUNCTION_RETURN_REG;
+                      result.size:=OS_32;
                     end;
                     end;
                   else
                   else
                     internalerror(2005082603);
                     internalerror(2005082603);
@@ -488,8 +489,8 @@ unit cpupara;
               end
               end
             else
             else
               begin
               begin
-                p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                p.funcretloc[side].register:=NR_FPU_RESULT_REG;
+                result.loc:=LOC_FPUREGISTER;
+                result.register:=NR_FPU_RESULT_REG;
               end;
               end;
           end
           end
           { Return in register }
           { Return in register }
@@ -498,17 +499,29 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
             if retcgsize in [OS_64,OS_S64] then
               begin
               begin
                 { low }
                 { low }
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                result.loc:=LOC_REGISTER;
+                result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
+                result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
               end
               end
             else
             else
               begin
               begin
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
+                result.loc:=LOC_REGISTER;
+                result.register:=NR_FUNCTION_RETURN_REG;
               end;
               end;
-
           end;
           end;
+      end;
+
+
+    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+      var
+        cur_stack_offset: aword;
+        curintreg, curfloatreg, curmmreg: tsuperregister;
+      begin
+        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+
+        create_funcretloc_info(p,side);
      end;
      end;
 
 
 
 

+ 40 - 27
compiler/avr/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
     uses
        globtype,globals,
        globtype,globals,
        aasmtai,aasmdata,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
 
     type
     type
@@ -52,8 +52,7 @@ unit cpupara;
     uses
     uses
        verbose,systems,
        verbose,systems,
        rgobj,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
 
 
     function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
     function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -396,30 +395,44 @@ unit cpupara;
 
 
         result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
         result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
 
+        create_funcretloc_info(p,side);
+     end;
+
+
+    procedure tavrparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function  tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
+      var
+        retcgsize  : tcgsize;
+      begin
         { Constructors return self instead of a boolean }
         { Constructors return self instead of a boolean }
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
+          retcgsize:=def_cgsize(def);
 
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
+        location_reset(result,LOC_INVALID,OS_NO);
+        result.size:=retcgsize;
 
 
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
               begin
@@ -428,17 +441,17 @@ unit cpupara;
                   OS_F64:
                   OS_F64:
                     begin
                     begin
                       { low }
                       { low }
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                      p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
-                      p.funcretloc[side].size:=OS_64;
+                      result.loc:=LOC_REGISTER;
+                      result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
+                      result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                      result.size:=OS_64;
                     end;
                     end;
                   OS_32,
                   OS_32,
                   OS_F32:
                   OS_F32:
                     begin
                     begin
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-                      p.funcretloc[side].size:=OS_32;
+                      result.loc:=LOC_REGISTER;
+                      result.register:=NR_FUNCTION_RETURN_REG;
+                      result.size:=OS_32;
                     end;
                     end;
                   else
                   else
                     internalerror(2005082603);
                     internalerror(2005082603);
@@ -446,8 +459,8 @@ unit cpupara;
               end
               end
             else
             else
               begin
               begin
-                p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                p.funcretloc[side].register:=NR_FPU_RESULT_REG;
+                result.loc:=LOC_FPUREGISTER;
+                result.register:=NR_FPU_RESULT_REG;
               end;
               end;
           end
           end
           { Return in register }
           { Return in register }
@@ -456,18 +469,18 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
             if retcgsize in [OS_64,OS_S64] then
               begin
               begin
                 { low }
                 { low }
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
+                result.loc:=LOC_REGISTER;
+                result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
+                result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
               end
               end
             else
             else
               begin
               begin
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
+                result.loc:=LOC_REGISTER;
+                result.register:=NR_FUNCTION_RETURN_REG;
               end;
               end;
 
 
           end;
           end;
-     end;
+      end;
 
 
 
 
     function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
     function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;

+ 30 - 24
compiler/i386/cpupara.pas

@@ -27,7 +27,7 @@ unit cpupara;
 
 
     uses
     uses
        globtype,
        globtype,
-       aasmtai,aasmdata,cpubase,cgbase,
+       aasmtai,aasmdata,cpubase,cgbase,cgutils,
        symconst,symtype,symsym,symdef,
        symconst,symtype,symsym,symdef,
        parabase,paramgr;
        parabase,paramgr;
 
 
@@ -49,6 +49,7 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
        private
        private
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
@@ -61,8 +62,7 @@ unit cpupara;
     uses
     uses
        cutils,
        cutils,
        systems,verbose,
        systems,verbose,
-       defutil,
-       cgutils;
+       defutil;
 
 
       const
       const
         parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
         parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
@@ -307,6 +307,12 @@ unit cpupara;
 
 
 
 
     procedure ti386paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure ti386paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
       var
         retcgsize  : tcgsize;
         retcgsize  : tcgsize;
       begin
       begin
@@ -314,28 +320,28 @@ unit cpupara;
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
+          retcgsize:=def_cgsize(def);
 
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
+        location_reset(result,LOC_INVALID,OS_NO);
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_FPUREGISTER;
-            p.funcretloc[side].register:=NR_FPU_RESULT_REG;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_FPUREGISTER;
+            result.register:=NR_FPU_RESULT_REG;
+            result.size:=retcgsize;
           end
           end
         else
         else
          { Return in register }
          { Return in register }
@@ -343,26 +349,26 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
             if retcgsize in [OS_64,OS_S64] then
              begin
              begin
                { low 32bits }
                { low 32bits }
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=OS_64;
+               result.loc:=LOC_REGISTER;
+               result.size:=OS_64;
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+                 result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
                else
                else
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 result.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
                { high 32bits }
                { high 32bits }
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
                else
                else
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 result.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
              end
              end
             else
             else
              begin
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               result.loc:=LOC_REGISTER;
+               result.size:=retcgsize;
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
                else
                else
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
              end;
              end;
           end;
           end;
       end;
       end;

+ 68 - 30
compiler/ncgcal.pas

@@ -45,6 +45,8 @@ interface
 
 
        tcgcallnode = class(tcallnode)
        tcgcallnode = class(tcallnode)
        private
        private
+          retloc: tlocation;
+
           procedure handle_return_value;
           procedure handle_return_value;
           procedure release_unused_return_value;
           procedure release_unused_return_value;
           procedure release_para_temps;
           procedure release_para_temps;
@@ -510,7 +512,6 @@ implementation
       var
       var
         tmpcgsize,
         tmpcgsize,
         cgsize    : tcgsize;
         cgsize    : tcgsize;
-        retloc    : tlocation;
 {$ifdef cpu64bitaddr}
 {$ifdef cpu64bitaddr}
         ref       : treference;
         ref       : treference;
 {$endif cpu64bitaddr}
 {$endif cpu64bitaddr}
@@ -529,12 +530,12 @@ implementation
           end;
           end;
 
 
         { Load normal (ordinal,float,pointer) result value from accumulator }
         { Load normal (ordinal,float,pointer) result value from accumulator }
-        cgsize:=procdefinition.funcretloc[callerside].size;
-        case procdefinition.funcretloc[callerside].loc of
+        cgsize:=retloc.size;
+        case retloc.loc of
            LOC_FPUREGISTER:
            LOC_FPUREGISTER:
              begin
              begin
                location_reset(location,LOC_FPUREGISTER,cgsize);
                location_reset(location,LOC_FPUREGISTER,cgsize);
-               location.register:=procdefinition.funcretloc[callerside].register;
+               location.register:=retloc.register;
 {$ifdef x86}
 {$ifdef x86}
                tcgx86(cg).inc_fpu_stack;
                tcgx86(cg).inc_fpu_stack;
 {$else x86}
 {$else x86}
@@ -548,8 +549,8 @@ implementation
                  (mantis #13536).  }
                  (mantis #13536).  }
                if (cnf_return_value_used in callnodeflags) then
                if (cnf_return_value_used in callnodeflags) then
                  begin
                  begin
-                   if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then
-                     cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+                   if getsupreg(retloc.register)<first_fpu_imreg then
+                     cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
                    hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
                    hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
                    cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
                    cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
                    location.register:=hregister;
                    location.register:=hregister;
@@ -567,7 +568,6 @@ implementation
                     structs with up to 16 bytes are returned in registers }
                     structs with up to 16 bytes are returned in registers }
                   if cgsize in [OS_128,OS_S128] then
                   if cgsize in [OS_128,OS_S128] then
                     begin
                     begin
-                      retloc:=procdefinition.funcretloc[callerside];
                       if retloc.loc<>LOC_REGISTER then
                       if retloc.loc<>LOC_REGISTER then
                         internalerror(2009042001);
                         internalerror(2009042001);
                       { See #13536 comment above.  }
                       { See #13536 comment above.  }
@@ -591,7 +591,6 @@ implementation
 {$else cpu64bitaddr}
 {$else cpu64bitaddr}
                   if cgsize in [OS_64,OS_S64] then
                   if cgsize in [OS_64,OS_S64] then
                     begin
                     begin
-                      retloc:=procdefinition.funcretloc[callerside];
                       if retloc.loc<>LOC_REGISTER then
                       if retloc.loc<>LOC_REGISTER then
                         internalerror(200409141);
                         internalerror(200409141);
                       { See #13536 comment above.  }
                       { See #13536 comment above.  }
@@ -621,8 +620,8 @@ implementation
                       { See #13536 comment above.  }
                       { See #13536 comment above.  }
                       if (cnf_return_value_used in callnodeflags) then
                       if (cnf_return_value_used in callnodeflags) then
                         begin
                         begin
-                          if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
-                            cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+                          if getsupreg(retloc.register)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
 
 
                           { but use def_size only if it returns something valid because in
                           { but use def_size only if it returns something valid because in
                             case of odd sized structured results in registers def_cgsize(resultdef)
                             case of odd sized structured results in registers def_cgsize(resultdef)
@@ -633,10 +632,10 @@ implementation
                             tmpcgsize:=cgsize;
                             tmpcgsize:=cgsize;
 
 
                           location.register:=cg.getintregister(current_asmdata.CurrAsmList,tmpcgsize);
                           location.register:=cg.getintregister(current_asmdata.CurrAsmList,tmpcgsize);
-                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,tmpcgsize,procdefinition.funcretloc[callerside].register,location.register);
+                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,tmpcgsize,retloc.register,location.register);
                         end
                         end
                       else
                       else
-                        location:=procdefinition.funcretloc[callerside];
+                        location:=retloc;
                     end;
                     end;
 {$ifdef arm}
 {$ifdef arm}
                   if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
                   if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
@@ -658,13 +657,13 @@ implementation
                if (cnf_return_value_used in callnodeflags) then
                if (cnf_return_value_used in callnodeflags) then
                  begin
                  begin
                    location_reset(location,LOC_MMREGISTER,cgsize);
                    location_reset(location,LOC_MMREGISTER,cgsize);
-                   if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
-                     cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+                   if getsupreg(retloc.register)<first_mm_imreg then
+                     cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
                    location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
                    location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
-                   cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
+                   cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,retloc.register,location.register,mms_movescalar);
                  end
                  end
                else
                else
-                 location:=procdefinition.funcretloc[callerside];
+                 location:=retloc;
              end;
              end;
 
 
            else
            else
@@ -735,8 +734,8 @@ implementation
                 end;
                 end;
 {$endif x86}
 {$endif x86}
            end;
            end;
-            if procdefinition.funcretloc[callerside].size<>OS_NO then
-              location_free(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside]);
+            if retloc.size<>OS_NO then
+              location_free(current_asmdata.CurrAsmList,retloc);
             location_reset(location,LOC_VOID,OS_NO);
             location_reset(location,LOC_VOID,OS_NO);
           end;
           end;
       end;
       end;
@@ -944,16 +943,49 @@ implementation
          { Include Function result registers }
          { Include Function result registers }
          if (not is_void(resultdef)) then
          if (not is_void(resultdef)) then
           begin
           begin
-            case procdefinition.funcretloc[callerside].loc of
+            { The forced returntype may have a different size than the one
+              declared for the procdef }
+            if not assigned(typedef) then
+              retloc:=procdefinition.funcretloc[callerside]
+            else
+              retloc:=paramanager.get_funcretloc(procdefinition,callerside,typedef);
+            case retloc.loc of
               LOC_REGISTER,
               LOC_REGISTER,
               LOC_CREGISTER:
               LOC_CREGISTER:
-                include(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register));
+                begin
+{$ifdef cpu64bitaddr}
+                  { x86-64 system v abi:
+                    structs with up to 16 bytes are returned in registers }
+                  if retloc.size in [OS_128,OS_S128] then
+                    begin
+                      include(regs_to_save_int,getsupreg(retloc.register));
+                      include(regs_to_save_int,getsupreg(retloc.registerhi));
+                    end
+                  else
+{$else cpu64bitaddr}
+                  if retloc.size in [OS_64,OS_S64] then
+                    begin
+                      include(regs_to_save_int,getsupreg(retloc.register64.reglo));
+                      include(regs_to_save_int,getsupreg(retloc.register64.reghi));
+                    end
+                  else
+{$endif not cpu64bitaddr}
+                    include(regs_to_save_int,getsupreg(retloc.register));
+                end;
               LOC_FPUREGISTER,
               LOC_FPUREGISTER,
               LOC_CFPUREGISTER:
               LOC_CFPUREGISTER:
-                include(regs_to_save_fpu,getsupreg(procdefinition.funcretloc[callerside].register));
+                begin
+                  include(regs_to_save_fpu,getsupreg(retloc.register));
+{$ifdef SPARC}
+                  { SPARC uses two successive single precision fpu registers
+                    for double-precision values  }
+                  if retloc.size=OS_F64 then
+                    include(regs_to_save_fpu,succ(getsupreg(retloc.register)));
+{$endif SPARC}
+                end;
               LOC_MMREGISTER,
               LOC_MMREGISTER,
               LOC_CMMREGISTER:
               LOC_CMMREGISTER:
-                include(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
+                include(regs_to_save_mm,getsupreg(retloc.register));
               LOC_REFERENCE,
               LOC_REFERENCE,
               LOC_VOID:
               LOC_VOID:
                 ;
                 ;
@@ -1145,26 +1177,32 @@ implementation
            function result }
            function result }
          if (not is_void(resultdef)) then
          if (not is_void(resultdef)) then
            begin
            begin
-             case procdefinition.funcretloc[callerside].loc of
+             case retloc.loc of
                LOC_REGISTER,
                LOC_REGISTER,
                LOC_CREGISTER:
                LOC_CREGISTER:
                  begin
                  begin
 {$ifndef cpu64bitalu}
 {$ifndef cpu64bitalu}
-                   if procdefinition.funcretloc[callerside].size in [OS_64,OS_S64] then
+                   if retloc.size in [OS_64,OS_S64] then
                      begin
                      begin
-                       exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register64.reghi));
-                       exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register64.reglo));
+                       exclude(regs_to_save_int,getsupreg(retloc.register64.reghi));
+                       exclude(regs_to_save_int,getsupreg(retloc.register64.reglo));
+                     end
+{$else not cpu64bitalu}
+                   if retloc.size in [OS_128,OS_S128] then
+                     begin
+                       exclude(regs_to_save_int,getsupreg(retloc.register));
+                       exclude(regs_to_save_int,getsupreg(retloc.registerhi));
                      end
                      end
-                   else
 {$endif not cpu64bitalu}
 {$endif not cpu64bitalu}
-                     exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register));
+                   else
+                     exclude(regs_to_save_int,getsupreg(retloc.register));
                  end;
                  end;
                LOC_FPUREGISTER,
                LOC_FPUREGISTER,
                LOC_CFPUREGISTER:
                LOC_CFPUREGISTER:
-                 exclude(regs_to_save_fpu,getsupreg(procdefinition.funcretloc[callerside].register));
+                 exclude(regs_to_save_fpu,getsupreg(retloc.register));
                LOC_MMREGISTER,
                LOC_MMREGISTER,
                LOC_CMMREGISTER:
                LOC_CMMREGISTER:
-                 exclude(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
+                 exclude(regs_to_save_mm,getsupreg(retloc.register));
                LOC_REFERENCE,
                LOC_REFERENCE,
                LOC_VOID:
                LOC_VOID:
                  ;
                  ;

+ 8 - 2
compiler/paramgr.pas

@@ -29,7 +29,7 @@ unit paramgr;
 
 
     uses
     uses
        cclasses,globtype,
        cclasses,globtype,
-       cpubase,cgbase,
+       cpubase,cgbase,cgutils,
        parabase,
        parabase,
        aasmtai,aasmdata,
        aasmtai,aasmdata,
        symconst,symtype,symsym,symdef;
        symconst,symtype,symsym,symdef;
@@ -96,6 +96,12 @@ unit paramgr;
           }
           }
           function  create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;virtual;abstract;
           function  create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;virtual;abstract;
 
 
+          { Returns the location of the function result if p had def as
+            function result instead of its actual result. Used if the compiler
+            forces the function result to something different than the real
+            result.  }
+          function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;virtual;abstract;
+
           { This is used to populate the location information on all parameters
           { This is used to populate the location information on all parameters
             for the routine when it is being inlined. It returns
             for the routine when it is being inlined. It returns
             the size allocated on the stack
             the size allocated on the stack
@@ -124,7 +130,7 @@ implementation
 
 
     uses
     uses
        systems,
        systems,
-       cgobj,tgobj,cgutils,
+       cgobj,tgobj,
        defutil,verbose;
        defutil,verbose;
 
 
     { true if the location in paraloc can be reused as localloc }
     { true if the location in paraloc can be reused as localloc }

+ 29 - 23
compiler/powerpc/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
        aasmtai,aasmdata,
        aasmtai,aasmdata,
        cpubase,
        cpubase,
        symconst,symtype,symdef,symsym,
        symconst,symtype,symdef,symsym,
-       paramgr,parabase,cgbase;
+       paramgr,parabase,cgbase,cgutils;
 
 
     type
     type
        tppcparamanager = class(tparamanager)
        tppcparamanager = class(tparamanager)
@@ -40,6 +40,7 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
          private
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -53,7 +54,6 @@ unit cpupara;
     uses
     uses
        verbose,systems,
        verbose,systems,
        defutil,
        defutil,
-       cgutils,
        procinfo,cpupi;
        procinfo,cpupi;
 
 
 
 
@@ -245,6 +245,12 @@ unit cpupara;
 
 
 
 
     procedure tppcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure tppcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function tppcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
       var
         retcgsize  : tcgsize;
         retcgsize  : tcgsize;
       begin
       begin
@@ -252,29 +258,29 @@ unit cpupara;
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
+          retcgsize:=def_cgsize(def);
 
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
+        location_reset(result,LOC_INVALID,OS_NO);
+        result.size:=retcgsize;
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_VOID;
+            result.loc:=LOC_VOID;
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_FPUREGISTER;
-            p.funcretloc[side].register:=NR_FPU_RESULT_REG;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_FPUREGISTER;
+            result.register:=NR_FPU_RESULT_REG;
+            result.size:=retcgsize;
           end
           end
         else
         else
          { Return in register }
          { Return in register }
@@ -283,26 +289,26 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
             if retcgsize in [OS_64,OS_S64] then
              begin
              begin
                { low 32bits }
                { low 32bits }
-               p.funcretloc[side].loc:=LOC_REGISTER;
+               result.loc:=LOC_REGISTER;
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
                else
                else
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 result.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
                { high 32bits }
                { high 32bits }
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+                 result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
                else
                else
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 result.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
              end
              end
             else
             else
 {$endif cpu64bitaddr}
 {$endif cpu64bitaddr}
              begin
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               result.loc:=LOC_REGISTER;
+               result.size:=retcgsize;
                if side=callerside then
                if side=callerside then
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
                else
                else
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
              end;
              end;
           end;
           end;
       end;
       end;

+ 24 - 18
compiler/powerpc64/cpupara.pas

@@ -29,7 +29,7 @@ uses
   aasmtai,aasmdata,
   aasmtai,aasmdata,
   cpubase,
   cpubase,
   symconst, symtype, symdef, symsym,
   symconst, symtype, symdef, symsym,
-  paramgr, parabase, cgbase;
+  paramgr, parabase, cgbase, cgutils;
 
 
 type
 type
   tppcparamanager = class(tparamanager)
   tppcparamanager = class(tparamanager)
@@ -45,6 +45,7 @@ type
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
     function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
     function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
       tvarargsparalist): longint; override;
       tvarargsparalist): longint; override;
+    function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
     procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
     procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
 
 
   private
   private
@@ -62,7 +63,6 @@ implementation
 uses
 uses
   verbose, systems,
   verbose, systems,
   defutil,
   defutil,
-  cgutils,
   procinfo, cpupi;
   procinfo, cpupi;
 
 
 function tppcparamanager.get_volatile_registers_int(calloption:
 function tppcparamanager.get_volatile_registers_int(calloption:
@@ -204,6 +204,12 @@ end;
 
 
 procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side:
 procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side:
   tcallercallee);
   tcallercallee);
+begin
+  p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+end;
+
+function tppcparamanager.get_funcretloc(p : tabstractprocdef; side:
+  tcallercallee; def: tdef): tlocation;
 var
 var
   retcgsize: tcgsize;
   retcgsize: tcgsize;
 begin
 begin
@@ -211,37 +217,37 @@ begin
   if (p.proctypeoption = potype_constructor) then
   if (p.proctypeoption = potype_constructor) then
     retcgsize := OS_ADDR
     retcgsize := OS_ADDR
   else
   else
-    retcgsize := def_cgsize(p.returndef);
+    retcgsize := def_cgsize(def);
 
 
-  location_reset(p.funcretloc[side], LOC_INVALID, OS_NO);
-  p.funcretloc[side].size := retcgsize;
+  location_reset(result, LOC_INVALID, OS_NO);
+  result.size := retcgsize;
   { void has no location }
   { void has no location }
-  if is_void(p.returndef) then begin
-    p.funcretloc[side].loc := LOC_VOID;
+  if is_void(def) then begin
+    result.loc := LOC_VOID;
     exit;
     exit;
   end;
   end;
   { Return is passed as var parameter }
   { Return is passed as var parameter }
-  if ret_in_param(p.returndef, p.proccalloption) then
+  if ret_in_param(def, p.proccalloption) then
     begin
     begin
-      p.funcretloc[side].loc := LOC_REFERENCE;
-      p.funcretloc[side].size := retcgsize;
+      result.loc := LOC_REFERENCE;
+      result.size := retcgsize;
       exit;
       exit;
     end;
     end;
   { Return in FPU register? }
   { Return in FPU register? }
-  if p.returndef.typ = floatdef then begin
-    p.funcretloc[side].loc := LOC_FPUREGISTER;
-    p.funcretloc[side].register := NR_FPU_RESULT_REG;
-    p.funcretloc[side].size := retcgsize;
+  if def.typ = floatdef then begin
+    result.loc := LOC_FPUREGISTER;
+    result.register := NR_FPU_RESULT_REG;
+    result.size := retcgsize;
   end else
   end else
     { Return in register }
     { Return in register }
     begin
     begin
-      p.funcretloc[side].loc := LOC_REGISTER;
-      p.funcretloc[side].size := retcgsize;
+      result.loc := LOC_REGISTER;
+      result.size := retcgsize;
       if side = callerside then
       if side = callerside then
-        p.funcretloc[side].register := newreg(R_INTREGISTER,
+        result.register := newreg(R_INTREGISTER,
           RS_FUNCTION_RESULT_REG, cgsize2subreg(R_INTREGISTER, retcgsize))
           RS_FUNCTION_RESULT_REG, cgsize2subreg(R_INTREGISTER, retcgsize))
       else
       else
-        p.funcretloc[side].register := newreg(R_INTREGISTER,
+        result.register := newreg(R_INTREGISTER,
           RS_FUNCTION_RETURN_REG, cgsize2subreg(R_INTREGISTER, retcgsize));
           RS_FUNCTION_RETURN_REG, cgsize2subreg(R_INTREGISTER, retcgsize));
     end;
     end;
 end;
 end;

+ 31 - 24
compiler/sparc/cpupara.pas

@@ -28,7 +28,7 @@ interface
       cclasses,
       cclasses,
       aasmtai,aasmdata,
       aasmtai,aasmdata,
       cpubase,cpuinfo,
       cpubase,cpuinfo,
-      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase;
+      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils;
 
 
     type
     type
       TSparcParaManager=class(TParaManager)
       TSparcParaManager=class(TParaManager)
@@ -41,6 +41,7 @@ interface
         procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
         procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
         function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
         function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
+        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
       private
       private
         procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
@@ -52,7 +53,7 @@ implementation
     uses
     uses
       cutils,verbose,systems,
       cutils,verbose,systems,
       defutil,
       defutil,
-      cgutils,cgobj;
+      cgobj;
 
 
     type
     type
       tparasupregs = array[0..5] of tsuperregister;
       tparasupregs = array[0..5] of tsuperregister;
@@ -139,6 +140,12 @@ implementation
 
 
 
 
     procedure tsparcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure tsparcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function tsparcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
       var
         retcgsize  : tcgsize;
         retcgsize  : tcgsize;
       begin
       begin
@@ -146,31 +153,31 @@ implementation
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
+          retcgsize:=def_cgsize(def);
 
 
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
+        location_reset(result,LOC_INVALID,OS_NO);
+        result.size:=retcgsize;
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_VOID;
+            result.loc:=LOC_VOID;
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_FPUREGISTER;
-            p.funcretloc[side].register:=NR_FPU_RESULT_REG;
+            result.loc:=LOC_FPUREGISTER;
+            result.register:=NR_FPU_RESULT_REG;
             if retcgsize=OS_F64 then
             if retcgsize=OS_F64 then
-              setsubreg(p.funcretloc[side].register,R_SUBFD);
-            p.funcretloc[side].size:=retcgsize;
+              setsubreg(result.register,R_SUBFD);
+            result.size:=retcgsize;
           end
           end
         else
         else
          { Return in register }
          { Return in register }
@@ -178,27 +185,27 @@ implementation
 {$ifndef cpu64bitaddr}
 {$ifndef cpu64bitaddr}
             if retcgsize in [OS_64,OS_S64] then
             if retcgsize in [OS_64,OS_S64] then
              begin
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
+               result.loc:=LOC_REGISTER;
                { high }
                { high }
                if (side=callerside) or (po_inline in p.procoptions) then
                if (side=callerside) or (po_inline in p.procoptions) then
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
                else
                else
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 result.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
                { low }
                { low }
                if (side=callerside) or (po_inline in p.procoptions) then
                if (side=callerside) or (po_inline in p.procoptions) then
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+                 result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
                else
                else
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 result.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
              end
              end
             else
             else
 {$endif not cpu64bitaddr}
 {$endif not cpu64bitaddr}
              begin
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               result.loc:=LOC_REGISTER;
+               result.size:=retcgsize;
                if (side=callerside) then
                if (side=callerside) then
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
                else
                else
-                 p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
+                 result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
              end;
              end;
           end;
           end;
       end;
       end;

+ 39 - 33
compiler/x86_64/cpupara.pas

@@ -27,7 +27,7 @@ unit cpupara;
 
 
     uses
     uses
       globtype,
       globtype,
-      cpubase,cgbase,
+      cpubase,cgbase,cgutils,
       symconst,symtype,symsym,symdef,
       symconst,symtype,symsym,symdef,
       aasmtai,aasmdata,
       aasmtai,aasmdata,
       parabase,paramgr;
       parabase,paramgr;
@@ -48,6 +48,7 @@ unit cpupara;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
        end;
        end;
 
 
   implementation
   implementation
@@ -55,8 +56,7 @@ unit cpupara;
     uses
     uses
        cutils,verbose,
        cutils,verbose,
        systems,
        systems,
-       defutil,
-       cgutils;
+       defutil;
 
 
     const
     const
       paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
       paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
@@ -393,6 +393,12 @@ unit cpupara;
 
 
 
 
     procedure tx86_64paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure tx86_64paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function tx86_64paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
       var
         retcgsize : tcgsize;
         retcgsize : tcgsize;
       begin
       begin
@@ -400,38 +406,38 @@ unit cpupara;
         if (p.proctypeoption=potype_constructor) then
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
           retcgsize:=OS_ADDR
         else
         else
-          retcgsize:=def_cgsize(p.returndef);
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
+          retcgsize:=def_cgsize(def);
+        location_reset(result,LOC_INVALID,OS_NO);
         { void has no location }
         { void has no location }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
             exit;
           end;
           end;
         { Return is passed as var parameter }
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
             exit;
           end;
           end;
         { Return in FPU register? }
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
           begin
-            case tfloatdef(p.returndef).floattype of
+            case tfloatdef(def).floattype of
               s32real,s64real:
               s32real,s64real:
                 begin
                 begin
-                  p.funcretloc[side].loc:=LOC_MMREGISTER;
-                  p.funcretloc[side].register:=NR_MM_RESULT_REG;
-                  p.funcretloc[side].size:=retcgsize;
+                  result.loc:=LOC_MMREGISTER;
+                  result.register:=NR_MM_RESULT_REG;
+                  result.size:=retcgsize;
                 end;
                 end;
               s64currency,
               s64currency,
               s64comp,
               s64comp,
               s80real:
               s80real:
                 begin
                 begin
-                  p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                  p.funcretloc[side].register:=NR_FPU_RESULT_REG;
-                  p.funcretloc[side].size:=retcgsize;
+                  result.loc:=LOC_FPUREGISTER;
+                  result.register:=NR_FPU_RESULT_REG;
+                  result.size:=retcgsize;
                 end;
                 end;
               else
               else
                 internalerror(200405034);
                 internalerror(200405034);
@@ -440,41 +446,41 @@ unit cpupara;
         else
         else
          { Return in register }
          { Return in register }
           begin
           begin
-            p.funcretloc[side].loc:=LOC_REGISTER;
+            result.loc:=LOC_REGISTER;
             if retcgsize=OS_NO then
             if retcgsize=OS_NO then
               begin
               begin
-                case p.returndef.size of
+                case def.size of
                   0..4:
                   0..4:
                     begin
                     begin
-                      p.funcretloc[side].size:=OS_32;
-                      p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBD);
+                      result.size:=OS_32;
+                      result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBD);
                     end;
                     end;
                   5..8:
                   5..8:
                     begin
                     begin
-                      p.funcretloc[side].size:=OS_64;
-                      p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBQ);
+                      result.size:=OS_64;
+                      result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBQ);
                     end;
                     end;
                   9..16:
                   9..16:
                     begin
                     begin
-                      p.funcretloc[side].size:=OS_128;
-                      p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBWHOLE);
-                      p.funcretloc[side].registerhi:=newreg(R_INTREGISTER,RS_RDX,R_SUBWHOLE);
+                      result.size:=OS_128;
+                      result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBWHOLE);
+                      result.registerhi:=newreg(R_INTREGISTER,RS_RDX,R_SUBWHOLE);
                     end;
                     end;
                 end;
                 end;
               end
               end
             else if retcgsize in [OS_128,OS_S128] then
             else if retcgsize in [OS_128,OS_S128] then
               begin
               begin
-                p.funcretloc[side].size:=retcgsize;
-                p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBWHOLE);
-                p.funcretloc[side].registerhi:=newreg(R_INTREGISTER,RS_RDX,R_SUBWHOLE);                
+                result.size:=retcgsize;
+                result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBWHOLE);
+                result.registerhi:=newreg(R_INTREGISTER,RS_RDX,R_SUBWHOLE);
               end
               end
             else
             else
               begin
               begin
-                p.funcretloc[side].size:=retcgsize;
+                result.size:=retcgsize;
                 if side=callerside then
                 if side=callerside then
-                  p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
+                  result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
                 else
                 else
-                  p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
+                  result.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
               end;
               end;
           end;
           end;
       end;
       end;