+ support for formal var/out parameters on the JVM target:

o primitive types are first boxed
   o the parameter is passed inside an array of one class instance
   o changing the parameter inside the routine (by assigning a value to it
     like in Delphi.NET and different from regular Pascal code) will replace
     this class instance (again boxing the value if required)
   o on return, the class instance is extracted, unboxed if required, and
     assigned back to the original location
   o formal const parameters are handled without the extra array indirection,
     since they cannot be changed

  TODO: while writing tjvmcallparanode.handleformalcopyoutpara() I forgot that
    calling getcopy on ttemprefnodes whose ttempcreatenode hasn't been copied
    yet works fine, so that code is more complex than needed. Still have to
    fix.

git-svn-id: branches/jvmbackend@18675 -

compiler/compinnr.inc

@@ -84,6 +84,7 @@ const
    in_bsf_x             = 74;
    in_bsr_x             = 75;
    in_box_x             = 76; { managed platforms: wrap in class instance }
+   in_unbox_x_y         = 77; { manage platforms: extract from class instance }
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/jvm/cpupara.pas

@@ -83,7 +83,10 @@ implementation
     { true if a parameter is too large to copy and only the address is pushed }
     function TJVMParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
-        result:=jvmimplicitpointertype(def);
+        result:=
+          jvmimplicitpointertype(def) or
+          ((def.typ=formaldef) and
+           not(varspez in [vs_var,vs_out]));
       end;
 
 
@@ -92,7 +95,7 @@ implementation
         { in principle also for vs_constref, but since we can't have real
           references, that won't make a difference }
         result:=
-          (varspez in [vs_var,vs_out]) and
+          (varspez in [vs_var,vs_out,vs_constref]) and
           not jvmimplicitpointertype(def);
       end;
 

compiler/jvm/njvmcal.pas

@@ -31,13 +31,14 @@ interface
       ncgcal;
 
     type
-
        tjvmcallparanode = class(tcgcallparanode)
         protected
          outcopybasereg: tregister;
          procedure push_formal_para; override;
          procedure push_copyout_para; override;
 
+         procedure handleformalcopyoutpara(orgparadef: tdef); override;
+
          procedure load_arrayref_para(useparadef: tdef);
        end;
 
@@ -55,12 +56,12 @@ interface
 implementation
 
     uses
-      verbose,globtype,
+      verbose,globtype,constexp,
       symconst,defutil,ncal,
       cgutils,tgobj,procinfo,
       cpubase,aasmdata,aasmcpu,
       hlcgobj,hlcgcpu,
-      node,
+      pass_1,node,nutils,nbas,ncnv,ncon,ninl,nld,nmem,
       jvmdef;
 
 {*****************************************************************************
@@ -95,14 +96,22 @@ implementation
 
 
     procedure tjvmcallparanode.push_formal_para;
-      var
-        primitivetype: boolean;
       begin
-        { create an array with one element of JLObject }
+        { primitive values are boxed, so in all cases this is a pointer to
-        thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
+          something and since it cannot be changed (or is not supposed to be
-        { left is either an object-derived type, or has been boxed into one }
+          changed anyway), we don't have to create a temporary array to hold a
-        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_anewarray,current_asmdata.RefAsmSymbol(jvmarrtype(java_jlobject,primitivetype))));
+          pointer to this value and can just pass the pointer to this value
-        load_arrayref_para(java_jlobject);
+          directly.
+
+          In case the value can be changed (formal var/out), then we have
+          already created a temporary array of one element that holds the boxed
+          (or in case of a non-primitive type: original) value. The reason is
+          that copying it back out may be a complex operation which we don't
+          want to handle at the code generator level.
+
+          -> always push a value parameter (which is either an array of one
+          element, or an object) }
+        push_value_para
       end;
 
 
@@ -125,6 +134,220 @@ implementation
       end;
 
 
