* greatly simplified dynamic array handling by making use of the

    java.lang.reflect functionality

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

compiler/jvm/hlcgcpu.pas

@@ -1056,6 +1056,7 @@ implementation
       procname: string;
       eledef: tdef;
       ndim: longint;
+      adddefaultlenparas: boolean;
     begin
       { load copy helper parameters on the stack }
       a_load_ref_stack(list,java_jlobject,source,prepare_stack_for_ref(list,source,false));
@@ -1063,31 +1064,21 @@ implementation
       { call copy helper }
       eledef:=tarraydef(size).elementdef;
       ndim:=1;
+      adddefaultlenparas:=true;
       case eledef.typ of
         orddef:
           begin
             case torddef(eledef).ordtype of
-              pasbool8,s8bit,u8bit,bool8bit,uchar:
-                procname:='FPC_COPY_JBYTE_ARRAY';
-              s16bit,u16bit,bool16bit,pasbool16:
-                procname:='FPC_COPY_JSHORT_ARRAY';
-              uwidechar:
-                procname:='FPC_COPY_JCHAR_ARRAY';
-              s32bit,u32bit,bool32bit,pasbool32:
-                procname:='FPC_COPY_JINT_ARRAY';
+              pasbool8,s8bit,u8bit,bool8bit,uchar,
+              s16bit,u16bit,bool16bit,pasbool16,
+              uwidechar,
+              s32bit,u32bit,bool32bit,pasbool32,
               s64bit,u64bit,bool64bit,pasbool64,scurrency:
-                procname:='FPC_COPY_JLONG_ARRAY';
+                procname:='FPC_COPY_SHALLOW_ARRAY'
               else
                 internalerror(2011020504);
             end;
           end;
