mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-25 00:18:25 +02:00
8a95a04e16
in the system unit for easier debugging)
* disabled a bunch more feature flags by default for the JVM target
* incorporate modified version of inc/systemh.inc (split into two parts:
jsystemh_types.inc and jsystemh.inc, because some of the types are
required for the declaration of the shortstring/ansistring/set/...
classes, which in turn are required for the routine declarations) and
inc/system.inc (as jsystem.inc)
o moved some routines around from old to new locations based on where
they appear in the common files
o added a number of defines that allow skipping more common implementations
in case a platform-specific one is already available
* all base classes (AnsistringClass etc) are now descendants of
JLObject rather than TObject, because their declaration is now parsed
before TObject is known (and there's no need for them to inherit from
TObject)
* incorporate modified version of inc/system.inc
* use the common version of generic.inc, currh.inc, gencurr.inc and
genmath.inc (with small modification to those files)
+ addition of quite a bit of system unit functionality (halt, runerror,
random, round, str() for integer types, abs, odd, endian swapping helpers,
bit scanning, trigonometric functions, ln, exp, ...)
o round()/trunc() for comp-types has been renamed trunc_comp() on the
JVM target because their JVM signature conflicts with trunc(currency)
o the unsigned versions of swapendian() and other endian helpers are not
available on the JVM target because of JVM signature conflicts
git-svn-id: branches/jvmbackend@18746 -
395 lines
12 KiB
PHP
395 lines
12 KiB
PHP
{
|
|
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;
|
|
|
|
|
|
{$i jrec.inc}
|
|
{$i jset.inc}
|
|
{$i jpvar.inc}
|
|
{$i jsystem.inc}
|
|
|
|
{ copying helpers }
|
|
|
|
procedure fpc_copy_shallow_array(src, dst: JLObject; srcstart: jint = -1; srccopylen: jint = -1);
|
|
var
|
|
srclen, dstlen: jint;
|
|
begin
|
|
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;
|
|
if srccopylen=-1 then
|
|
srccopylen:=srclen
|
|
else if srcstart+srccopylen>srclen then
|
|
srccopylen:=srclen-srcstart;
|
|
{ causes exception in JLSystem.arraycopy }
|
|
if (srccopylen=0) or
|
|
(dstlen=0) then
|
|
exit;
|
|
JLSystem.arraycopy(src,srcstart,dst,0,min(srccopylen,dstlen));
|
|
end;
|
|
|
|
|
|
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);
|
|
if srcstart=-1 then
|
|
srcstart:=0
|
|
else if srcstart>=srclen then
|
|
exit;
|
|
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(srccopylen,dstlen)-1 do
|
|
src[srcstart+i].fpcDeepCopy(dst[i]);
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jenumset_array(src, dst: TJEnumSetArray; srcstart: jint = -1; srccopylen: jint = -1);
|
|
var
|
|
i: longint;
|
|
srclen, dstlen: jint;
|
|
begin
|
|
srclen:=length(src);
|
|
dstlen:=length(dst);
|
|
if srcstart=-1 then
|
|
srcstart:=0
|
|
else if srcstart>=srclen then
|
|
exit;
|
|
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(srccopylen,dstlen)-1 do
|
|
begin
|
|
dst[i].clear;
|
|
dst[i].addAll(src[srcstart+i]);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jbitset_array(src, dst: TJBitSetArray; srcstart: jint = -1; srccopylen: jint = -1);
|
|
var
|
|
i: longint;
|
|
srclen, dstlen: jint;
|
|
begin
|
|
srclen:=length(src);
|
|
dstlen:=length(dst);
|
|
if srcstart=-1 then
|
|
srcstart:=0
|
|
else if srcstart>=srclen then
|
|
exit;
|
|
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(srccopylen,dstlen)-1 do
|
|
begin
|
|
dst[i].clear;
|
|
dst[i].addAll(src[srcstart+i]);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jprocvar_array(src, dst: TJProcVarArray; srcstart: jint = -1; srccopylen: jint = -1);
|
|
var
|
|
i: longint;
|
|
srclen, dstlen: jint;
|
|
begin
|
|
srclen:=length(src);
|
|
dstlen:=length(dst);
|
|
if srcstart=-1 then
|
|
srcstart:=0
|
|
else if srcstart>=srclen then
|
|
exit;
|
|
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(srccopylen,dstlen)-1 do
|
|
src[srcstart+i].fpcDeepCopy(dst[i]);
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jshortstring_array(src, dst: TShortstringArray; srcstart: jint = -1; srccopylen: jint = -1);
|
|
var
|
|
i: longint;
|
|
srclen, dstlen: jint;
|
|
begin
|
|
srclen:=length(src);
|
|
dstlen:=length(dst);
|
|
if srcstart=-1 then
|
|
srcstart:=0
|
|
else if srcstart>=srclen then
|
|
exit;
|
|
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(srccopylen,dstlen)-1 do
|
|
pshortstring(src[srcstart+i])^:=pshortstring(dst[i])^;
|
|
end;
|
|
|
|
|
|
{ 1-dimensional setlength routines }
|
|
|
|
function fpc_setlength_dynarr_generic(aorg, anew: JLObject; deepcopy: boolean; docopy: boolean = true): JLObject;
|
|
var
|
|
orglen, newlen: jint;
|
|
begin
|
|
orglen:=0;
|
|
newlen:=0;
|
|
if not deepcopy then
|
|
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
|
|
(orglen<>newlen) then
|
|
begin
|
|
if docopy then
|
|
fpc_copy_shallow_array(aorg,anew);
|
|
result:=anew
|
|
end
|
|
else
|
|
result:=aorg;
|
|
end;
|
|
|
|
|
|
function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
fpc_copy_jrecord_array(aorg,anew);
|
|
result:=anew
|
|
end
|
|
else
|
|
result:=aorg;
|
|
end;
|
|
|
|
|
|
function fpc_setlength_dynarr_jenumset(aorg, anew: TJEnumSetArray; deepcopy: boolean): TJEnumSetArray;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
fpc_copy_jenumset_array(aorg,anew);
|
|
result:=anew
|
|
end
|
|
else
|
|
result:=aorg;
|
|
end;
|
|
|
|
|
|
function fpc_setlength_dynarr_jbitset(aorg, anew: TJBitSetArray; deepcopy: boolean): TJBitSetArray;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
fpc_copy_jbitset_array(aorg,anew);
|
|
result:=anew
|
|
end
|
|
else
|
|
result:=aorg;
|
|
end;
|
|
|
|
|
|
function fpc_setlength_dynarr_jprocvar(aorg, anew: TJProcVarArray; deepcopy: boolean): TJProcVarArray;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
fpc_copy_jprocvar_array(aorg,anew);
|
|
result:=anew
|
|
end
|
|
else
|
|
result:=aorg;
|
|
end;
|
|
|
|
|
|
function fpc_setlength_dynarr_jshortstring(aorg, anew: TShortstringArray; deepcopy: boolean): TShortstringArray;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
fpc_copy_jshortstring_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 }
|
|
{ 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 }
|
|
if not assigned(aorg) and
|
|
not deepcopy then
|
|
exit;
|
|
partdone:=min(high(result),high(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
|
|
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;
|
|
FPCJDynArrTypeEnumSet:
|
|
begin
|
|
for i:=low(result) to partdone do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(TJEnumSetArray(aorg[i]),TJEnumSetArray(anew[i]),deepcopy));
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jenumset(nil,TJEnumSetArray(anew[i]),deepcopy));
|
|
end;
|
|
FPCJDynArrTypeBitSet:
|
|
begin
|
|
for i:=low(result) to partdone do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(TJBitSetArray(aorg[i]),TJBitSetArray(anew[i]),deepcopy));
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jbitset(nil,TJBitSetArray(anew[i]),deepcopy));
|
|
end;
|
|
FPCJDynArrTypeProcVar:
|
|
begin
|
|
for i:=low(result) to partdone do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(TJProcVarArray(aorg[i]),TJProcVarArray(anew[i]),deepcopy));
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jprocvar(nil,TJProcVarArray(anew[i]),deepcopy));
|
|
end;
|
|
FPCJDynArrTypeShortstring:
|
|
begin
|
|
for i:=low(result) to partdone do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(TShortstringArray(aorg[i]),TShortstringArray(anew[i]),deepcopy));
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_jshortstring(nil,TShortstringArray(anew[i]),deepcopy));
|
|
end;
|
|
else
|
|
begin
|
|
for i:=low(result) to partdone do
|
|
result[i]:=fpc_setlength_dynarr_generic(aorg[i],anew[i],deepcopy);
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=fpc_setlength_dynarr_generic(nil,anew[i],deepcopy);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ recursively handle the next dimension }
|
|
for i:=low(result) to partdone do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_multidim(TJObjectArray(aorg[i]),TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
|
|
for i:=succ(partdone) to high(result) do
|
|
result[i]:=JLObject(fpc_setlength_dynarr_multidim(nil,TJObjectArray(anew[i]),deepcopy,pred(ndim),eletype));
|
|
end;
|
|
end;
|
|
|
|
|
|
function fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; eletype: jchar): JLObject;
|
|
var
|
|
i: longint;
|
|
srclen: longint;
|
|
begin
|
|
if not assigned(src) then
|
|
begin
|
|
result:=nil;
|
|
exit;
|
|
end;
|
|
srclen:=JLRArray.getLength(src);
|
|
if (start=-1) and
|
|
(len=-1) then
|
|
begin
|
|
len:=srclen;
|
|
start:=0;
|
|
end
|
|
else if (start+len>srclen) then
|
|
len:=srclen-start+1;
|
|
result:=JLRArray.newInstance(src.getClass.getComponentType,len);
|
|
if ndim=1 then
|
|
begin
|
|
case eletype of
|
|
FPCJDynArrTypeRecord:
|
|
fpc_copy_jrecord_array(TJRecordArray(src),TJRecordArray(result),start,len);
|
|
FPCJDynArrTypeEnumSet:
|
|
fpc_copy_jenumset_array(TJEnumSetArray(src),TJEnumSetArray(result),start,len);
|
|
FPCJDynArrTypeBitSet:
|
|
fpc_copy_jbitset_array(TJBitSetArray(src),TJBitSetArray(result),start,len);
|
|
FPCJDynArrTypeProcvar:
|
|
fpc_copy_jprocvar_array(TJProcVarArray(src),TJProcVarArray(result),start,len);
|
|
FPCJDynArrTypeShortstring:
|
|
fpc_copy_jshortstring_array(TShortstringArray(src),TShortstringArray(result),start,len);
|
|
else
|
|
fpc_copy_shallow_array(src,result,start,len);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
for i:=0 to len-1 do
|
|
TJObjectArray(result)[i]:=fpc_dynarray_copy(TJObjectArray(src)[start+i],-1,-1,ndim-1,eletype);
|
|
end;
|
|
end;
|
|
|