mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-16 10:09:34 +02:00
+ (dynamic) array helper routines
git-svn-id: branches/jvmbackend@18357 -
This commit is contained in:
Jonas Maebe
parent
9bd753ba7a
commit
ca98c329b3
@ -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
|
||||
*****************************************************************************}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user