-        floatdef:
-          case tfloatdef(eledef).floattype of
-            s32real:
-              procname:='FPC_COPY_JFLOAT_ARRAY';
-            s64real:
-              procname:='FPC_COPY_JDOUBLE_ARRAY';
-          end;
         arraydef:
           begin
             { call fpc_setlength_dynarr_multidim with deepcopy=true, and extra
@@ -1099,7 +1090,7 @@ implementation
                 inc(ndim)
               end;
             if (ndim=1) then
-              procname:='FPC_COPY_JOBJECT_ARRAY'
+              procname:='FPC_COPY_SHALLOW_ARRAY'
             else
               begin
                 { deepcopy=true }
@@ -1108,13 +1099,15 @@ implementation
                 a_load_const_stack(list,s32inttype,ndim,R_INTREGISTER);
                 { eletype }
                 a_load_const_stack(list,cwidechartype,ord(jvmarrtype_setlength(eledef)),R_INTREGISTER);
+                adddefaultlenparas:=false;
                 procname:='FPC_SETLENGTH_DYNARR_MULTIDIM';
               end;
           end;
         recorddef:
           procname:='FPC_COPY_JRECORD_ARRAY';
+        floatdef,
         stringdef:
-          procname:='FPC_COPY_JOBJECT_ARRAY';
+          procname:='FPC_COPY_SHALLOW_ARRAY';
         setdef,
         variantdef:
           begin
@@ -1122,11 +1115,21 @@ implementation
             internalerror(2011020505);
           end;
         else
-          procname:='FPC_COPY_JOBJECT_ARRAY';
+          procname:='FPC_COPY_SHALLOW_ARRAY';
       end;
+     if adddefaultlenparas then
+       begin
+         { -1, -1 means "copy entire array" }
+         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
-       decstack(list,2)
+       begin
+         decstack(list,2);
+         if adddefaultlenparas then
+           decstack(list,2);
+       end
      else
        begin
          decstack(list,4);

compiler/jvm/njvminl.pas

@@ -286,45 +286,33 @@ implementation
           assignmenttarget:=tcallparanode(left).left.getcopy;
         newparas:=left;
         left:=nil;
-        { if more than 1 dimension, or if 1 dimention of a non-primitive type,
-          typecast to generic array of tobject }
-        setlenroutine:=jvmarrtype(eledef,primitive);
         finaltype:=jvmarrtype_setlength(eledef);
-
         { since the setlength prototypes require certain types, insert
           explicit type conversions where necessary }
         objarraydef:=nil;
-        { all arrays, records and object types need to be handled as JLObject }
-        if (ndims>1) or
-           not primitive then
-          objarraydef:=search_system_type('TJOBJECTARRAY').typedef
-        { insert type conversion, because this is used both for signed and
-          unsigned types }
-        else case finaltype of
-          'Z': { boolean is always the same };
-          'C': { char is always the same };
-          'B':
-            { jbyte: used for both shortint and byte }
-            objarraydef:=search_system_type('TJBYTEARRAY').typedef;
-          'S':
-            { jshort: used for both smallint and word }
-            objarraydef:=search_system_type('TJSHORTARRAY').typedef;
-          'I':
-            { jshort: used for both smallint and word }
-            objarraydef:=search_system_type('TJINTARRAY').typedef;
-          'J':
-            { jshort: used for both smallint and word }
-            objarraydef:=search_system_type('TJLONGARRAY').typedef;
-          'F': { float is always the same };
-          'D': { double is always the same };
-          else
-            internalerror(2011040705);
-          end;
-        if assigned(objarraydef) then
+        if (ndims>1) then
+          begin
+            { expects array of JLObject }
+            setlenroutine:='FPC_SETLENGTH_DYNARR_MULTIDIM';
+            objarraydef:=search_system_type('TJOBJECTARRAY').typedef
+          end
+        else
           begin
-            tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
-            newnode:=ctypeconvnode.create_explicit(newnode,objarraydef);
+            if finaltype<>'R' then
+              begin
+                { expects JLObject }
+                setlenroutine:='FPC_SETLENGTH_DYNARR_GENERIC';
+                objarraydef:=java_jlobject;
+              end
+            else
+              begin
+                { expects array of FpcBaseRecord}
+                setlenroutine:='FPC_SETLENGTH_DYNARR_JRECORD';
+                objarraydef:=search_system_type('TJRECORDARRAY').typedef;
+              end;
           end;
+        tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
+        newnode:=ctypeconvnode.create_explicit(newnode,objarraydef);
         { prepend new }
         newparas:=ccallparanode.create(newnode,newparas);
         { prepend deepcopy }
@@ -332,7 +320,6 @@ implementation
         { call the right setlenght helper }
         if ndims>1 then
           begin
-            setlenroutine:='FPC_SETLENGTH_DYNARR_MULTIDIM';
             { create proper parameters, from right to left:
                eletype=finaltype, ndim=ndims, deepcopy=false, new=newnode,
                assignmenttarget=tcallparanode(left).left }
@@ -343,11 +330,6 @@ implementation
           end
         else
           begin
-            if not primitive then
-              setlenroutine:='OBJECT'
-            else
-              uppervar(setlenroutine);
-            setlenroutine:='FPC_SETLENGTH_DYNARR_J'+setlenroutine;
             { create proper parameters, from right to left:
                deepcopy=false, new=newnode, assignmenttarget=tcallparnode(left).left
               -> already done in common part above }

rtl/java/jdynarrh.inc

@@ -44,27 +44,13 @@ const
     size specified to setlength. The function either returns org if it had the
     right size already, or copies (part of) org in new and returns new.
 }
-function fpc_setlength_dynarr_jbyte(aorg, anew: TJByteArray; deepcopy: boolean): TJByteArray;
-function fpc_setlength_dynarr_jshort(aorg, anew: TJShortArray; deepcopy: boolean): TJShortArray;
-function fpc_setlength_dynarr_jint(aorg, anew: TJIntArray; deepcopy: boolean): TJIntArray;
-function fpc_setlength_dynarr_jlong(aorg, anew: TJLongArray; deepcopy: boolean): TJLongArray;
-function fpc_setlength_dynarr_jchar(aorg, anew: TJCharArray; deepcopy: boolean): TJCharArray;
-function fpc_setlength_dynarr_jfloat(aorg, anew: TJFloatArray; deepcopy: boolean): TJFloatArray;
-function fpc_setlength_dynarr_jdouble(aorg, anew: TJDoubleArray; deepcopy: boolean): TJDoubleArray;
-function fpc_setlength_dynarr_jobject(aorg, anew: TJObjectArray; deepcopy: boolean; docopy : boolean = true): TJObjectArray;
+function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
 function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
 
 { array copying helpers }
 