+    procedure getparabasenodes(p: tnode; out basenode: tnode; out parent: tunarynode);
+      begin
+        parent:=nil;
+        while assigned(p) do
+          begin
+            case p.nodetype of
+              inlinen:
+                begin
+                  if tinlinenode(p).inlinenumber=in_box_x then
+                    begin
+                      parent:=tunarynode(p);
+                      p:=parent.left;
+                    end
+                  else
+                    break;
+                end;
+              subscriptn,
+              vecn:
+                begin
+                  break;
+                end;
+              typeconvn:
+                begin
+                  parent:=tunarynode(p);
+                  { skip typeconversions that don't change the node type }
+                  p:=p.actualtargetnode;
+                end;
+              derefn:
+                begin
+                  parent:=tunarynode(p);
+                  p:=tunarynode(p).left;
+                end
+              else
+                break;
+            end;
+          end;
+        basenode:=p;
+      end;
+
+
+    function replacewithtemps(var orgnode, copiednode: tnode): ttempcreatenode;
+      begin
+        result:=ctempcreatenode.create_value(
+          orgnode.resultdef,orgnode.resultdef.size,
+          tt_persistent,true,orgnode);
+        { this right is reused while constructing the temp }
+        orgnode:=ctemprefnode.create(result);
+        typecheckpass(orgnode);
+        { this right is not reused }
+        copiednode.free;
+        copiednode:=ctemprefnode.create(result);
+        typecheckpass(copiednode);
+      end;
+
+
+    procedure tjvmcallparanode.handleformalcopyoutpara(orgparadef: tdef);
+      var
+        paravaltemp,
+        arraytemp,
+        indextemp: ttempcreatenode;
+        arrdef: tarraydef;
+        initstat,
+        finistat: tstatementnode;
+        leftcopy: tnode;
+        realpara, copyrealpara, tempn, assignmenttempn: tnode;
+        realparaparent,copyrealparaparent: tunarynode;
+        derefbasedef: tdef;
+        deref: boolean;
+      begin
+        fparainit:=internalstatements(initstat);
+        { In general, we now create a temp array of one element, assign left
+          (or its address in case of a jvmimplicitpointertype) to it, replace
+          the parameter with this array, and add code to paracopyback that
+          extracts the value from the array again and assigns it to the original
+          variable.
+
+          Complications
+            a) in case the parameter involves calling a function, it must not
+               be called twice, so take the address of the location (since this
+               is a var/out parameter, taking the address is conceptually
+               always possible)
+            b) in case this is an element of a string, we can't take the address
+               in JVM code, so we then have to take the address of the string
+               (which conceptually may not be possible since it can be a
+                property or so) and store the index value into a temp, and
+                reconstruct the vecn in te paracopyback code from this data
+                (it's similar for normal var/out parameters)
+        }
+
+        { we'll replace a bunch of stuff in the parameter with temprefnodes,
+          but we can't take a getcopy for the assignment afterwards of this
+          result since a getcopy will always assume that we are copying the
+          init/deletenodes too and that the temprefnodes have to point to the
+          new temps -> get a copy of the parameter in advance, and then replace
+          the nodes in the copy with temps just like in the original para }
+        leftcopy:=left.getcopy;
+        { get the real parameter source in case of type conversions. This is
+          the same logic as for set_unique(). The parent is where we have to
+          replace realpara with the temp that replaces it. }
+        getparabasenodes(left,realpara,realparaparent);
+        getparabasenodes(leftcopy,copyrealpara,copyrealparaparent);
+        { assign either the parameter's address (in case it's an implicit
+          pointer type) or the parameter itself (in case it's a primitive or
+          actual pointer/object type) to the temp }
+        deref:=false;
+        if jvmimplicitpointertype(realpara.resultdef) then
+          begin
+            derefbasedef:=realpara.resultdef;
+            realpara:=caddrnode.create_internal(realpara);
+            include(realpara.flags,nf_typedaddr);
+            typecheckpass(realpara);
+            { we'll have to reference the parameter again in the expression }
+            deref:=true;
+          end;
+        paravaltemp:=nil;
+        { make sure we don't replace simple loadnodes with a temp, because
+          in case of passing e.g. stringvar[3] to a formal var/out parameter,
+          we add "stringvar[3]:=<result>" afterwards. Because Java strings are
+          immutable, this is translated into "stringvar:=stringvar.setChar(3,
+          <result>)". So if we replace stringvar with a temp, this will change
+          the temp rather than stringvar. }
+        indextemp:=nil;
+        if (realpara.nodetype=vecn) then
+          begin
+            if node_complexity(tvecnode(realpara).left)>1 then
+              begin
+                paravaltemp:=replacewithtemps(tvecnode(realpara).left,
+                  tvecnode(copyrealpara).left);
+                addstatement(initstat,paravaltemp);
+              end;
+            { in case of an array index, also replace the index with a temp if
+              necessary/useful }
+            if (node_complexity(tvecnode(realpara).right)>1) then
+              begin
+                indextemp:=replacewithtemps(tvecnode(realpara).right,
+                  tvecnode(copyrealpara).right);
+                addstatement(initstat,indextemp);
+              end;
+          end
+        else
+          begin
+            paravaltemp:=ctempcreatenode.create_value(
+              realpara.resultdef,java_jlobject.size,tt_persistent,true,realpara);
+            addstatement(initstat,paravaltemp);
+            { replace the parameter in the parameter expression with this temp }
+            tempn:=ctemprefnode.create(paravaltemp);
+            assignmenttempn:=ctemprefnode.create(paravaltemp);
+            { will be spliced in the middle of a tree that has already been
+              typecheckpassed }
+            typecheckpass(tempn);
+            typecheckpass(assignmenttempn);
+            if assigned(realparaparent) then
+              begin
+                { left has been reused in paravaltemp (it's realpara itself) ->
+                  don't free }
+                realparaparent.left:=tempn;
+                { the left's copy is not reused }
+                copyrealparaparent.left.free;
+                copyrealparaparent.left:=assignmenttempn;
+              end
+            else
+              begin
+                { left has been reused in paravaltemp (it's realpara itself) ->
+                  don't free }
+                left:=tempn;
+                { leftcopy can remain the same }
+                assignmenttempn.free;
+              end;
+          end;
+        { create the array temp that and assign the parameter value (typecasted
+          to java_jlobject) }
+        arrdef:=tarraydef.create(0,1,s32inttype);
+        arrdef.elementdef:=java_jlobject;
+        arraytemp:=ctempcreatenode.create(arrdef,java_jlobject.size,
+          tt_persistent,true);
+        addstatement(initstat,arraytemp);
+        { wrap the primitive type in an object container
+          if required }
+        if (left.resultdef.typ in [orddef,floatdef]) then
+          begin
+            left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil));
+            typecheckpass(left);
+          end;
+        addstatement(initstat,cassignmentnode.create(
+          cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)),
+          ctypeconvnode.create_explicit(left,java_jlobject)));
+        { replace the parameter with the array }
+        left:=ctemprefnode.create(arraytemp);
+        { add the extraction of the parameter and assign it back to the
+          original location }
+        fparacopyback:=internalstatements(finistat);
+        tempn:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0));
+        { unbox if necessary }
+        if orgparadef.typ in [orddef,floatdef] then
+          tempn:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
+            ctypenode.create(orgparadef),ccallparanode.create(tempn,nil)));
+        if (deref) then
+          begin
+            inserttypeconv_explicit(tempn,getpointerdef(derefbasedef));
+            tempn:=cderefnode.create(tempn);
+          end;
+        addstatement(finistat,cassignmentnode.create(leftcopy,
+          ctypeconvnode.create_explicit(tempn,orgparadef)));
+        if assigned(indextemp) then
+          addstatement(finistat,ctempdeletenode.create(indextemp));
+        addstatement(finistat,ctempdeletenode.create(arraytemp));
+        if assigned(paravaltemp) then
+          addstatement(finistat,ctempdeletenode.create(paravaltemp));
+        typecheckpass(fparainit);
+        typecheckpass(left);
+        typecheckpass(fparacopyback);
+      end;
+
+
 {*****************************************************************************
                              TJVMCALLNODE
 *****************************************************************************}
