* let thlcg.a_call_name() return the tcgpara representing the function

    result location (NR_FUNCTION_RESULT_REG is not valid on all platforms)
   o this requires passing the forced function result type (if any) to this
     method
   o a generic, basic thlcg.a_call_name() is now available that sets the
     function result location; can be called by descendants
  * the availability under all circumstances of the correct function return
    type enables g_call_system_proc() on the JVM platform to now determine
    by itself how many stack slots are removed by the call -> do so, instead
    of manually counting them (or forgetting to do so and messing up the
    maximum evaluation stack height calculations)

git-svn-id: trunk@21862 -

compiler/hlcg2ll.pas

@@ -152,12 +152,12 @@ unit hlcg2ll;
           }
           procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override;
 
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);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;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : aint;register : tregister);override;
@@ -459,9 +459,10 @@ implementation
       cg.a_loadaddr_ref_cgpara(list,r,cgpara);
     end;
 
-  procedure thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       cg.a_call_name(list,s,weak);
+      result:=inherited;
     end;
 
   procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
@@ -474,9 +475,10 @@ implementation
       cg.a_call_ref(list,ref);
     end;
 
-  procedure thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);
+      result:=inherited a_call_name(list,pd,s,forceresdef,false);
     end;
 
   procedure thlcg2ll.a_load_const_reg(list: TAsmList; tosize: tdef; a: aint; register: tregister);

compiler/hlcgobj.pas

@@ -191,14 +191,15 @@ unit hlcgobj;
           }
 
           {# Emits instruction to call the method specified by symbol name.
+             Returns the function result location.
              This routine must be overridden for each new target cpu.
           }
-          procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);virtual;abstract;
+          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
           procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          procedure a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; 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;
@@ -533,7 +534,11 @@ unit hlcgobj;
           procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual;
 
           { generate a call to a routine in the system unit }
-          procedure g_call_system_proc(list: TAsmList; const procname: string);
+          function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
+         protected
+          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
+         public
+
 
           { Generate code to exit an unwind-protected region. The default implementation
             produces a simple jump to destination label. }
@@ -868,6 +873,19 @@ implementation
          end;
     end;
 
+  function thlcgobj.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+    begin
+      { this is incomplete, it only sets the default function result location;
+        for use by descendants }
+      if not assigned(forceresdef) then
+        begin
+          pd.init_paraloc_info(callerside);
+          result:=pd.funcretloc[callerside];
+        end
+      else
+        result:=paramanager.get_funcretloc(pd,callerside,forceresdef);
+    end;
+
   procedure thlcgobj.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
     var
       reg: tregister;
@@ -884,14 +902,14 @@ implementation
       a_call_reg(list,pd,reg);
     end;
 
-  procedure thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
-      a_call_name(list,pd,s,false);
+      result:=a_call_name(list,pd,s,forceresdef,false);
     end;
 
     procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
       begin
-        a_call_name(list,pd,s,false);
+        a_call_name(list,pd,s,nil,false);
       end;
 
   procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: aint; const ref: treference);
@@ -2770,7 +2788,7 @@ implementation
          paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
          a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
          paramanager.freecgpara(list,cgpara1);
-         g_call_system_proc(list,'fpc_handleerror');
+         g_call_system_proc(list,'fpc_handleerror',nil);
          cgpara1.done;
          a_label(list,oklabel);
        end;
@@ -2810,7 +2828,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,'fpc_shortstr_assign');
+      g_call_system_proc(list,'fpc_shortstr_assign',nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -2830,7 +2848,7 @@ implementation
       a_loadaddr_ref_cgpara(list,vardef,source,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,'fpc_variant_copy_overwrite');
+      g_call_system_proc(list,'fpc_variant_copy_overwrite',nil);
       cgpara2.done;
       cgpara1.done;
     end;
@@ -2868,7 +2886,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,incrfunc);
+          g_call_system_proc(list,incrfunc,nil);
         end
        else
         begin
@@ -2879,7 +2897,7 @@ implementation
           a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,'fpc_addref');
+          g_call_system_proc(list,'fpc_addref',nil);
         end;
        cgpara2.done;
        cgpara1.done;
@@ -2905,7 +2923,7 @@ implementation
            paramanager.getintparaloc(pocall_default,1,pvardata,cgpara1);
            a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
            paramanager.freecgpara(list,cgpara1);
-           g_call_system_proc(list,'fpc_variant_init');
+           g_call_system_proc(list,'fpc_variant_init',nil);
          end
        else
          begin
@@ -2918,7 +2936,7 @@ implementation
             a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
             paramanager.freecgpara(list,cgpara1);
             paramanager.freecgpara(list,cgpara2);
