--- Merging r13695 into '.':

U    compiler/sparc/cpupara.pas
U    compiler/i386/cpupara.pas
U    compiler/powerpc/cpupara.pas
U    compiler/avr/cpupara.pas
U    compiler/powerpc64/cpupara.pas
U    compiler/x86_64/cpupara.pas
U    compiler/arm/cpupara.pas
U    compiler/paramgr.pas
U    compiler/ncgcal.pas
--- Merging r13760 into '.':
U    compiler/cgbase.pas
U    compiler/x86/cgx86.pas
U    compiler/x86/agx86att.pas
U    compiler/x86/aasmcpu.pas
U    compiler/aasmbase.pas
--- Merging r13761 into '.':
U    compiler/powerpc/agppcvasm.pas
U    compiler/ppcgen/agppcgas.pas
--- Merging r13795 into '.':
G    compiler/x86/cgx86.pas
--- Merging r14392 into '.':
G    compiler/x86/cgx86.pas
--- Merging r14971 into '.':
G    compiler/x86/cgx86.pas
--- Merging r14974 into '.':
G    compiler/x86/cgx86.pas

git-svn-id: branches/fixes_2_4@15174 -

compiler/aasmbase.pas

@@ -329,11 +329,18 @@ implementation
 *****************************************************************************}
 
     constructor TAsmLabel.Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
+      var
+        asmtyp: TAsmsymtype;
       begin
-        if ltyp=alt_addr then
-          inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_ADDR)
-        else
-          inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL);
+        case ltyp of
+          alt_addr:
+            asmtyp:=AT_ADDR;
+          alt_data:
+            asmtyp:=AT_DATA;
+          else
+            asmtyp:=AT_LABEL;
+        end;
+        inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,asmtyp);
         labelnr:=nr;
         labeltype:=ltyp;
         is_set:=false;

compiler/arm/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
        globtype,globals,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
@@ -41,10 +41,12 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):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
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
        end;
 
   implementation
@@ -52,8 +54,7 @@ unit cpupara;
     uses
        verbose,systems,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
     function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
@@ -428,40 +429,40 @@ unit cpupara;
       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
-        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 }
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
         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 }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
           end;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
@@ -470,17 +471,17 @@ unit cpupara;
                   OS_F64:
                     begin
                       { 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;
                   OS_32,
                   OS_F32:
                     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;
                   else
                     internalerror(2005082603);
@@ -488,8 +489,8 @@ unit cpupara;
               end
             else
               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
           { Return in register }
@@ -498,17 +499,29 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
               begin
                 { 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
             else
               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;
+
+
+    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;
 
 

compiler/avr/cpupara.pas

@@ -29,7 +29,7 @@ unit cpupara;
     uses
        globtype,globals,
        aasmtai,aasmdata,
-       cpuinfo,cpubase,cgbase,
+       cpuinfo,cpubase,cgbase,cgutils,
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
@@ -52,8 +52,7 @@ unit cpupara;
     uses
        verbose,systems,
        rgobj,
-       defutil,symsym,
-       cgutils;
+       defutil,symsym;
 
 
     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);
 
+        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 }
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
         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 }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
           end;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
             if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
               begin