@@ -246,12 +469,8 @@ implementation
                       end
                     else
                       begin
-{$ifndef nounsupported}
+                        { extracting values from foramldef parameters is done
-                        { to do: extract value from boxed parameter or load
+                          by the generic code }
-                          value back }
-{$else}
-                        internalerror(2011051901);
-{$endif}
                       end;
                   end;
               end;

compiler/jvm/njvmcnv.pas

@@ -93,7 +93,7 @@ implementation
       symconst,symdef,symsym,symtable,aasmbase,aasmdata,
       defutil,defcmp,jvmdef,
       cgbase,cgutils,pass_1,pass_2,
-      nbas,ncon,ncal,nld,nmem,procinfo,
+      nbas,ncon,ncal,ninl,nld,nmem,procinfo,
       nutils,
       cpubase,aasmcpu,
       tgobj,hlcgobj,hlcgcpu;
@@ -912,7 +912,35 @@ implementation
           side }
         if (left.resultdef.typ=formaldef) and
            not assignment_side then
-          exit;
+          begin
+            if resultdef.typ in [orddef,floatdef] then
+              begin
+                if not check_only then
+                  begin
+                    resnode:=cinlinenode.create(in_unbox_x_y,false,
+                      ccallparanode.create(ctypenode.create(resultdef),
+                        ccallparanode.create(left,nil)));
+                    left:=nil;
+                  end;
+                result:=true;
+                exit;
+              end
+            else if jvmimplicitpointertype(resultdef) then
+              begin
+                { typecast formaldef to pointer to the type, then deref, so that
+                  a proper checkcast is inserted }
+                if not check_only then
+                  begin
+                    resnode:=ctypeconvnode.create_explicit(left,getpointerdef(resultdef));
+                    resnode:=cderefnode.create(resnode);
+                    left:=nil;
+                  end;
+                result:=true;
+                exit;
+              end;
+            result:=false;
+            exit;
+          end;
 
         { don't allow conversions between different classes of primitive types,
           except for a few special cases }
