+ support for non-array/record var parameter on the JVM target using

    copy-in/out

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

compiler/jvm/cpupara.pas

@@ -37,6 +37,7 @@ interface
       TJVMParaManager=class(TParaManager)
         function  push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
         function  push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+        function  push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
         function  push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;override;
         {Returns a structure giving the information on the storage of the parameter
         (which must be an integer parameter)
@@ -58,7 +59,8 @@ implementation
     uses
       cutils,verbose,systems,
       defutil,jvmdef,
-      cgobj;
+      aasmcpu,
+      hlcgobj;
 
 
     procedure TJVMParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara);
@@ -85,6 +87,16 @@ implementation
       end;
 
 
+    function TJVMParaManager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+      begin
+        { 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
+          not jvmimplicitpointertype(def);
+      end;
+
+
     function TJVMParaManager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
       begin
         { all aggregate types are emulated using indirect pointer types }
@@ -169,17 +181,29 @@ implementation
         hp           : tparavarsym;
         paracgsize   : tcgsize;
         paraofs      : longint;
+        paradef      : tdef;
       begin
         paraofs:=0;
         for i:=0 to paras.count-1 do
           begin
             hp:=tparavarsym(paras[i]);
-            paracgsize:=def_cgsize(hp.vardef);
-            if paracgsize=OS_NO then
-              paracgsize:=OS_ADDR;
+            if push_copyout_param(hp.varspez,hp.vardef,p.proccalloption) then
+              begin
+                { passed via array reference (instead of creating a new array
+                  type for every single parameter, use java_jlobject) }
+                paracgsize:=OS_ADDR;
+                paradef:=java_jlobject;
+              end
+            else
+              begin
+                paracgsize:=def_cgsize(hp.vardef);
+                if paracgsize=OS_NO then
+                  paracgsize:=OS_ADDR;
+                paradef:=hp.vardef;
+              end;
             hp.paraloc[side].reset;
             hp.paraloc[side].size:=paracgsize;
-            hp.paraloc[side].def:=hp.vardef;
+            hp.paraloc[side].def:=paradef;
             hp.paraloc[side].alignment:=std_param_align;
             hp.paraloc[side].intsize:=tcgsize2size[paracgsize];
             paraloc:=hp.paraloc[side].add_location;
@@ -205,9 +229,9 @@ implementation
                 end;
             end;
             { 2 slots for 64 bit integers and floats, 1 slot for the rest }
-            if not(is_64bit(hp.vardef) or
-                   ((hp.vardef.typ=floatdef) and
-                    (tfloatdef(hp.vardef).floattype=s64real))) then
+            if not(is_64bit(paradef) or
+                   ((paradef.typ=floatdef) and
+                    (tfloatdef(paradef).floattype=s64real))) then
               inc(paraofs)
             else
               inc(paraofs,2);

compiler/jvm/njvmcal.pas

@@ -26,11 +26,18 @@ unit njvmcal;
 interface
 
     uses
+      cgbase,
       symdef,
       ncgcal;
 
     type
 
+       tjvmcallparanode = class(tcgcallparanode)
+        protected
+         outcopybasereg: tregister;
+         procedure push_copyout_para; override;
+       end;
+
        { tjvmcallnode }
 
        tjvmcallnode = class(tcgcallnode)
@@ -47,12 +54,54 @@ implementation
     uses
       verbose,globtype,
       symconst,symtype,defutil,ncal,
-      cgbase,cgutils,tgobj,procinfo,
+      cgutils,tgobj,procinfo,
       cpubase,aasmdata,aasmcpu,
       hlcgobj,hlcgcpu,
       node,
       jvmdef;
 
+{*****************************************************************************
+                           TJVMCALLPARANODE
+*****************************************************************************}
+
+    procedure tjvmcallparanode.push_copyout_para;
+      var
+        mangledname: string;
+        primitivetype: boolean;
+        opc: tasmop;
+        arrayloc: tlocation;
+        arrayref: treference;
+      begin
+        { create an array with one element of the parameter type }
+        thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
+        mangledname:=jvmarrtype(left.resultdef,primitivetype);
+        if primitivetype then
+          opc:=a_newarray
+        else
+          opc:=a_anewarray;
+        { doesn't change stack height: one int replaced by one reference }
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
+        { cannot be a regular array or record, because those are passed by
+          plain reference (since they are reference types at the Java level,
+          but not at the Pascal level) -> no special initialisation necessary }
+        outcopybasereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+        thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,outcopybasereg);
+        reference_reset_base(arrayref,outcopybasereg,0,4);
+        arrayref.arrayreftype:=art_indexconst;
+        arrayref.indexoffset:=0;
+        { load the current parameter value into the array in case it's not an
+          out-parameter; if it's an out-parameter the contents must be nil
+          but that's already ok, since the anewarray opcode takes care of that }
+        if (parasym.varspez<>vs_out) then
+          hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
+
+        { store the array reference into the parameter location (don't change
+          left.location, we may need it for copy-back after the call) }
+        location_reset(arrayloc,LOC_REGISTER,OS_ADDR);
+        arrayloc.register:=outcopybasereg;
+        hlcg.gen_load_loc_cgpara(current_asmdata.CurrAsmList,java_jlobject,arrayloc,tempcgpara)
+      end;
+
 
 {*****************************************************************************
                              TJVMCALLNODE
@@ -118,6 +167,8 @@ implementation
       var
         totalremovesize: longint;
         realresdef: tdef;
+        ppn: tjvmcallparanode;
+        pararef: treference;
       begin
         if not assigned(typedef) then
           realresdef:=tstoreddef(resultdef)
@@ -141,9 +192,37 @@ implementation
         if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) and
            (cnf_inherited in callnodeflags) then
           thlcgjvm(hlcg).gen_initialize_fields_code(current_asmdata.CurrAsmList);
+
+        { copy back the copyout parameter values, if any }
+        { Release temps from parameters }
+        ppn:=tjvmcallparanode(left);
+        while assigned(ppn) do
+          begin
+            if assigned(ppn.left) then
+              begin
+                if (ppn.outcopybasereg<>NR_NO) then
+                  begin
+                    reference_reset_base(pararef,NR_NO,0,4);
+                    pararef.arrayreftype:=art_indexconst;
+                    pararef.base:=ppn.outcopybasereg;
+                    pararef.indexoffset:=0;
+                    { the value has to be copied back into persistent storage }
+                    case ppn.left.location.loc of
+                      LOC_REFERENCE:
+                        hlcg.a_load_ref_ref(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.reference);
+                      LOC_CREGISTER:
+                        hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.register);
+                    else
+                      internalerror(2011051201);
+                    end;
+                  end;
+              end;
+            ppn:=tjvmcallparanode(ppn.right);
+          end;
       end;
 
 
 begin
   ccallnode:=tjvmcallnode;
+  ccallparanode:=tjvmcallparanode;
 end.

compiler/jvm/njvmld.pas

@@ -34,6 +34,7 @@ uses
 type
   tjvmloadnode = class(tcgloadnode)
     function is_addr_param_load: boolean; override;
+    procedure pass_generate_code; override;
   end;
 
   tjvmassignmentnode  = class(tcgassignmentnode)
@@ -52,7 +53,8 @@ uses
   verbose,
   aasmdata,
   nbas,nld,ncal,nmem,ncnv,
-  symsym,symdef,defutil,jvmdef,
+  symconst,symsym,symdef,defutil,jvmdef,
+  paramgr,
   cgbase,hlcgobj;
 
 { tjvmassignmentnode }
@@ -99,6 +101,25 @@ function tjvmloadnode.is_addr_param_load: boolean;
   end;
 
 
+procedure tjvmloadnode.pass_generate_code;
+  begin
+    if (symtable.symtabletype=parasymtable) and
+       (symtableentry.typ=paravarsym) and
+       paramanager.push_copyout_param(tparavarsym(symtableentry).varspez,resultdef,tprocdef(symtable.defowner).proccalloption) then
+      begin
+        { the parameter is passed as an array of one element containing the
+          parameter value }
+        location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),4);
+        location.reference.arrayreftype:=art_indexconst;
+        location.reference.base:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+        hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,tparavarsym(symtableentry).localloc,location.reference.base);
+        location.reference.indexoffset:=0;
+      end
+    else
+      inherited pass_generate_code;
+  end;
+
+
 { tjvmarrayconstructornode }
 
 procedure tjvmarrayconstructornode.makearrayref(var ref: treference; eledef: tdef);

