* pass a list of (pointers to) the paralocs to hlcgobj.a_call/g_call*, as

    required for the LLVM support (LLVM parameter support is not yet
    included)
  * always return the function return loc from a_call*, again as required
    for the LLVM support

git-svn-id: branches/hlcgllvm@26992 -

compiler/hlcg2ll.pas

@@ -149,11 +149,11 @@ unit hlcg2ll;
           }
           procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override;
 
-          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
-          procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
+          function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override;
+          function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
+          function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
@@ -450,18 +450,19 @@ implementation
       cg.a_loadaddr_ref_cgpara(list,r,cgpara);
     end;
 
-  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       cg.a_call_name(list,s,weak);
       result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
-  procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+  function thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
     begin
       cg.a_call_reg(list,reg);
+      result:=get_call_result_cgpara(pd,nil);
     end;
 
-  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
+  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);
       result:=get_call_result_cgpara(pd,forceresdef);

compiler/hlcgobj.pas

@@ -193,14 +193,14 @@ unit hlcgobj;
              Returns the function result location.
              This routine must be overridden for each new target cpu.
           }
-          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
-          procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
+          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
+          function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;virtual;abstract;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             special static calls for inherited methods }
-          procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
+          function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;virtual;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);virtual;abstract;
@@ -258,8 +258,8 @@ unit hlcgobj;
           procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);virtual;
           procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: tcgint; const loc: tlocation);virtual;
 
+          function  get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; virtual;
          protected
-           function  get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
            procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean);
            procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
            procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual;
@@ -536,10 +536,10 @@ unit hlcgobj;
           procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual;
 
           { generate a call to a routine in the system unit }
-          function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
-          function g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+          function g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
+          function g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
          protected
-          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
+          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; virtual;
          public
 
 
@@ -986,15 +986,15 @@ implementation
          end;
     end;
 
-  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
+  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
-      result:=a_call_name(list,pd,s,forceresdef,false);
+      result:=a_call_name(list,pd,s,paras,forceresdef,false);
     end;
 
-    procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
-      begin
-        a_call_name(list,pd,s,nil,false);
-      end;
+  function thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara;
+    begin
+      result:=a_call_name(list,pd,s,paras,nil,false);
+    end;
 
   procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
     var
@@ -1670,7 +1670,7 @@ implementation
     end;
 
 
-  function thlcgobj.get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
     begin
       if not assigned(forceresdef) then
         begin
@@ -2936,7 +2936,7 @@ implementation
          paramanager.getintparaloc(pd,1,cgpara1);
          a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
          paramanager.freecgpara(list,cgpara1);
-         g_call_system_proc(list,pd,nil);
+         g_call_system_proc(list,pd,[@cgpara1],nil);
          cgpara1.done;
          a_label(list,oklabel);
        end;
@@ -2984,7 +2984,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3012,7 +3012,7 @@ implementation
         end;
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
       cgpara2.done;
       cgpara1.done;
     end;
@@ -3051,7 +3051,7 @@ implementation
             { these functions get the pointer by value }
             a_load_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil);
         end
        else
         begin
@@ -3073,7 +3073,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
         end;
        cgpara2.done;
        cgpara1.done;
@@ -3099,7 +3099,7 @@ implementation
            paramanager.getintparaloc(pd,1,cgpara1);
            a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
            paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil);
          end
        else
          begin
@@ -3121,7 +3121,7 @@ implementation
               end;
             paramanager.freecgpara(list,cgpara1);
             paramanager.freecgpara(list,cgpara2);
-            g_call_system_proc(list,pd,nil);
+            g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
          end;
        cgpara1.done;
        cgpara2.done;
@@ -3171,7 +3171,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
           cgpara1.done;
           cgpara2.done;
           exit;
@@ -3181,7 +3181,7 @@ implementation
       paramanager.getintparaloc(pd,1,cgpara1);
       a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil);
       cgpara1.done;
     end;
 