@@ -1195,7 +1223,8 @@ implementation
       if (checkdef.typ=pointerdef) and
          jvmimplicitpointertype(tpointerdef(checkdef).pointeddef) then
         checkdef:=tpointerdef(checkdef).pointeddef;
-      if checkdef=voidpointertype then
+      if (checkdef=voidpointertype) or
+         (checkdef.typ=formaldef) then
         checkdef:=java_jlobject
       else if checkdef.typ=enumdef then
         checkdef:=tenumdef(checkdef).classdef

compiler/jvm/njvminl.pas

@@ -38,8 +38,8 @@ interface
 
           function first_copy: tnode; override;
 
-          function handle_box: tnode; override;
           function first_box: tnode; override;
+          function first_unbox: tnode; override;
 
           function first_setlength_array: tnode;
           function first_setlength_string: tnode;
@@ -76,7 +76,6 @@ interface
 *)
           procedure second_new; override;
           procedure second_setlength; override;
-          procedure second_box; override;
        protected
           procedure load_fpu_location;
        end;
@@ -238,20 +237,38 @@ implementation
       end;
 
 
-    function tjvminlinenode.handle_box: tnode;
+    function tjvminlinenode.first_box: tnode;
+      var
+        boxdef,
+        boxparadef: tdef;
       begin
-        Result:=inherited;
+        { get class wrapper type }
-        resultdef:=java_jlobject;
+        jvmgetboxtype(left.resultdef,boxdef,boxparadef);
+        { created wrapped instance }
+        inserttypeconv_explicit(tcallparanode(left).left,boxparadef);
+        result:=ccallnode.createinternmethod(
+          cloadvmtaddrnode.create(ctypenode.create(tobjectdef(boxdef))),'CREATE',left);
+        { reused }
+        left:=nil;
       end;
 
 
-    function tjvminlinenode.first_box: tnode;
+    function tjvminlinenode.first_unbox: tnode;
+      var
+        val: tnode;
+        boxdef,
+        boxparadef: tdef;
       begin
-        result:=nil;
+        jvmgetboxtype(resultdef,boxdef,boxparadef);
-        expectloc:=LOC_REGISTER;
+        val:=tcallparanode(tcallparanode(left).right).left;
-{$ifdef nounsupported}
+        tcallparanode(tcallparanode(left).right).left:=nil;
-        internalerror(2011042603);
+        { typecast to the boxing type }
-{$endif}
+        val:=ctypeconvnode.create_explicit(val,boxdef);
+        { call the unboxing method }
+        val:=ccallnode.createinternmethod(val,jvmgetunboxmethod(resultdef),nil);
+        { add type conversion for shortint -> byte etc }
+        inserttypeconv_explicit(val,resultdef);
+        result:=val;
       end;
 
 