-            g_call_system_proc(list,'fpc_initialize');
+            g_call_system_proc(list,'fpc_initialize',nil);
          end;
       cgpara1.done;
       cgpara2.done;
@@ -2965,9 +2983,9 @@ implementation
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
           if dynarr then
-            g_call_system_proc(list,'fpc_dynarray_clear')
+            g_call_system_proc(list,'fpc_dynarray_clear',nil)
           else
-            g_call_system_proc(list,'fpc_finalize');
+            g_call_system_proc(list,'fpc_finalize',nil);
           cgpara1.done;
           cgpara2.done;
           exit;
@@ -2976,7 +2994,7 @@ implementation
       paramanager.getintparaloc(pocall_default,1,paratype,cgpara1);
       a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,decrfunc);
+      g_call_system_proc(list,decrfunc,nil);
       cgpara1.done;
     end;
 
@@ -3016,7 +3034,7 @@ implementation
       paramanager.freecgpara(list,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara3);
-      g_call_system_proc(list,name);
+      g_call_system_proc(list,name,nil);
 
       cgpara3.done;
       cgpara2.done;
@@ -3187,7 +3205,7 @@ implementation
                   { if low(to) > maxlongint also range error }
                   (lto > aintmax) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror');
+                   g_call_system_proc(list,'fpc_rangeerror',nil);
                    exit
                  end;
                { from is signed and to is unsigned -> when looking at to }
@@ -3202,7 +3220,7 @@ implementation
                if (lfrom > aintmax) or
                   (hto < 0) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror');
+                   g_call_system_proc(list,'fpc_rangeerror',nil);
                    exit
                  end;
                { from is unsigned and to is signed -> when looking at to }
@@ -3225,7 +3243,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');
+      g_call_system_proc(list,'fpc_rangeerror',nil);
       a_label(list,neglabel);
     end;
 
@@ -4319,7 +4337,7 @@ implementation
         current_asmdata.asmlists[al_procedures].concatlist(data);
     end;
 
-  procedure thlcgobj.g_call_system_proc(list: TAsmList; const procname: string);
+  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
     var
       srsym: tsym;
       pd: tprocdef;
@@ -4332,8 +4350,13 @@ implementation
          (srsym.typ<>procsym) then
         Message1(cg_f_unknown_compilerproc,procname);
       pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
+      result:=g_call_system_proc_intern(list,pd,forceresdef);
+    end;
+
+  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+    begin
       allocallcpuregisters(list);
-      a_call_name(list,pd,pd.mangledname,false);
+      result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
       deallocallcpuregisters(list);
     end;
 

compiler/jvm/hlcgcpu.pas

@@ -50,7 +50,7 @@ uses
 
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : aint;const cgpara : TCGPara);override;
 
-      procedure a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; weak: boolean);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;
 
@@ -158,6 +158,10 @@ uses
         then they have to be zero-extended again on the consumer side }
       procedure maybe_resize_stack_para_val(list: TAsmList; retdef: tdef; callside: boolean);
 
+      { adjust the stack height after a call based on the specified number of
+        slots used for parameters and the provided resultdef }
+      procedure g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
+
 
       property maxevalstackheight: longint read fmaxevalstackheight;
 
@@ -178,6 +182,7 @@ uses
 
       procedure inittempvariables(list:TAsmList);override;
 
+      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; 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
@@ -199,7 +204,7 @@ uses
         JVM does not support unsigned divisions }
       procedure maybepreparedivu32(list: TAsmList; var op: topcg; size: tdef; out isdivu32: boolean);
       { common implementation of a_call_* }
-      procedure a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; inheritedcall: boolean);
+      function a_call_name_intern(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara;
 
       { concatcopy helpers }
       procedure concatcopy_normal_array(list: TAsmList; size: tdef; const source, dest: treference);
@@ -291,14 +296,14 @@ implementation
       inherited a_load_const_cgpara(list, tosize, a, cgpara);
     end;
 
-  procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     begin
-      a_call_name_intern(list,pd,s,false);
+      result:=a_call_name_intern(list,pd,s,forceresdef,false);
     end;
 
   procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
     begin
-      a_call_name_intern(list,pd,s,true);
+      a_call_name_intern(list,pd,s,nil,true);
     end;
 
 
@@ -632,7 +637,6 @@ implementation
       i: longint;
       mangledname: string;
       opc: tasmop;
-      parasize: longint;
       primitivetype: boolean;
     begin
       elemdef:=arrdef;
@@ -682,50 +686,46 @@ implementation
           list.concat(taicpu.op_none(a_dup));
           incstack(list,1);
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
-          parasize:=2;
           case elemdef.typ of
             arraydef:
-              g_call_system_proc(list,'fpc_initialize_array_dynarr');
+              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));
-                inc(parasize);
                 case elemdef.typ of
                   recorddef:
-                    g_call_system_proc(list,'fpc_initialize_array_record');
+                    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')
+                        g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
                       else
-                        g_call_system_proc(list,'fpc_initialize_array_bitset')
+                        g_call_system_proc(list,'fpc_initialize_array_bitset',nil)
                     end;
                   procvardef:
-                    g_call_system_proc(list,'fpc_initialize_array_procvar');
+                    g_call_system_proc(list,'fpc_initialize_array_procvar',nil);
                 end;
                 tg.ungettemp(list,recref);
               end;
             enumdef:
               begin
-                inc(parasize);
                 a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
-                g_call_system_proc(list,'fpc_initialize_array_object');
+                g_call_system_proc(list,'fpc_initialize_array_object',nil);
               end;
             stringdef:
               begin
                 case tstringdef(elemdef).stringtype of
                   st_shortstring:
                     begin
-                      inc(parasize);
                       a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
-                      g_call_system_proc(list,'fpc_initialize_array_shortstring');
+                      g_call_system_proc(list,'fpc_initialize_array_shortstring',nil);
                     end;
                   st_ansistring:
-                    g_call_system_proc(list,'fpc_initialize_array_ansistring');
+                    g_call_system_proc(list,'fpc_initialize_array_ansistring',nil);
                   st_unicodestring,
                   st_widestring:
-                    g_call_system_proc(list,'fpc_initialize_array_unicodestring');
+                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil);
                   else
                     internalerror(2011081801);
                 end;
@@ -733,7 +733,6 @@ implementation
             else
               internalerror(2011081801);
           end;
-          decstack(list,parasize);
         end;
     end;
 
@@ -933,6 +932,15 @@ implementation
       { these are automatically initialised when allocated if necessary }
     end;
 
+
+  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+    begin
+      result:=inherited;
+      pd.init_paraloc_info(callerside);
+      g_adjust_stack_after_call(list,pd,pd.callerargareasize,forceresdef);
+    end;
+
+
   function thlcgjvm.prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint;
     var
       href: treference;
@@ -1287,16 +1295,9 @@ 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);
-     if ndim=1 then
-       begin
-         decstack(list,2);
-         if adddefaultlenparas then
-           decstack(list,2);
-       end
-     else
+     g_call_system_proc(list,procname,nil);
+     if ndim<>1 then
        begin
-         decstack(list,4);
          { pop return value, must be the same as dest }
          list.concat(taicpu.op_none(a_pop));
          decstack(list,1);
@@ -1318,7 +1319,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,false);
+        a_call_name(list,pd,pd.mangledname,nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1330,11 +1331,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')
+          g_call_system_proc(list,'fpc_enumset_copy',nil)
         else
-          g_call_system_proc(list,'fpc_bitset_copy');
-        { both parameters are removed, no function result }
-        decstack(list,2);
+          g_call_system_proc(list,'fpc_bitset_copy',nil);
       end;
 
 
@@ -1353,7 +1352,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,false);
+        a_call_name(list,pd,pd.mangledname,nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1543,22 +1542,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')
+        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')
+        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')
+        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')
+            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')
+            g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
           else
-            g_call_system_proc(list,'fpc_initialize_array_bitset');
+            g_call_system_proc(list,'fpc_initialize_array_bitset',nil);
           tg.ungettemp(list,eleref);
         end
       else if (t.typ=enumdef) then
@@ -1566,7 +1565,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');
+              g_call_system_proc(list,'fpc_initialize_array_object',nil);
             end;
         end
       else
@@ -1597,7 +1596,7 @@ implementation
               pd:=tprocdef(tprocsym(sym).procdeflist[0]);
             end;
           a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false));
-          a_call_name(list,pd,pd.mangledname,false);
+          a_call_name(list,pd,pd.mangledname,nil,false);
           { parameter removed, no result }
           decstack(list,1);
         end
@@ -2060,6 +2059,31 @@ implementation
           end;
       end;
 
+
+  procedure thlcgjvm.g_adjust_stack_after_call(list: TAsmList; pd: tabstractprocdef; paraheight: longint; forceresdef: tdef);
+    var
+      totalremovesize: longint;
+      realresdef: tdef;
+    begin
+      if not assigned(forceresdef) then
+        realresdef:=pd.returndef
+      else
+        realresdef:=forceresdef;
+      { a constructor doesn't actually return a value in the jvm }
+      if (tabstractprocdef(pd).proctypeoption=potype_constructor) then
+        totalremovesize:=paraheight
+      else
+        { even a byte takes up a full stackslot -> align size to multiple of 4 }
+        totalremovesize:=paraheight-(align(realresdef.size,4) shr 2);
+      { remove parameters from internal evaluation stack counter (in case of
+        e.g. no parameters and a result, it can also increase) }
+      if totalremovesize>0 then
+        decstack(list,totalremovesize)
+      else if totalremovesize<0 then
+        incstack(list,-totalremovesize);
+    end;
+
+
   procedure thlcgjvm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
     var
       tmpref: treference;
@@ -2256,7 +2280,7 @@ implementation
         isdivu32:=false;
     end;
 
-  procedure thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; inheritedcall: boolean);
+  function thlcgjvm.a_call_name_intern(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; inheritedcall: boolean): tcgpara;
     var
       opc: tasmop;
     begin