compiler/ncgcal.pas

@@ -33,10 +33,12 @@ interface
 
     type
        tcgcallparanode = class(tcallparanode)
-       private
+       protected
           tempcgpara : tcgpara;
           procedure push_addr_para;
           procedure push_value_para;
+          procedure push_formal_para;virtual;
+          procedure push_copyout_para;virtual;abstract;
        public
           constructor create(expr,next : tnode);override;
           destructor destroy;override;
@@ -149,6 +151,16 @@ implementation
       end;
 
 
+    procedure tcgcallparanode.push_formal_para;
+      begin
+        { allow passing of a constant to a const formaldef }
+        if (parasym.varspez=vs_const) and
+           (left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
+          hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
+        push_addr_para;
+      end;
+
+
     procedure tcgcallparanode.secondcallparan;
       var
          href    : treference;
@@ -216,16 +228,12 @@ implementation
                    push_value_para;
                end
              { formal def }
-             else if (parasym.vardef.typ=formaldef) and
-                     not(target_info.system in systems_managed_vm) then
-               begin
-                  { allow passing of a constant to a const formaldef }
-                  if (parasym.varspez=vs_const) and
-                     (left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
-                    hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
-                  push_addr_para;
-               end
+             else if (parasym.vardef.typ=formaldef) then
+               push_formal_para
              { Normal parameter }
+             else if paramanager.push_copyout_param(parasym.varspez,parasym.vardef,
+                         aktcallnode.procdefinition.proccalloption) then
+               push_copyout_para
              else
                begin
                  { don't push a node that already generated a pointer type

compiler/ncgld.pas

@@ -436,10 +436,10 @@ implementation
                       hregister:=location.register
                     else
                       begin
-                        hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                        hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidpointertype);
                         { we need to load only an address }
                         location.size:=OS_ADDR;
-                        cg.a_load_loc_reg(current_asmdata.CurrAsmList,location.size,location,hregister);
+                        hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,voidpointertype,voidpointertype,location,hregister);
                       end;
                     { assume packed records may always be unaligned }
                     if not(resultdef.typ in [recorddef,objectdef]) or

compiler/paramgr.pas

@@ -55,6 +55,10 @@ unit paramgr;
             the address is pushed
           }
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;abstract;
+          { returns true if a parameter must be handled via copy-out (construct
+            a reference, copy the parameter's value there in case of copy-in/out, pass the reference)
+          }
+          function push_copyout_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
           { return the size of a push }
           function push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;virtual;
           {# Returns a structure giving the information on
@@ -180,6 +184,12 @@ implementation
       end;
 
 
+    function tparamanager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+      begin
+        push_copyout_param:=false;
+      end;
+
+
     { return the size of a push }
     function tparamanager.push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;
       begin