@@ -796,18 +813,6 @@ implementation
         thlcgjvm(hlcg).a_load_reg_loc(current_asmdata.CurrAsmList,target.resultdef,target.resultdef,tmpreg,target.location);
       end;
 
-    procedure tjvminlinenode.second_box;
-      begin
-{$ifndef nounsupported}
-        secondpass(tcallparanode(left).left);
-        location_reset(location,LOC_REGISTER,OS_ADDR);
-        location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
-        hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
-{$else}
-        internalerror(2011042606);
-{$endif}
-      end;
-
 
 begin
    cinlinenode:=tjvminlinenode;

compiler/jvm/njvmld.pas

@@ -55,15 +55,19 @@ implementation
 uses
   verbose,
   aasmdata,
-  nbas,nld,ncal,nmem,ncnv,
+  nbas,nld,ncal,ninl,nmem,ncnv,
   symconst,symsym,symdef,symtable,defutil,jvmdef,
   paramgr,
+  pass_1,
   cgbase,hlcgobj;
 
 { tjvmassignmentnode }
 
 function tjvmassignmentnode.pass_1: tnode;
   var
+    block: tblocknode;
+    tempn: ttempcreatenode;
+    stat: tstatementnode;
     target: tnode;
     psym: tsym;
   begin
@@ -115,6 +119,30 @@ function tjvmassignmentnode.pass_1: tnode;
         tvecnode(target).right:=nil;
         exit;
       end
+    else if target.resultdef.typ=formaldef then
+      begin
+        if right.resultdef.typ in [orddef,floatdef] then
+          right:=cinlinenode.create(in_box_x,false,right)
+        else if jvmimplicitpointertype(right.resultdef) then
+          begin
+            { we have to assign the address of a deep copy of the type to the
+              object in the formalpara -> create a temp, assign the value to
+              the temp, then assign the address in the temp to the para }
+            block:=internalstatements(stat);
+            tempn:=ctempcreatenode.create_value(right.resultdef,right.resultdef.size,
+              tt_persistent,false,right);
+            addstatement(stat,tempn);
+            right:=caddrnode.create(ctemprefnode.create(tempn));
+            inserttypeconv_explicit(right,java_jlobject);
+            addstatement(stat,ctempdeletenode.create_normal_temp(tempn));
+            addstatement(stat,ctypeconvnode.create_explicit(
+              caddrnode.create(ctemprefnode.create(tempn)),java_jlobject));
+            right:=block;
+          end;
+        typecheckpass(right);
+        result:=inherited;
+        exit;
+      end
     else
       result:=inherited;
   end;
@@ -134,7 +162,8 @@ function tjvmloadnode.is_addr_param_load: boolean;
   begin
     result:=
       (inherited and
-       not jvmimplicitpointertype(tparavarsym(symtableentry).vardef)) or
+       not jvmimplicitpointertype(tparavarsym(symtableentry).vardef) and
+       (tparavarsym(symtableentry).vardef.typ<>formaldef)) or
       is_copyout_addr_param_load;
   end;
 

compiler/jvmdef.pas

@@ -74,6 +74,11 @@ interface
     function jvmmangledbasename(sym: tsym; withsignature: boolean): TSymStr;
     function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
 
+    { sometimes primitive types have to be boxed/unboxed via class types. This
+      routine returns the appropriate box type for the passed primitive type }
+    procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef);
+    function jvmgetunboxmethod(def: tdef): string;
+
 implementation
 
   uses
@@ -503,6 +508,124 @@ implementation
       end;
 
 