@@ -428,17 +441,17 @@ unit cpupara;
                   OS_F64:
                     begin
                       { 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;
                   OS_32,
                   OS_F32:
                     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;
                   else
                     internalerror(2005082603);
@@ -446,8 +459,8 @@ unit cpupara;
               end
             else
               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
           { Return in register }
@@ -456,18 +469,18 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
               begin
                 { 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
             else
               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;
 
 
     function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;

compiler/cgbase.pas

@@ -68,7 +68,8 @@ interface
        trefaddr = (
          addr_no,
          addr_full,
-         addr_pic
+         addr_pic,
+         addr_pic_no_got
          {$IF defined(POWERPC) or defined(POWERPC64) or defined(SPARC)}
          ,
          addr_low,         // bits 48-63

compiler/i386/cpupara.pas

@@ -27,7 +27,7 @@ unit cpupara;
 
     uses
        globtype,
-       aasmtai,aasmdata,cpubase,cgbase,
+       aasmtai,aasmdata,cpubase,cgbase,cgutils,
        symconst,symtype,symsym,symdef,
        parabase,paramgr;
 
@@ -49,6 +49,7 @@ unit cpupara;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):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;
+          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;override;
        private
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
@@ -61,8 +62,7 @@ unit cpupara;
     uses
        cutils,
        systems,verbose,
-       defutil,
-       cgutils;
+       defutil;
 
       const
         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);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
         retcgsize  : tcgsize;
       begin
@@ -314,28 +320,28 @@ unit cpupara;
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
         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 }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
           end;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           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
         else
          { Return in register }
@@ -343,26 +349,26 @@ unit cpupara;
             if retcgsize in [OS_64,OS_S64] then
              begin
                { 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
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
+                 result.register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG
                else
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 result.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
                { high 32bits }
                if side=callerside then
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
+                 result.register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG
                else
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 result.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
              end
             else
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               result.loc:=LOC_REGISTER;
+               result.size:=retcgsize;
                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
-                 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;

compiler/ncgcal.pas

@@ -45,6 +45,8 @@ interface
 
        tcgcallnode = class(tcallnode)
        private
+          retloc: tlocation;
+
           procedure handle_return_value;
           procedure release_unused_return_value;
           procedure release_para_temps;
@@ -510,7 +512,6 @@ implementation
       var
         tmpcgsize,
         cgsize    : tcgsize;
-        retloc    : tlocation;
 {$ifdef cpu64bitaddr}
         ref       : treference;
 {$endif cpu64bitaddr}
@@ -529,12 +530,12 @@ implementation
           end;
 
         { 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:
              begin
                location_reset(location,LOC_FPUREGISTER,cgsize);
-               location.register:=procdefinition.funcretloc[callerside].register;
+               location.register:=retloc.register;
 {$ifdef x86}
                tcgx86(cg).inc_fpu_stack;
 {$else x86}
@@ -548,8 +549,8 @@ implementation
                  (mantis #13536).  }
                if (cnf_return_value_used in callnodeflags) then
                  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);
                    cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
                    location.register:=hregister;
@@ -567,7 +568,6 @@ implementation
                     structs with up to 16 bytes are returned in registers }
                   if cgsize in [OS_128,OS_S128] then
                     begin
-                      retloc:=procdefinition.funcretloc[callerside];
                       if retloc.loc<>LOC_REGISTER then
                         internalerror(2009042001);
                       { See #13536 comment above.  }
@@ -591,7 +591,6 @@ implementation
 {$else cpu64bitaddr}
                   if cgsize in [OS_64,OS_S64] then
                     begin
-                      retloc:=procdefinition.funcretloc[callerside];
                       if retloc.loc<>LOC_REGISTER then
                         internalerror(200409141);
                       { See #13536 comment above.  }
@@ -621,8 +620,8 @@ implementation
                       { See #13536 comment above.  }
                       if (cnf_return_value_used in callnodeflags) then
                         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
                             case of odd sized structured results in registers def_cgsize(resultdef)
@@ -633,10 +632,10 @@ implementation
                             tmpcgsize:=cgsize;
 
                           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
                       else
-                        location:=procdefinition.funcretloc[callerside];
+                        location:=retloc;
                     end;
 {$ifdef arm}
                   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
                  begin
                    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);
-                   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
                else
-                 location:=procdefinition.funcretloc[callerside];
+                 location:=retloc;
              end;
 
            else
@@ -735,8 +734,8 @@ implementation
                 end;
 {$endif x86}
            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);
           end;
       end;
@@ -944,16 +943,49 @@ implementation
          { Include Function result registers }
          if (not is_void(resultdef)) then
           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_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_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_CMMREGISTER:
-                include(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
+                include(regs_to_save_mm,getsupreg(retloc.register));
               LOC_REFERENCE,
               LOC_VOID:
                 ;
@@ -1145,26 +1177,32 @@ implementation
            function result }
          if (not is_void(resultdef)) then
            begin
-             case procdefinition.funcretloc[callerside].loc of
+             case retloc.loc of
                LOC_REGISTER,
                LOC_CREGISTER:
                  begin
 {$ifndef cpu64bitalu}
-                   if procdefinition.funcretloc[callerside].size in [OS_64,OS_S64] then
+                   if retloc.size in [OS_64,OS_S64] then
                      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
-                   else
 {$endif not cpu64bitalu}
-                     exclude(regs_to_save_int,getsupreg(procdefinition.funcretloc[callerside].register));
+                   else
+                     exclude(regs_to_save_int,getsupreg(retloc.register));
                  end;
                LOC_FPUREGISTER,
                LOC_CFPUREGISTER:
-                 exclude(regs_to_save_fpu,getsupreg(procdefinition.funcretloc[callerside].register));
+                 exclude(regs_to_save_fpu,getsupreg(retloc.register));
                LOC_MMREGISTER,
                LOC_CMMREGISTER:
-                 exclude(regs_to_save_mm,getsupreg(procdefinition.funcretloc[callerside].register));
+                 exclude(regs_to_save_mm,getsupreg(retloc.register));
                LOC_REFERENCE,
                LOC_VOID:
                  ;

compiler/paramgr.pas

@@ -29,7 +29,7 @@ unit paramgr;
 
     uses
        cclasses,globtype,
-       cpubase,cgbase,
+       cpubase,cgbase,cgutils,
        parabase,
        aasmtai,aasmdata,
        symconst,symtype,symsym,symdef;
@@ -96,6 +96,12 @@ unit paramgr;
           }
           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
             for the routine when it is being inlined. It returns
             the size allocated on the stack
@@ -124,7 +130,7 @@ implementation
 
     uses
        systems,
-       cgobj,tgobj,cgutils,
+       cgobj,tgobj,
        defutil,verbose;
 
     { true if the location in paraloc can be reused as localloc }

compiler/powerpc/agppcvasm.pas

@@ -66,13 +66,13 @@ unit agppcvasm;
 
 {$ifdef cpu64bitaddr}
     const
-      refaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+      refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
       verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta];
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
+      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
 {$else cpu64bitaddr}
     const