@@ -3235,7 +3235,7 @@ implementation
       paramanager.freecgpara(list,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara3);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
 
       cgpara3.done;
       cgpara2.done;
@@ -3406,7 +3406,7 @@ implementation
                   { if low(to) > maxlongint also range error }
                   (lto > aintmax) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
                    exit
                  end;
                { from is signed and to is unsigned -> when looking at to }
@@ -3421,7 +3421,7 @@ implementation
                if (lfrom > aintmax) or
                   (hto < 0) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
                    exit
                  end;
                { from is unsigned and to is signed -> when looking at to }
@@ -3444,7 +3444,7 @@ implementation
         a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
       else
         a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
-      g_call_system_proc(list,'fpc_rangeerror',nil);
+      g_call_system_proc(list,'fpc_rangeerror',[],nil);
       a_label(list,neglabel);
     end;
 
@@ -3486,7 +3486,7 @@ implementation
       paramanager.getintparaloc(pd,1,cgpara1);
       a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      getmemres:=g_call_system_proc(list,pd,ptrarrdef);
+      getmemres:=g_call_system_proc(list,pd,[@cgpara1],ptrarrdef);
       cgpara1.done;
       { return the new address }
       location_reset(destloc,LOC_REGISTER,OS_ADDR);
@@ -3522,7 +3522,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3541,7 +3541,7 @@ implementation
       { load source }
       a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil);
       cgpara1.done;
     end;
 
@@ -4062,9 +4062,9 @@ implementation
        begin
          { initialize units }
          if not(current_module.islibrary) then
-           g_call_system_proc(list,'fpc_initializeunits',nil)
+           g_call_system_proc(list,'fpc_initializeunits',[],nil)
          else
-           g_call_system_proc(list,'fpc_libinitializeunits',nil);
+           g_call_system_proc(list,'fpc_libinitializeunits',[],nil);
        end;
 
       list.concat(Tai_force_line.Create);
@@ -4082,7 +4082,7 @@ implementation
       { call __EXIT for main program }
       if (not DLLsource) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
-        g_call_system_proc(list,'fpc_do_exit',nil);
+        g_call_system_proc(list,'fpc_do_exit',[],nil);
     end;
 
   procedure thlcgobj.inittempvariables(list: TAsmList);
@@ -4713,26 +4713,26 @@ implementation
         current_asmdata.asmlists[al_procedures].concatlist(data);
     end;
 
-  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     var
       pd: tprocdef;
     begin
       pd:=search_system_proc(procname);
-      result:=g_call_system_proc_intern(list,pd,forceresdef);
+      result:=g_call_system_proc_intern(list,pd,paras,forceresdef);
     end;
 
-  function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       { separate non-virtual routine to make it clear that the routine to
         override, if any, is g_call_system_proc_intern (and that none of
         the g_call_system_proc variants should be made virtual) }
-      result:=g_call_system_proc_intern(list,pd,forceresdef);
+      result:=g_call_system_proc_intern(list,pd,paras,forceresdef);
     end;
 
-  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       allocallcpuregisters(list);
-      result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
+      result:=a_call_name(list,pd,pd.mangledname,paras,forceresdef,false);
       deallocallcpuregisters(list);
     end;
 

compiler/i8086/n8086cal.pas

@@ -28,6 +28,7 @@ interface
 { $define AnsiStrRef}
 
     uses
+      parabase,
       nx86cal,cgutils;
 
     type
@@ -36,7 +37,7 @@ interface
           procedure pop_parasize(pop_size:longint);override;
           procedure extra_interrupt_code;override;
           procedure extra_call_ref_code(var ref: treference);override;
-          procedure do_call_ref(ref: treference);override;
+          function do_call_ref(ref: treference): tcgpara;override;
        end;
 
 
@@ -49,6 +50,7 @@ implementation
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
       ncal,nbas,nmem,nld,ncnv,