+    procedure jvmgetboxtype(def: tdef; out objdef, paradef: tdef);
+      begin
+        case def.typ of
+          orddef:
+            begin
+              case torddef(def).ordtype of
+                pasbool8:
+                  begin
+                    objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
+                    paradef:=pasbool8type;
+                  end;
+                { wrap all integer types into a JLLONG, so that we don't get
+                  errors after returning a byte assigned to a long etc }
+                s8bit,
+                u8bit,
+                uchar,
+                bool8bit,
+                s16bit,
+                u16bit,
+                bool16bit,
+                pasbool16,
+                s32bit,
+                u32bit,
+                bool32bit,
+                pasbool32,
+                s64bit,
+                u64bit,
+                scurrency,
+                bool64bit,
+                pasbool64:
+                  begin
+                    objdef:=tobjectdef(search_system_type('JLLONG').typedef);
+                    paradef:=s64inttype;
+                  end;
+                uwidechar:
+                  begin
+                    objdef:=tobjectdef(search_system_type('JLCHARACTER').typedef);
+                    paradef:=cwidechartype;
+                  end;
+                else
+                  internalerror(2011052101);
+              end;
+            end;
+          floatdef:
+            begin
+              case tfloatdef(def).floattype of
+                s32real:
+                  begin
+                    objdef:=tobjectdef(search_system_type('JLFLOAT').typedef);
+                    paradef:=s32floattype;
+                  end;
+                s64real:
+                  begin
+                    objdef:=tobjectdef(search_system_type('JLDOUBLE').typedef);
+                    paradef:=s64floattype;
+                  end;
+                else
+                  internalerror(2011052102);
+              end;
+            end;
+          else
+            internalerror(2011052103);
+        end;
+      end;
+
+
+    function jvmgetunboxmethod(def: tdef): string;
+      begin
+        case def.typ of
+          orddef:
+            begin
+              case torddef(def).ordtype of
+                pasbool8:
+                  result:='BOOLEANVALUE';
+                s8bit,
+                u8bit,
+                uchar,
+                bool8bit:
+                  result:='BYTEVALUE';
+                s16bit,
+                u16bit,
+                bool16bit,
+                pasbool16:
+                  result:='SHORTVALUE';
+                s32bit,
+                u32bit,
+                bool32bit,
+                pasbool32:
+                  result:='INTVALUE';
+                s64bit,
+                u64bit,
+                scurrency,
+                bool64bit,
+                pasbool64:
+                  result:='LONGVALUE';
+                uwidechar:
+                  result:='CHARVALUE';
+                else
+                  internalerror(2011071702);
+              end;
+            end;
+          floatdef:
+            begin
+              case tfloatdef(def).floattype of
+                s32real:
+                  result:='FLOATVALUE';
+                s64real:
+                  result:='DOUBLEVALUE';
+                else
+                  internalerror(2011071703);
+              end;
+            end;
+          else
+            internalerror(2011071704);
+        end;
+      end;
+
+
     function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
       var
         container: tsymtable;

compiler/ncal.pas

@@ -178,6 +178,13 @@ interface
        private
           fcontains_stack_tainting_call_cached,
           ffollowed_by_stack_tainting_call_cached : boolean;
+       protected
+          { in case of copy-out parameters: initialization code, and the code to
+            copy back the parameter value after the call (including any required
+            finalization code }
+          fparainit,
+          fparacopyback: tnode;
+          procedure handleformalcopyoutpara(orgparadef: tdef);virtual;abstract;
        public
           callparaflags : tcallparaflags;
           parasym       : tparavarsym;
@@ -187,6 +194,8 @@ interface
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderefimpl; override;
+          procedure derefimpl; override;
           function dogetcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck : tnode;override;
@@ -221,6 +230,7 @@ interface
             parameter whose evaluation involves a stack tainting parameter
             (result is only valid after order_parameters has been called) }
           property followed_by_stack_tainting_call_cached: boolean read ffollowed_by_stack_tainting_call_cached;
+          property paracopyback: tnode read fparacopyback;
        end;
        tcallparanodeclass = class of tcallparanode;
 
@@ -573,6 +583,8 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         ppufile.getsmallset(callparaflags);
+        fparainit:=ppuloadnode(ppufile);
+        fparacopyback:=ppuloadnode(ppufile);
       end;
 
 