-      refaddr2str: array[trefaddr] of string[3] = ('','','','@l','@h','@ha');
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','lo16','hi16','ha16');
+      refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha');
+      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16');
       verbose_refaddrs = [addr_low,addr_high,addr_higha];
 {$endif cpu64bitaddr}
 

compiler/powerpc/cpupara.pas

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

compiler/powerpc64/cpupara.pas

@@ -29,7 +29,7 @@ uses
   aasmtai,aasmdata,
   cpubase,
   symconst, symtype, symdef, symsym,
-  paramgr, parabase, cgbase;
+  paramgr, parabase, cgbase, cgutils;
 
 type
   tppcparamanager = class(tparamanager)
@@ -45,6 +45,7 @@ type
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): 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);
 
   private
@@ -62,7 +63,6 @@ implementation
 uses
   verbose, systems,
   defutil,
-  cgutils,
   procinfo, cpupi;
 
 function tppcparamanager.get_volatile_registers_int(calloption:
@@ -204,6 +204,12 @@ end;
 
 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
   retcgsize: tcgsize;
 begin
@@ -211,37 +217,37 @@ begin
   if (p.proctypeoption = potype_constructor) then
     retcgsize := OS_ADDR
   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 }
-  if is_void(p.returndef) then begin
-    p.funcretloc[side].loc := LOC_VOID;
+  if is_void(def) then begin
+    result.loc := LOC_VOID;
     exit;
   end;
   { Return is passed as var parameter }