-procedure fpc_copy_jbyte_array(src, dst: TJByteArray);
-procedure fpc_copy_jshort_array(src, dst: TJShortArray);
-procedure fpc_copy_jint_array(src, dst: TJIntArray);
-procedure fpc_copy_jlong_array(src, dst: TJLongArray);
-procedure fpc_copy_jchar_array(src, dst: TJCharArray);
-procedure fpc_copy_jfloat_array(src, dst: TJFloatArray);
-procedure fpc_copy_jdouble_array(src, dst: TJDoubleArray);
-procedure fpc_copy_jobject_array(src, dst: TJObjectArray);
-procedure fpc_copy_jrecord_array(src, dst: TJRecordArray);
+procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
+procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
 
 { multi-dimendional setlength routine: all intermediate dimensions are arrays
   of arrays, so that's the same for all array kinds. Only the type of the final

rtl/java/system.pp

@@ -280,229 +280,79 @@ function min(a,b : longint) : longint;
 
 { copying helpers }
 
-{ also for booleans }
-procedure fpc_copy_jbyte_array(src, dst: TJByteArray);
+procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
   var
     srclen, dstlen: jint;
   begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
-      exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jshort_array(src, dst: TJShortArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
-      exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jint_array(src, dst: TJIntArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
-      exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jlong_array(src, dst: TJLongArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
-      exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jchar_array(src, dst: TJCharArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
-      exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jfloat_array(src, dst: TJFloatArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
+    if assigned(src) then
+      srclen:=JLRArray.getLength(src)
+    else
+      srclen:=0;
+    if assigned(dst) then
+      dstlen:=JLRArray.getLength(dst)
+    else
+      dstlen:=0;
+    if srcstart=-1 then
+      srcstart:=0
+    else if srcstart>=srclen then
       exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jdouble_array(src, dst: TJDoubleArray);
-  var
-    srclen, dstlen: jint;
-  begin
-    srclen:=length(src);
-    dstlen:=length(dst);
+    if srccopylen=-1 then
+      srccopylen:=srclen
+    else if srcstart+srccopylen>srclen then
+      srccopylen:=srclen-srcstart;
     { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
+    if (srccopylen=0) or
        (dstlen=0) then
       exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
+    JLSystem.arraycopy(src,srcstart,dst,0,min(srccopylen,dstlen));
   end;
 
 
-procedure fpc_copy_jobject_array(src, dst: TJObjectArray);
+procedure fpc_copy_jrecord_array(src, dst: TJRecordArray; srcstart: jint = -1; srccopylen: jint = -1);
   var
+    i: longint;
     srclen, dstlen: jint;
   begin
     srclen:=length(src);
     dstlen:=length(dst);
-    { causes exception in JLSystem.arraycopy }
-    if (srclen=0) or
-       (dstlen=0) then
+    if srcstart=-1 then
+      srcstart:=0
+    else if srcstart>=srclen then
       exit;
-    JLSystem.arraycopy(JLObject(src),0,JLObject(dst),0,min(srclen,dstlen));
-  end;
-
-
-procedure fpc_copy_jrecord_array(src, dst: TJRecordArray);
-  var
-    i: longint;
-  begin
+    if srccopylen=-1 then
+      srccopylen:=srclen
+    else if srcstart+srccopylen>srclen then
+      srccopylen:=srclen-srcstart;
     { no arraycopy, have to clone each element }
-    for i:=0 to min(high(src),high(dst)) do
-      dst[i]:=FpcBaseRecordType(src[i].clone);
+    for i:=0 to min(srccopylen,dstlen)-1 do
+      dst[i]:=FpcBaseRecordType(src[srcstart+i].clone);
   end;
 
 
 { 1-dimensional setlength routines }
 
-function fpc_setlength_dynarr_jbyte(aorg, anew: TJByteArray; deepcopy: boolean): TJByteArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jbyte_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jshort(aorg, anew: TJShortArray; deepcopy: boolean): TJShortArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jshort_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jint(aorg, anew: TJIntArray; deepcopy: boolean): TJIntArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jint_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jlong(aorg, anew: TJLongArray; deepcopy: boolean): TJLongArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jlong_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jchar(aorg, anew: TJCharArray; deepcopy: boolean): TJCharArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jchar_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jfloat(aorg, anew: TJFloatArray; deepcopy: boolean): TJFloatArray;
-  begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
-      begin
-        fpc_copy_jfloat_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jdouble(aorg, anew: TJDoubleArray; deepcopy: boolean): TJDoubleArray;
+function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
+  var
+    orglen, newlen: jint;
   begin
-    if deepcopy or
-       (length(aorg)<>length(anew)) then
+    orglen:=0;
+    newlen:=0;
+    if not deepcopy then
       begin
-        fpc_copy_jdouble_array(aorg,anew);
-        result:=anew
-      end
-    else
-      result:=aorg;
-  end;
-
-
-function fpc_setlength_dynarr_jobject(aorg, anew: TJObjectArray; deepcopy: boolean; docopy : boolean = true): TJObjectArray;
-  begin
+        if assigned(aorg) then
+          orglen:=JLRArray.getLength(aorg)
+        else
+          orglen:=0;
+        if assigned(anew) then
+          newlen:=JLRArray.getLength(anew)
+        else
+          newlen:=0;
+      end;
     if deepcopy or
-       (length(aorg)<>length(anew)) then
+       (orglen<>newlen) then
       begin
         if docopy then
-          fpc_copy_jobject_array(aorg,anew);
+          fpc_copy_shallow_array(aorg,anew);
         result:=anew
       end
     else
@@ -532,7 +382,9 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
   begin
     { resize the current dimension; no need to copy the subarrays of the old
       array, as the subarrays will be (re-)initialised immediately below }
-    result:=fpc_setlength_dynarr_jobject(aorg,anew,deepcopy,false);
+    { the srcstart/srccopylen always refers to the first dimension (since copy()
+      performs a shallow copy of a dynamic array }
+    result:=TJObjectArray(fpc_setlength_dynarr_generic(JLObject(aorg),JLObject(anew),deepcopy,false));
     { if aorg was empty, there's nothing else to do since result will now
       contain anew, of which all other dimensions are already initialised
       correctly since there are no aorg elements to copy }
@@ -547,69 +399,20 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
       begin
         { final dimension -> copy the primitive arrays }
         case eletype of
-          FPCJDynArrTypeJByte:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jbyte(TJByteArray(aorg[i]),TJByteArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jbyte(nil,TJByteArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJShort:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jshort(TJShortArray(aorg[i]),TJShortArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jshort(nil,TJShortArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJInt:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jint(TJIntArray(aorg[i]),TJIntArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jint(nil,TJIntArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJLong:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jlong(TJLongArray(aorg[i]),TJLongArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jlong(nil,TJLongArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJChar:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jchar(TJCharArray(aorg[i]),TJCharArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jchar(nil,TJCharArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJFloat:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jfloat(TJFloatArray(aorg[i]),TJFloatArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jfloat(nil,TJFloatArray(anew[i]),deepcopy));
-            end;
-          FPCJDynArrTypeJDouble:
+          FPCJDynArrTypeRecord:
             begin
               for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jdouble(TJDoubleArray(aorg[i]),TJDoubleArray(anew[i]),deepcopy));
+                result[i]:=JLObject(fpc_setlength_dynarr_jrecord(TJRecordArray(aorg[i]),TJRecordArray(anew[i]),deepcopy));
               for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jdouble(nil,TJDoubleArray(anew[i]),deepcopy));
+                result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
             end;
-          FPCJDynArrTypeJObject:
+          else
             begin
               for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jobject(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,true));
+                result[i]:=fpc_setlength_dynarr_generic(aorg[i],anew[i],deepcopy);
               for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jobject(nil,TJObjectArray(anew[i]),deepcopy,true));
+                result[i]:=fpc_setlength_dynarr_generic(nil,anew[i],deepcopy);
             end;
-          FPCJDynArrTypeRecord:
-            begin
-              for i:=low(result) to partdone do
-                result[i]:=JLObject(fpc_setlength_dynarr_jrecord(TJRecordArray(aorg[i]),TJRecordArray(anew[i]),deepcopy));
-              for i:=succ(partdone) to high(result) do
-                result[i]:=JLObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
-          end;
         end;
       end
     else