+      hlcgobj,
       cga,cgobj,cgx86,cpuinfo;
 
 
@@ -113,11 +115,12 @@ implementation
       end;
 
 
-    procedure ti8086callnode.do_call_ref(ref: treference);
+    function ti8086callnode.do_call_ref(ref: treference): tcgpara;
       begin
         if current_settings.x86memorymodel in x86_far_code_models then
           ref.refaddr:=addr_far_ref;
         current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+        result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
       end;
 
 

compiler/i8086/n8086mem.pas

@@ -154,7 +154,7 @@ implementation
                paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
                paraloc1.done;
                hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
-               hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+               hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[],nil,false);
                hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
              end;
           end

compiler/jvm/hlcgcpu.pas

@@ -50,9 +50,9 @@ uses
 
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
 
-      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
-      procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
-      procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override;
+      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
+      function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;override;
+      function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
 
       procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
       procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override;
@@ -200,7 +200,7 @@ uses
 
       procedure inittempvariables(list:TAsmList);override;
 
-      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; override;
+      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
 
       { in case of an array, the array base address and index have to be
         put on the evaluation stack before the stored value; similarly, for
@@ -314,20 +314,21 @@ implementation
       inherited a_load_const_cgpara(list, tosize, a, cgpara);
     end;
 
-  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       result:=a_call_name_intern(list,pd,s,forceresdef,false);
     end;
 
-  procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara;
     begin
-      a_call_name_intern(list,pd,s,nil,true);
+      result:=a_call_name_intern(list,pd,s,nil,true);
     end;
 
 
-  procedure thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+  function thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
     begin
       internalerror(2012042824);
+      result.init;
     end;
 
 
@@ -705,30 +706,30 @@ implementation
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
           case elemdef.typ of
             arraydef:
-              g_call_system_proc(list,'fpc_initialize_array_dynarr',nil);
+              g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil);
             recorddef,setdef,procvardef:
               begin
                 tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
                 a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
                 case elemdef.typ of
                   recorddef:
-                    g_call_system_proc(list,'fpc_initialize_array_record',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_record',[],nil);
                   setdef:
                     begin
                       if tsetdef(elemdef).elementdef.typ=enumdef then
-                        g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
+                        g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
                       else
-                        g_call_system_proc(list,'fpc_initialize_array_bitset',nil)
+                        g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil)
                     end;
                   procvardef:
-                    g_call_system_proc(list,'fpc_initialize_array_procvar',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_procvar',[],nil);
                 end;
                 tg.ungettemp(list,recref);
               end;
             enumdef:
               begin
                 a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
-                g_call_system_proc(list,'fpc_initialize_array_object',nil);
+                g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
               end;
             stringdef:
               begin
@@ -736,13 +737,13 @@ implementation
                   st_shortstring:
                     begin
                       a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
-                      g_call_system_proc(list,'fpc_initialize_array_shortstring',nil);
+                      g_call_system_proc(list,'fpc_initialize_array_shortstring',[],nil);
                     end;
                   st_ansistring:
-                    g_call_system_proc(list,'fpc_initialize_array_ansistring',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil);
                   st_unicodestring,
                   st_widestring:
-                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil);
                   else
                     internalerror(2011081801);
                 end;
@@ -950,7 +951,7 @@ implementation
     end;
 
 
-  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       result:=inherited;
       pd.init_paraloc_info(callerside);
@@ -1413,7 +1414,7 @@ implementation
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
        end;
-     g_call_system_proc(list,procname,nil);
+     g_call_system_proc(list,procname,[],nil);
      if ndim<>1 then
        begin
          { pop return value, must be the same as dest }
@@ -1437,7 +1438,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,nil,false);
+        a_call_name(list,pd,pd.mangledname,[],nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1449,9 +1450,9 @@ implementation
         a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false));
         { call set copy helper }
         if tsetdef(size).elementdef.typ=enumdef then