-  if ret_in_param(p.returndef, p.proccalloption) then
+  if ret_in_param(def, p.proccalloption) then
     begin
-      p.funcretloc[side].loc := LOC_REFERENCE;
-      p.funcretloc[side].size := retcgsize;
+      result.loc := LOC_REFERENCE;
+      result.size := retcgsize;
       exit;
     end;
   { 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
     { Return in register }
     begin
-      p.funcretloc[side].loc := LOC_REGISTER;
-      p.funcretloc[side].size := retcgsize;
+      result.loc := LOC_REGISTER;
+      result.size := retcgsize;
       if side = callerside then
-        p.funcretloc[side].register := newreg(R_INTREGISTER,
+        result.register := newreg(R_INTREGISTER,
           RS_FUNCTION_RESULT_REG, cgsize2subreg(R_INTREGISTER, retcgsize))
       else
-        p.funcretloc[side].register := newreg(R_INTREGISTER,
+        result.register := newreg(R_INTREGISTER,
           RS_FUNCTION_RETURN_REG, cgsize2subreg(R_INTREGISTER, retcgsize));
     end;
 end;

compiler/ppcgen/agppcgas.pas

@@ -71,13 +71,13 @@ unit agppcgas;
 
 {$ifdef cpu64bitaddr}
     const
-      refaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+      refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
       verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta];
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
+      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
 {$else cpu64bitaddr}
     const
-      refaddr2str: array[trefaddr] of string[3] = ('','','','@l','@h','@ha');
-      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','lo16','hi16','ha16');
+      refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha');
+      refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16');
       verbose_refaddrs = [addr_low,addr_high,addr_higha];
 {$endif cpu64bitaddr}
 

compiler/sparc/cpupara.pas

@@ -28,7 +28,7 @@ interface
       cclasses,
       aasmtai,aasmdata,
       cpubase,cpuinfo,
-      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase;
+      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils;
 
     type
       TSparcParaManager=class(TParaManager)
@@ -41,6 +41,7 @@ interface
         procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):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
         procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
@@ -52,7 +53,7 @@ implementation
     uses
       cutils,verbose,systems,
       defutil,
-      cgutils,cgobj;
+      cgobj;
 
     type
       tparasupregs = array[0..5] of tsuperregister;
@@ -139,6 +140,12 @@ implementation
 
 
     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
         retcgsize  : tcgsize;
       begin
@@ -146,31 +153,31 @@ implementation
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
         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 }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            p.funcretloc[side].loc:=LOC_VOID;
+            result.loc:=LOC_VOID;
             exit;
           end;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           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
-              setsubreg(p.funcretloc[side].register,R_SUBFD);
-            p.funcretloc[side].size:=retcgsize;
+              setsubreg(result.register,R_SUBFD);
+            result.size:=retcgsize;
           end
         else
          { Return in register }
@@ -178,27 +185,27 @@ implementation
 {$ifndef cpu64bitaddr}
             if retcgsize in [OS_64,OS_S64] then
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
+               result.loc:=LOC_REGISTER;
                { high }
                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
-                 p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                 result.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
                { low }
                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
-                 p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                 result.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
              end
             else
 {$endif not cpu64bitaddr}
              begin
-               p.funcretloc[side].loc:=LOC_REGISTER;
-               p.funcretloc[side].size:=retcgsize;
+               result.loc:=LOC_REGISTER;
+               result.size:=retcgsize;
                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
-                 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;

compiler/x86/aasmcpu.pas

@@ -931,7 +931,7 @@ implementation
                   if (ref^.refaddr=addr_no)
 {$ifdef x86_64}
                      or (
-                         (ref^.refaddr=addr_pic) and
+                         (ref^.refaddr in [addr_pic,addr_pic_no_got]) and
                          (ref^.base<>NR_NO)
                         )
 {$endif x86_64}

compiler/x86/agx86att.pas