@@ -580,6 +592,28 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(callparaflags);
+        ppuwritenode(ppufile,fparainit);
+        ppuwritenode(ppufile,fparacopyback);
+      end;
+
+
+    procedure tcallparanode.buildderefimpl;
+      begin
+        inherited buildderefimpl;
+        if assigned(fparainit) then
+          fparainit.buildderefimpl;
+        if assigned(fparacopyback) then
+          fparacopyback.buildderefimpl;
+      end;
+
+
+    procedure tcallparanode.derefimpl;
+      begin
+        inherited derefimpl;
+        if assigned(fparainit) then
+          fparainit.derefimpl;
+        if assigned(fparacopyback) then
+          fparacopyback.derefimpl;
       end;
 
 
@@ -587,11 +621,19 @@ implementation
 
       var
          n : tcallparanode;
-
+         initcopy: tnode;
       begin
+         initcopy:=nil;
+         { must be done before calling inherited getcopy, because can create
+           tempcreatenodes for values used in left }
+         if assigned(fparainit) then
+           initcopy:=fparainit.getcopy;
          n:=tcallparanode(inherited dogetcopy);
          n.callparaflags:=callparaflags;
          n.parasym:=parasym;
+         n.fparainit:=initcopy;
+         if assigned(fparacopyback) then
+           n.fparacopyback:=fparacopyback.getcopy;
          result:=n;
       end;
 
@@ -625,9 +667,13 @@ implementation
           tcallparanode(right).get_paratype;
          old_array_constructor:=allow_array_constructor;
          allow_array_constructor:=true;
+         if assigned(fparainit) then
+          typecheckpass(fparainit);
          typecheckpass(left);
          if assigned(third) then
            typecheckpass(third);
+         if assigned(fparacopyback) then
+           typecheckpass(fparacopyback);
          allow_array_constructor:=old_array_constructor;
          if codegenerror then
           resultdef:=generrordef
@@ -642,7 +688,11 @@ implementation
           tcallparanode(right).firstcallparan;
         if not assigned(left.resultdef) then
           get_paratype;
+        if assigned(fparainit) then
+          firstpass(fparainit);
         firstpass(left);
+        if assigned(fparacopyback) then
+          firstpass(fparacopyback);
         if assigned(third) then
           firstpass(third);
         expectloc:=left.expectloc;
@@ -871,21 +921,22 @@ implementation
                          begin
                            if not valid_for_formal_var(left,true) then
                             CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list)
-                           else if (target_info.system in systems_managed_vm) and
+                           else if (target_info.system in systems_managed_vm) then
-                              (left.resultdef.typ in [orddef,floatdef]) then
                              begin
-                               left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil));
+                               olddef:=left.resultdef;
-                               typecheckpass(left);
+                               handleformalcopyoutpara(left.resultdef);
-{$ifdef nounsupported}
-                               { TODO: unbox afterwards }
-                               internalerror(2011042608);
-{$endif}
                              end;
                          end;
                        vs_const :
                          begin
                            if not valid_for_formal_const(left,true) then
-                            CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
+                            CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list)
+                           else if (target_info.system in systems_managed_vm) and
+                              (left.resultdef.typ in [orddef,floatdef]) then
+                             begin
+                               left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil));
+                               typecheckpass(left);
+                             end;
                          end;
                      end;
                    end
@@ -1006,6 +1057,8 @@ implementation
       begin
         docompare :=
           inherited docompare(p) and
+          fparainit.isequal(tcallparanode(p).fparainit) and
+          fparacopyback.isequal(tcallparanode(p).fparacopyback) and
           (callparaflags = tcallparanode(p).callparaflags)
           ;
       end;

compiler/ncgcal.pas

@@ -52,6 +52,7 @@ interface
 
           procedure handle_return_value;
           procedure release_unused_return_value;
+          procedure copy_back_paras;
           procedure release_para_temps;
           procedure pushparas;
           procedure freeparas;
@@ -181,6 +182,8 @@ implementation
              oflabel:=current_procinfo.CurrFalseLabel;
              current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
              current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
+             if assigned(fparainit) then
+               secondpass(fparainit);
              secondpass(left);
 
              maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true);
@@ -471,6 +474,22 @@ implementation
       end;
 
 
+    procedure tcgcallnode.copy_back_paras;
+      var
+        hp,
+        hp2 : tnode;
+        ppn : tcallparanode;
+      begin
+        ppn:=tcallparanode(left);
+        while assigned(ppn) do
+          begin
+             if assigned(ppn.paracopyback) then
+               secondpass(ppn.paracopyback);
+             ppn:=tcallparanode(ppn.right);
+          end;
+      end;
+
+
     procedure tcgcallnode.release_para_temps;
       var
         hp,
