+ (dynamic) array helper routines

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

rtl/java/system.pp

@@ -23,6 +23,7 @@ Unit System;
 {$define FPC_IS_SYSTEM}
 
 {$I-,Q-,H-,R-,V-}
+{$implicitexceptions off}
 {$mode objfpc}
 
 Type
@@ -70,11 +71,318 @@ type
 
 {$i innr.inc}
 {$i jmathh.inc}
+{$i jdynarrh.inc}
 
 {*****************************************************************************}
                                  implementation
 {*****************************************************************************}
 
+{i jdynarr.inc}
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe
+    member of the Free Pascal development team.
+
+    This file implements the helper routines for dyn. Arrays in FPC
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+function min(a,b : longint) : longint;
+  begin
+     if a<=b then
+       min:=a
+     else
+       min:=b;
+  end;
+
+{ copying helpers }
+
+{ also for booleans }
+procedure copy_jbyte_array(src, dst: TJByteArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jshort_array(src, dst: TJShortArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jint_array(src, dst: TJIntArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jlong_array(src, dst: TJLongArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jchar_array(src, dst: TJCharArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jfloat_array(src, dst: TJFloatArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jdouble_array(src, dst: TJDoubleArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  end;
+
+
+procedure copy_jobject_array(src, dst: TJObjectArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to pred(min(length(src),length(dst))) do
+      dst[i]:=src[i];
+  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
+        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
+        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
+        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
+        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
+        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
+        copy_jfloat_array(aorg,anew);
+        result:=anew
+      end
+    else
+      result:=aorg;
+  end;
+
+
+function fpc_setlength_dynarr_jdouble(aorg, anew: TJDoubleArray; deepcopy: boolean): TJDoubleArray;
+  begin
+    if deepcopy or
+       (length(aorg)<>length(anew)) then
+      begin
+        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 deepcopy or
+       (length(aorg)<>length(anew)) then
+      begin
+        if docopy then
+          copy_jobject_array(aorg,anew);
+        result:=anew
+      end
+    else
+      result:=aorg;
+  end;
+
+
+{ multi-dimensional setlength routine }
+function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
+  var
+    partdone,
+    i: longint;
+
+  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);
+    { 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 }
+    if not assigned(aorg) and
+       not deepcopy then
+      exit;
+    partdone:=pred(min(length(result),length(aorg)));
+    { ndim must be >=2 when this routine is called, since it has to return
+      an array of java.lang.Object! (arrays are also objects, but primitive
+      types are not) }
+    if ndim=2 then
+      begin
+        { final dimension -> copy the primitive arrays }
+        case eletype of
+          FPCJDynArrTypeJByte:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jbyte(TJByteArray(aorg[i]),TJByteArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jbyte(nil,TJByteArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJShort:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jshort(TJShortArray(aorg[i]),TJShortArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jshort(nil,TJShortArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJInt:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jint(TJIntArray(aorg[i]),TJIntArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jint(nil,TJIntArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJLong:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jlong(TJLongArray(aorg[i]),TJLongArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jlong(nil,TJLongArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJChar:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jchar(TJCharArray(aorg[i]),TJCharArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jchar(nil,TJCharArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJFloat:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jfloat(TJFloatArray(aorg[i]),TJFloatArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jfloat(nil,TJFloatArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJDouble:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jdouble(TJDoubleArray(aorg[i]),TJDoubleArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jdouble(nil,TJDoubleArray(anew[i]),deepcopy));
+            end;
+          FPCJDynArrTypeJObject:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jobject(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,true));
+              for i:=succ(partdone) to pred(length(result)) do
+                result[i]:=TObject(fpc_setlength_dynarr_jobject(nil,TJObjectArray(anew[i]),deepcopy,true));
+            end;
+        end;
+      end
+    else
+      begin
+        { recursively handle the next dimension }
+        for i:=low(result) to partdone do
+          result[i]:=TObject(fpc_setlength_dynarr_multidim(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
+        for i:=succ(partdone) to pred(length(result)) do
+          result[i]:=TObject(fpc_setlength_dynarr_multidim(nil,TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
+      end;
+  end;
+
+
+
+{i jdynarr.inc end}
+
+
+
 {*****************************************************************************
                        Misc. System Dependent Functions
 *****************************************************************************}