@@ -162,7 +162,7 @@ interface
           top_reg :
             owner.AsmWrite(gas_regname(o.reg));
           top_ref :
-            if o.ref^.refaddr in [addr_no,addr_pic] then
+            if o.ref^.refaddr in [addr_no,addr_pic,addr_pic_no_got] then
               WriteReference(o.ref^)
             else
               begin

compiler/x86/cgx86.pas

@@ -350,6 +350,11 @@ unit cgx86;
         add_hreg: boolean;
 {$endif not  x86_64}
       begin
+        { make_simple_ref() may have already been called earlier, and in that
+          case make sure we don't perform the PIC-simplifications twice }
+        if (ref.refaddr in [addr_pic,addr_pic_no_got]) then
+          exit;
+
 {$ifdef x86_64}
         { Only 32bit is allowed }
         if ((ref.offset<low(longint)) or (ref.offset>high(longint))) then
@@ -385,13 +390,45 @@ unit cgx86;
           begin
             if cs_create_pic in current_settings.moduleswitches then
               begin
-                reference_reset_symbol(href,ref.symbol,0,sizeof(pint));
-                hreg:=getaddressregister(list);
-                href.refaddr:=addr_pic;
-                href.base:=NR_RIP;
-                list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,hreg));
+                { Local data symbols must not be accessed via the GOT on
+                  darwin/x86_64 under certain circumstances (and do not
+                  have to be in other cases); however, linux/x86_64 does
+                  require it; don't know about others, so do use GOT for
+                  safety reasons
+                }
+                if (ref.symbol.bind=AB_LOCAL) and
+                   (ref.symbol.typ=AT_DATA) and
+                   ((target_info.system=system_x86_64_darwin) or
+                    (target_info.system=system_x86_64_solaris)) then
+                  begin
+                    { unfortunately, RIP-based addresses don't support an index }
+                    if (ref.base<>NR_NO) or
+                       (ref.index<>NR_NO) then
+                      begin
+                        reference_reset_symbol(href,ref.symbol,0,ref.alignment);
+                        hreg:=getaddressregister(list);
+                        href.refaddr:=addr_pic_no_got;
+                        href.base:=NR_RIP;
+                        list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg));
+                        ref.symbol:=nil;
+                      end
+                    else
+                      begin
+                        ref.refaddr:=addr_pic_no_got;
+                        hreg:=NR_NO;
+                        ref.base:=NR_RIP;
+                      end;
+                  end
+                else
+                  begin
+                    reference_reset_symbol(href,ref.symbol,0,ref.alignment);
+                    hreg:=getaddressregister(list);
+                    href.refaddr:=addr_pic;
+                    href.base:=NR_RIP;
+                    list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,hreg));
 
-                ref.symbol:=nil;
+                    ref.symbol:=nil;
+                  end;
 
                 if ref.base=NR_NO then
                   ref.base:=hreg
@@ -407,17 +444,21 @@ unit cgx86;
                   end;
               end
             else
-              { Always use RIP relative symbol addressing for Windows targets. }
-              if (target_info.system in system_all_windows) and (ref.base<>NR_RIP) then
+              { Always use RIP relative symbol addressing for Windows and Darwin targets. }
+              if (target_info.system in (system_all_windows+[system_x86_64_darwin])) and (ref.base<>NR_RIP) then
                 begin
                   if (ref.refaddr=addr_no) and (ref.base=NR_NO) and (ref.index=NR_NO) then
-                    { Set RIP relative addressing for simple symbol references }
-                    ref.base:=NR_RIP
+                    begin
+                      { Set RIP relative addressing for simple symbol references }
+                      ref.base:=NR_RIP;
+                      ref.refaddr:=addr_pic_no_got
+                    end
                   else
                     begin
                       { Use temp register to load calculated 64-bit symbol address for complex references }
                       reference_reset_symbol(href,ref.symbol,0,sizeof(pint));
                       href.base:=NR_RIP;