@@ -966,6 +985,9 @@ implementation
          if assigned(callcleanupblock) then
            secondpass(tnode(callcleanupblock));
 
+         { copy back copy-out parameters if any }
+         copy_back_paras;
+
          { release temps and finalize unused return values, must be
            after the callcleanupblock because that converts temps
            from persistent to normal }

compiler/ncgld.pas

@@ -809,6 +809,9 @@ implementation
 { TODO: HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
                             { Use unaligned copy when the offset is not aligned }
                             len:=left.resultdef.size;
+                            { can be 0 in case of formaldef on JVM target }
+                            if len=0 then
+                              len:=sizeof(pint);
 
                             { data smaller than an aint has less alignment requirements }
                             alignmentrequirement:=min(len,sizeof(aint));

compiler/ninl.pas

@@ -74,8 +74,8 @@ interface
           function first_new: tnode; virtual;
           function first_length: tnode; virtual;
           function first_box: tnode; virtual; abstract;
+          function first_unbox: tnode; virtual; abstract;
 
-          function handle_box: tnode; virtual;
         private
           function handle_str: tnode;
           function handle_reset_rewrite_typed: tnode;
@@ -85,6 +85,8 @@ interface
           function handle_val: tnode;
           function handle_setlength: tnode;
           function handle_copy: tnode;
+          function handle_box: tnode;
+          function handle_unbox: tnode;
        end;
        tinlinenodeclass = class of tinlinenode;
 
@@ -2903,6 +2905,10 @@ implementation
                 begin
                   result:=handle_box;
                 end;
+              in_unbox_x_y:
+                begin
+                  result:=handle_unbox;
+                end;
               else
                 internalerror(8);
             end;
@@ -3303,6 +3309,8 @@ implementation
            result:=first_new;
          in_box_x:
            result:=first_box;
+         in_unbox_x_y:
+           result:=first_unbox;
          else
            internalerror(89);
           end;
@@ -3597,9 +3605,27 @@ implementation
      function tinlinenode.handle_box: tnode;
        begin
          result:=nil;
+         if not assigned(left) or
+            assigned(tcallparanode(left).right) then
+           CGMessage1(parser_e_wrong_parameter_size,'FpcInternalBox');
          resultdef:=class_tobject;
        end;
 
+
+     function tinlinenode.handle_unbox: tnode;
+       begin
+         result:=nil;
+         if not assigned(left) or
+            not assigned(tcallparanode(left).right) or
+            assigned(tcallparanode(tcallparanode(left).right).right) then
+           CGMessage1(parser_e_wrong_parameter_size,'FpcInternalUnBox');
+         if tcallparanode(left).left.nodetype<>typen then
+           internalerror(2011071701);
+         ttypenode(tcallparanode(left).left).allowed:=true;
+         resultdef:=tcallparanode(left).left.resultdef;
+       end;
+
+
      function tinlinenode.first_pack_unpack: tnode;
        var
          loopstatement    : tstatementnode;

compiler/symdef.pas

@@ -4661,7 +4661,8 @@ implementation
                   does achieve regular call-by-reference semantics though;
                   formaldefs always have to be passed like that because their
                   contents can be replaced }
-                if (vs.vardef.typ=formaldef) or
+                if ((vs.vardef.typ=formaldef) and
+                    (vs.varspez<>vs_const)) or
                    ((vs.varspez in [vs_var,vs_out,vs_constref]) and
                     not jvmimplicitpointertype(vs.vardef)) then
                   tmpresult:=tmpresult+'[';

rtl/inc/innr.inc

@@ -84,6 +84,8 @@ const
    fpc_in_sar_x             = 73;
    fpc_in_bsf_x             = 74;
    fpc_in_bsr_x             = 75;
+   in_box_x                 = 76; { managed platforms: wrap in class instance }
+   in_unbox_x_y             = 77; { manage platforms: extract from class instance }
 
 { Internal constant functions }
    fpc_in_const_sqr        = 100;