-          g_call_system_proc(list,'fpc_enumset_copy',nil)
+          g_call_system_proc(list,'fpc_enumset_copy',[],nil)
         else
-          g_call_system_proc(list,'fpc_bitset_copy',nil);
+          g_call_system_proc(list,'fpc_bitset_copy',[],nil);
       end;
 
 
@@ -1470,7 +1471,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,nil,false);
+        a_call_name(list,pd,pd.mangledname,[],nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1659,22 +1660,22 @@ implementation
       a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER);
       { highloc is invalid, the length is part of the array in Java }
       if is_wide_or_unicode_string(t) then
-        g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil)
+        g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil)
       else if is_ansistring(t) then
-        g_call_system_proc(list,'fpc_initialize_array_ansistring',nil)
+        g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil)
       else if is_dynamic_array(t) then
-        g_call_system_proc(list,'fpc_initialize_array_dynarr',nil)
+        g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil)
       else if is_record(t) or
               (t.typ=setdef) then
         begin
           tg.gethltemp(list,t,t.size,tt_persistent,eleref);
           a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
           if is_record(t) then
-            g_call_system_proc(list,'fpc_initialize_array_record',nil)
+            g_call_system_proc(list,'fpc_initialize_array_record',[],nil)
           else if tsetdef(t).elementdef.typ=enumdef then
-            g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
+            g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
           else
-            g_call_system_proc(list,'fpc_initialize_array_bitset',nil);
+            g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil);
           tg.ungettemp(list,eleref);
         end
       else if (t.typ=enumdef) then
@@ -1682,7 +1683,7 @@ implementation
           if get_enum_init_val_ref(t,eleref) then
             begin
               a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false));
-              g_call_system_proc(list,'fpc_initialize_array_object',nil);
+              g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
             end;
         end
       else
@@ -1715,7 +1716,7 @@ implementation
           else
             internalerror(2013113008);
           a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false));
-          a_call_name(list,pd,pd.mangledname,nil,false);
+          a_call_name(list,pd,pd.mangledname,[],nil,false);
           { parameter removed, no result }
           decstack(list,1);
         end
@@ -1742,7 +1743,7 @@ implementation
         exit;
       current_asmdata.getjumplabel(hl);
       a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
-      g_call_system_proc(list,'fpc_overflow',nil);
+      g_call_system_proc(list,'fpc_overflow',[],nil);
       a_label(list,hl);
     end;
 

compiler/jvm/njvmmat.pas

@@ -158,7 +158,7 @@ implementation
              hlcg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,resultdef,left.location.register,tmpreg);
              current_asmdata.getjumplabel(lab);
              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,-1,tmpreg,lab);
-             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil);
+             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil);
              hlcg.a_label(current_asmdata.CurrAsmList,lab);
            end;
       end;

compiler/jvm/njvmmem.pas

@@ -442,7 +442,7 @@ implementation
                   (tprocsym(psym).ProcdefList.count<>1) then
                  internalerror(2011062607);
                thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
-               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,nil,false);
+               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,[],nil,false);
                { call replaces self parameter with longint result -> no stack
                  height change }
                location_reset(right.location,LOC_REGISTER,OS_S32);

compiler/jvm/tgcpu.pas

@@ -85,7 +85,7 @@ unit tgcpu;
           end
         else
           internalerror(2011060301);
-        hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+        hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
         thlcgjvm(hlcg).decstack(list,1);
         { store reference to instance }
         thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
@@ -146,7 +146,7 @@ unit tgcpu;
                         internalerror(2011062801);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
                     end;
-                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                   { static calls method replaces parameter with set instance
                     -> no change in stack height }
                 end
@@ -169,7 +169,7 @@ unit tgcpu;
                     end
                   else
                     internalerror(2011062803);
-                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                   { duplicate self pointer is removed }
                   thlcgjvm(hlcg).decstack(list,1);
                 end;