+                      href.refaddr:=addr_pic_no_got;
                       hreg:=GetAddressRegister(list);
                       list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg));
                       ref.symbol:=nil;
@@ -873,7 +914,14 @@ unit cgx86;
                            list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r));
                          end;
                       end
-                    else if (cs_create_pic in current_settings.moduleswitches) then
+                    else if (cs_create_pic in current_settings.moduleswitches)
+{$ifdef x86_64}
+                             and not((ref.symbol.bind=AB_LOCAL) and
+                                     (ref.symbol.typ=AT_DATA) and
+                                     ((target_info.system=system_x86_64_darwin) or 
+                                     (target_info.system=system_x86_64_solaris)))
+{$endif x86_64}
+                            then
                       begin
 {$ifdef x86_64}
                         reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
@@ -890,6 +938,19 @@ unit cgx86;
                         if offset<>0 then
                           a_op_const_reg(list,OP_ADD,OS_ADDR,offset,r);
                       end
+{$ifdef x86_64}
+                    else if (target_info.system in (system_all_windows+[system_x86_64_darwin])) 
+			 or ((target_info.system = system_x86_64_solaris) and
+                             (cs_create_pic in current_settings.moduleswitches))
+			 then
+                      begin
+                        { Win64 and Darwin/x86_64 always require RIP-relative addressing }
+                        tmpref:=ref;
+                        tmpref.base:=NR_RIP;
+                        tmpref.refaddr:=addr_pic_no_got;
+                        list.concat(Taicpu.op_ref_reg(A_LEA,S_Q,tmpref,r));
+                      end
+{$endif x86_64}
                     else
                       begin
                         tmpref:=ref;

compiler/x86_64/cpupara.pas

@@ -27,7 +27,7 @@ unit cpupara;
 
     uses
       globtype,
-      cpubase,cgbase,
+      cpubase,cgbase,cgutils,
       symconst,symtype,symsym,symdef,
       aasmtai,aasmdata,
       parabase,paramgr;
@@ -48,6 +48,7 @@ unit cpupara;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):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;
 
   implementation
@@ -55,8 +56,7 @@ unit cpupara;
     uses
        cutils,verbose,
        systems,
-       defutil,
-       cgutils;
+       defutil;
 
     const
       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);
+      begin
+        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
+      end;
+
+
+    function tx86_64paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tlocation;
       var
         retcgsize : tcgsize;
       begin
@@ -400,38 +406,38 @@ unit cpupara;
         if (p.proctypeoption=potype_constructor) then
           retcgsize:=OS_ADDR
         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 }
-        if is_void(p.returndef) then
+        if is_void(def) then
           begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
+            location_reset(result,LOC_VOID,OS_NO);
             exit;
           end;
         { Return is passed as var parameter }
-        if ret_in_param(p.returndef,p.proccalloption) then
+        if ret_in_param(def,p.proccalloption) then
           begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
+            result.loc:=LOC_REFERENCE;
+            result.size:=retcgsize;
             exit;
           end;
         { Return in FPU register? }
-        if p.returndef.typ=floatdef then
+        if def.typ=floatdef then
           begin
-            case tfloatdef(p.returndef).floattype of
+            case tfloatdef(def).floattype of
               s32real,s64real:
                 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;
               s64currency,
               s64comp,
               s80real:
                 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;
               else
                 internalerror(200405034);
@@ -440,41 +446,41 @@ unit cpupara;
         else
          { Return in register }
           begin
-            p.funcretloc[side].loc:=LOC_REGISTER;
+            result.loc:=LOC_REGISTER;
             if retcgsize=OS_NO then
               begin
-                case p.returndef.size of
+                case def.size of
                   0..4:
                     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;
                   5..8:
                     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;
                   9..16:
                     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
             else if retcgsize in [OS_128,OS_S128] then
               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
             else
               begin
-                p.funcretloc[side].size:=retcgsize;
+                result.size:=retcgsize;
                 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
-                  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;