@@ -2319,6 +2343,7 @@ implementation
           pd.init_paraloc_info(calleeside);
           list.concat(taicpu.op_sym_const(opc,current_asmdata.RefAsmSymbol(s),pd.calleeargareasize));
         end;
+      result:=inherited a_call_name(list,pd,s,forceresdef,false);
     end;
 
   procedure create_hlcodegen;

compiler/jvm/njvmcal.pas

@@ -439,33 +439,21 @@ implementation
 
     procedure tjvmcallnode.extra_post_call_code;
       var
-        totalremovesize: longint;
         realresdef: tdef;
       begin
-        if not assigned(typedef) then
-          realresdef:=tstoreddef(resultdef)
-        else
-          realresdef:=tstoreddef(typedef);
+        thlcgjvm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition,pushedparasize,typedef);
         { a constructor doesn't actually return a value in the jvm }
-        if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) then
-          totalremovesize:=pushedparasize
-        else
+        if (tabstractprocdef(procdefinition).proctypeoption<>potype_constructor) then
           begin
-            { zero-extend unsigned 8/16 bit returns (we have to return them
-              sign-extended to keep the Android verifier happy, and even if that
-              one did not exist a plain Java routine could return a
-              sign-extended value) }
             if cnf_return_value_used in callnodeflags then
-              thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false);
-            { even a byte takes up a full stackslot -> align size to multiple of 4 }
-            totalremovesize:=pushedparasize-(align(realresdef.size,4) shr 2);
+              begin
+                if not assigned(typedef) then
+                  realresdef:=tstoreddef(resultdef)
+                else
+                  realresdef:=tstoreddef(typedef);
+                thlcgjvm(hlcg).maybe_resize_stack_para_val(current_asmdata.CurrAsmList,realresdef,false);
+              end;
           end;
-        { remove parameters from internal evaluation stack counter (in case of
-          e.g. no parameters and a result, it can also increase) }
-        if totalremovesize>0 then
-          thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,totalremovesize)
-        else if totalremovesize<0 then
-          thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,-totalremovesize);
 
         { if this was an inherited constructor call, initialise all fields that
           are wrapped types following it }

compiler/jvm/njvmmem.pas

@@ -415,7 +415,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,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,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,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,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,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

@@ -32,12 +32,12 @@ uses
   globtype,
   aasmbase, aasmdata,
   cgbase, cgutils,
-  symdef,
-  hlcgobj, hlcg2ll;
+  symtype,symdef,
+  parabase, hlcgobj, hlcg2ll;
 
   type
-    thlcg2mips = class(thlcg2ll)
-      procedure a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);override;
+    thlcgmips = class(thlcg2ll)
+      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;
       procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override;
   end;
@@ -53,7 +53,7 @@ implementation
     cpubase,
     cgcpu;
 
-  procedure thlcg2mips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; weak: boolean);
+  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
     var
       ref : treference;
     begin
@@ -73,9 +73,11 @@ implementation
         end
       else
         cg.a_call_name(list,s,weak);
+      { the default implementation only determines the result location }
+      result:=inherited;
     end;
 
-  procedure thlcg2mips.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+  procedure thlcgmips.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
     begin
       if (pd.proccalloption=pocall_cdecl) and (reg<>NR_PIC_FUNC) then
         begin
@@ -88,7 +90,7 @@ implementation
         cg.a_call_reg(list,reg);
     end;
 
-  procedure thlcg2mips.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
+  procedure thlcgmips.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
     begin
       if pd.proccalloption =pocall_cdecl then
         begin
@@ -103,7 +105,7 @@ implementation
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2mips.create;
+      hlcg:=thlcgmips.create;
       create_codegen;
     end;
 

compiler/ncgcal.pas

@@ -872,9 +872,9 @@ implementation
                         if cnf_inherited in callnodeflags then
                           hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname)
                         else
-                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions)
+                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname,typedef,po_weakexternal in procdefinition.procoptions)
                       else
-                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,po_weakexternal in procdefinition.procoptions);
+                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions);
                       extra_post_call_code;
                     end;
                end;