@@ -203,7 +203,7 @@ unit tgcpu;
                         internalerror(2011052404);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
                     end;
-                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                   { static calls method replaces parameter with string instance
                     -> no change in stack height }
                   { store reference to instance }

compiler/mips/hlcgcpu.pas

@@ -37,7 +37,7 @@ uses
 
   type
     thlcgmips = class(thlcg2ll)
-      function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; override;
+      function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override;
       procedure a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);override;
     protected
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
@@ -59,7 +59,7 @@ implementation
     cpuinfo,
     cgcpu;
 
-  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     var
       ref: treference;
       sym: tasmsymbol;

compiler/ncgcal.pas

@@ -34,12 +34,13 @@ interface
     type
        tcgcallparanode = class(tcallparanode)
        protected
-          tempcgpara : tcgpara;
           procedure push_addr_para;
           procedure push_value_para;virtual;
           procedure push_formal_para;virtual;
           procedure push_copyout_para;virtual;abstract;
        public
+          tempcgpara : tcgpara;
+
           constructor create(expr,next : tnode);override;
           destructor destroy;override;
           procedure secondcallparan;override;
@@ -55,10 +56,10 @@ interface
           procedure copy_back_paras;
           procedure release_para_temps;
           procedure reorder_parameters;
-          procedure pushparas;
           procedure freeparas;
        protected
           retloc: tcgpara;
+          paralocs: array of pcgpara;
 
           framepointer_paraloc : tcgpara;
           {# This routine is used to push the current frame pointer
@@ -94,7 +95,12 @@ interface
             on ref. }
           function can_call_ref(var ref: treference):boolean;virtual;
           procedure extra_call_ref_code(var ref: treference);virtual;
-          procedure do_call_ref(ref: treference);virtual;
+          function do_call_ref(ref: treference): tcgpara;virtual;
+
+          { store all the parameters in the temporary paralocs in their final
+            location, and create the paralocs array that will be passed to
+            hlcg.a_call_* }
+          procedure pushparas;virtual;
        public
           procedure pass_generate_code;override;
           destructor destroy;override;
@@ -107,7 +113,7 @@ implementation
       systems,
       cutils,verbose,globals,
       cpuinfo,
-      symconst,symtable,symtype,defutil,paramgr,
+      symconst,symtable,symtype,symsym,defutil,paramgr,
       cgbase,pass_2,
       aasmbase,aasmtai,aasmdata,
       nbas,nmem,nld,ncnv,nutils,
@@ -434,9 +440,11 @@ implementation
       end;
 
 
-    procedure tcgcallnode.do_call_ref(ref: treference);
+    function tcgcallnode.do_call_ref(ref: treference): tcgpara;
       begin
         InternalError(2014012901);
+        { silence warning }
+        result.init;
       end;
 
 
@@ -629,6 +637,7 @@ implementation
                end;
              ppn:=tcallparanode(ppn.right);
           end;
+        setlength(paralocs,0);
       end;
 
 
@@ -641,7 +650,7 @@ implementation
          htempref,
          href : treference;
          calleralignment,
-         tmpalignment: longint;
+         tmpalignment, i: longint;
          skipiffinalloc: boolean;
        begin
          { copy all resources to the allocated registers }
@@ -743,6 +752,9 @@ implementation
                end;
              ppn:=tcgcallparanode(ppn.right);
            end;
+         setlength(paralocs,procdefinition.paras.count);
+         for i:=0 to procdefinition.paras.count-1 do
+           paralocs[i]:=@tparavarsym(procdefinition.paras[i]).paraloc[callerside];
        end;
 
 
@@ -812,16 +824,12 @@ implementation
           begin
             { 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);
+            retloc:=hlcg.get_call_result_cgpara(procdefinition,typedef);
             retlocitem:=retloc.location;
             while assigned(retlocitem) do
               begin
                 case retlocitem^.loc of
                   LOC_REGISTER:
-
                     include(regs_to_save_int,getsupreg(retlocitem^.register));
                   LOC_FPUREGISTER:
                     include(regs_to_save_fpu,getsupreg(retlocitem^.register));
@@ -942,11 +950,11 @@ implementation
 
                  { call method }
                  extra_call_code;
+                 retloc.resetiftemp;
                  if callref then
-                   do_call_ref(href)
+                   retloc:=do_call_ref(href)
                  else
-                   hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
-
+                   retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs);
                  extra_post_call_code;
                end
              else
@@ -979,13 +987,14 @@ implementation
                       if (po_interrupt in procdefinition.procoptions) then
                         extra_interrupt_code;
                       extra_call_code;
+                      retloc.resetiftemp;
                       if (name_to_call='') then
                         if cnf_inherited in callnodeflags then
-                          hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname)
+                          retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,paralocs)
                         else
-                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp
+                          retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,paralocs,typedef,po_weakexternal in procdefinition.procoptions)
                       else
-                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp;
+                        retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs,typedef,po_weakexternal in procdefinition.procoptions);
                       extra_post_call_code;
                     end;
                end;
@@ -1045,10 +1054,11 @@ implementation
                 extra_interrupt_code;
               extra_call_code;
 
+              retloc.resetiftemp;
               if callref then
-                do_call_ref(href)
+                retloc:=do_call_ref(href)
               else
-                hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg);
+                retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs);
               extra_post_call_code;
            end;
 

compiler/ncgmat.pas

@@ -257,7 +257,7 @@ implementation
           begin
             current_asmdata.getjumplabel(hl);
             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_NE,torddef(opsize).low.svalue,location.register,hl);
-            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil);
+            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil);
             hlcg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;

compiler/ncgmem.pas

@@ -309,7 +309,7 @@ implementation
             paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
             paraloc1.done;
             hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
-            hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+            hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[@paraloc1],nil,false);
             hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
           end;
       end;
@@ -395,7 +395,7 @@ implementation
                     hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,resultdef,location.reference.base,paraloc1);
                     paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
                     hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                    hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+                    hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[@paraloc1],nil,false);
                     hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
                   end;
                end

compiler/parabase.pas

@@ -110,6 +110,7 @@ unit parabase;
           procedure   ppuwrite(ppufile:tcompilerppufile);
           procedure   ppuload(ppufile:tcompilerppufile);
        end;
+       PCGPara = ^TCGPara;
 
        tvarargsinfo = (
          va_uses_float_reg
@@ -195,6 +196,7 @@ implementation
         result.alignment:=alignment;
         result.size:=size;
         result.intsize:=intsize;
+        result.def:=def;
       end;
 
 

compiler/x86/nx86cal.pas

@@ -30,7 +30,7 @@ interface
     uses
       symdef,
       cgutils,
-      ncgcal;
+      ncgcal,parabase;
 
     type
 
@@ -41,7 +41,7 @@ interface
          procedure do_release_unused_return_value;override;
          procedure set_result_location(realresdef: tstoreddef);override;
          function can_call_ref(var ref: treference):boolean;override;
-         procedure do_call_ref(ref: treference);override;
+         function do_call_ref(ref: treference): tcgpara;override;
        end;
 
 
@@ -49,7 +49,8 @@ implementation
 
     uses
       cgobj,
-      cgbase,cpubase,cgx86,cga,aasmdata,aasmcpu;
+      cgbase,cpubase,cgx86,cga,aasmdata,aasmcpu,
+      hlcgobj;
 
 
 {*****************************************************************************
@@ -91,9 +92,10 @@ implementation
     end;
 
 
-  procedure tx86callnode.do_call_ref(ref: treference);
+  function tx86callnode.do_call_ref(ref: treference): tcgpara;
     begin
       current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+      result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
     end;
 
 end.