mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-11 02:39:24 +01:00
979f55e1db
o every porocedural variable type is represented by a class with one
public "invoke" method whose signature matches the signature of the
procvar
o internally, dispatching happens via java.lang.reflect.Method.invoke().
WARNING: while this allows calling private/protected or other methods
that are normally not accessible from another context, a security
manger can override this. If such a security manager is installed,
most procvars will cause security exceptions
o such dispatching also requires that all arguments are wrapped, but
that's done in the compiler-generated body of the invoke method,
so that procvars can also be called conveniently from Java code
o typecasting between a procedure of object and tmethod is supported,
as well as Delphi-style replacing of only the method pointer via
@procvar1=@procvar2.
o nested procvars are not yet supported, but most of the basic
infrastructure for them is already present
* all units/programs now get an internal __FPC_JVM_Module_Class_Alias$
type when compiled for the JVM target, which is an "external" class
that maps to the unit name. This is required to look up the
JLRMethod instances for regular functions/procedures
+ new tabstractprocdef.copyas() method that allows to create a procvar
from a procdef and vice versa
git-svn-id: branches/jvmbackend@18690 -
683 lines
21 KiB
ObjectPascal
683 lines
21 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2006 by Florian Klaempfl
|
|
member of the Free Pascal development team.
|
|
|
|
System unit for embedded systems
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
Unit system;
|
|
|
|
{$namespace org.freepascal.rtl}
|
|
|
|
{*****************************************************************************}
|
|
interface
|
|
{*****************************************************************************}
|
|
|
|
{$define FPC_IS_SYSTEM}
|
|
|
|
{$I-,Q-,H-,R-,V-,P+,T+}
|
|
{$implicitexceptions off}
|
|
{$mode objfpc}
|
|
|
|
{$undef FPC_HAS_FEATURE_ANSISTRINGS}
|
|
{$undef FPC_HAS_FEATURE_TEXTIO}
|
|
{$undef FPC_HAS_FEATURE_VARIANTS}
|
|
{$undef FPC_HAS_FEATURE_CLASSES}
|
|
{$undef FPC_HAS_FEATURE_EXCEPTIONS}
|
|
{$undef FPC_HAS_FEATURE_OBJECTS}
|
|
{$undef FPC_HAS_FEATURE_RTTI}
|
|
{$undef FPC_HAS_FEATURE_FILEIO}
|
|
{$undef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
|
|
|
|
Type
|
|
{ The compiler has all integer types defined internally. Here
|
|
we define only aliases }
|
|
DWord = LongWord;
|
|
Cardinal = LongWord;
|
|
Integer = SmallInt;
|
|
UInt64 = QWord;
|
|
SizeInt = Longint;
|
|
SizeUInt = Longint;
|
|
PtrInt = Longint;
|
|
PtrUInt = Longint;
|
|
|
|
ValReal = Double;
|
|
|
|
AnsiChar = Char;
|
|
UnicodeChar = WideChar;
|
|
|
|
{ map comp to int64 }
|
|
Comp = Int64;
|
|
|
|
HResult = type longint;
|
|
|
|
PShortString = ^ShortString;
|
|
|
|
{ Java primitive types }
|
|
jboolean = boolean;
|
|
jbyte = shortint;
|
|
jshort = smallint;
|
|
jint = longint;
|
|
jlong = int64;
|
|
jchar = widechar;
|
|
jfloat = single;
|
|
jdouble = double;
|
|
|
|
Arr1jboolean = array of jboolean;
|
|
Arr1jbyte = array of jbyte;
|
|
Arr1jshort = array of jshort;
|
|
Arr1jint = array of jint;
|
|
Arr1jlong = array of jlong;
|
|
Arr1jchar = array of jchar;
|
|
Arr1jfloat = array of jfloat;
|
|
Arr1jdouble = array of jdouble;
|
|
|
|
Arr2jboolean = array of Arr1jboolean;
|
|
Arr2jbyte = array of Arr1jbyte;
|
|
Arr2jshort = array of Arr1jshort;
|
|
Arr2jint = array of Arr1jint;
|
|
Arr2jlong = array of Arr1jlong;
|
|
Arr2jchar = array of Arr1jchar;
|
|
Arr2jfloat = array of Arr1jfloat;
|
|
Arr2jdouble = array of Arr1jdouble;
|
|
|
|
Arr3jboolean = array of Arr2jboolean;
|
|
Arr3jbyte = array of Arr2jbyte;
|
|
Arr3jshort = array of Arr2jshort;
|
|
Arr3jint = array of Arr2jint;
|
|
Arr3jlong = array of Arr2jlong;
|
|
Arr3jchar = array of Arr2jchar;
|
|
Arr3jfloat = array of Arr2jfloat;
|
|
Arr3jdouble = array of Arr2jdouble;
|
|
|
|
const
|
|
{ max. values for longint and int}
|
|
maxLongint = $7fffffff;
|
|
maxSmallint = 32767;
|
|
|
|
maxint = maxsmallint;
|
|
|
|
|
|
{ Java base class type }
|
|
{$i java_sysh.inc}
|
|
{$i java_sys.inc}
|
|
|
|
type
|
|
TObject = class(JLObject)
|
|
strict private
|
|
DestructorCalled: Boolean;
|
|
public
|
|
procedure Free;
|
|
destructor Destroy; virtual;
|
|
procedure finalize; override;
|
|
end;
|
|
|
|
FpcEnumValueObtainable = interface
|
|
function fpcOrdinal: jint;
|
|
function fpcGenericValueOf(__fpc_int: longint): JLEnum;
|
|
end;
|
|
|
|
{$i innr.inc}
|
|
{$i jmathh.inc}
|
|
{$i jrech.inc}
|
|
{$i jseth.inc}
|
|
{$i sstringh.inc}
|
|
{$i jpvarh.inc}
|
|
{$i jdynarrh.inc}
|
|
{$i astringh.inc}
|
|
|
|
|
|
{$ifndef nounsupported}
|
|
const
|
|
vtInteger = 0;
|
|
vtBoolean = 1;
|
|
vtChar = 2;
|
|
{$ifndef FPUNONE}
|
|
vtExtended = 3;
|
|
{$endif}
|
|
vtString = 4;
|
|
vtPointer = 5;
|
|
vtPChar = 6;
|
|
vtObject = 7;
|
|
vtClass = 8;
|
|
vtWideChar = 9;
|
|
vtPWideChar = 10;
|
|
vtAnsiString = 11;
|
|
vtCurrency = 12;
|
|
vtVariant = 13;
|
|
vtInterface = 14;
|
|
vtWideString = 15;
|
|
vtInt64 = 16;
|
|
vtQWord = 17;
|
|
vtUnicodeString = 18;
|
|
|
|
type
|
|
TVarRec = record
|
|
case VType : sizeint of
|
|
{$ifdef ENDIAN_BIG}
|
|
vtInteger : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint);
|
|
vtBoolean : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
|
|
vtChar : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char);
|
|
vtWideChar : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar);
|
|
{$else ENDIAN_BIG}
|
|
vtInteger : (VInteger: Longint);
|
|
vtBoolean : (VBoolean: Boolean);
|
|
vtChar : (VChar: Char);
|
|
vtWideChar : (VWideChar: WideChar);
|
|
{$endif ENDIAN_BIG}
|
|
// vtString : (VString: PShortString);
|
|
// vtPointer : (VPointer: Pointer);
|
|
/// vtPChar : (VPChar: PChar);
|
|
vtObject : (VObject: TObject);
|
|
// vtClass : (VClass: TClass);
|
|
// vtPWideChar : (VPWideChar: PWideChar);
|
|
vtAnsiString : (VAnsiString: JLObject);
|
|
vtCurrency : (VCurrency: Currency);
|
|
// vtVariant : (VVariant: PVariant);
|
|
vtInterface : (VInterface: JLObject);
|
|
vtWideString : (VWideString: JLString);
|
|
vtInt64 : (VInt64: Int64);
|
|
vtUnicodeString : (VUnicodeString: JLString);
|
|
vtQWord : (VQWord: QWord);
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
|
|
Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
|
|
Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
|
|
Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
|
|
Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
|
|
Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
|
|
Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
|
|
Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
|
|
Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
|
|
Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
|
|
Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
|
|
Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
|
|
|
|
Function chr(b : byte) : AnsiChar; [INTERNPROC: fpc_in_chr_byte];
|
|
|
|
function RorByte(Const AValue : Byte): Byte;[internproc:fpc_in_ror_x];
|
|
function RorByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_ror_x_x];
|
|
|
|
function RolByte(Const AValue : Byte): Byte;[internproc:fpc_in_rol_x];
|
|
function RolByte(Const AValue : Byte;Dist : Byte): Byte;[internproc:fpc_in_rol_x_x];
|
|
|
|
function RorWord(Const AValue : Word): Word;[internproc:fpc_in_ror_x];
|
|
function RorWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_ror_x_x];
|
|
|
|
function RolWord(Const AValue : Word): Word;[internproc:fpc_in_rol_x];
|
|
function RolWord(Const AValue : Word;Dist : Byte): Word;[internproc:fpc_in_rol_x_x];
|
|
|
|
function RorDWord(Const AValue : DWord): DWord;[internproc:fpc_in_ror_x];
|
|
function RorDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_ror_x_x];
|
|
|
|
function RolDWord(Const AValue : DWord): DWord;[internproc:fpc_in_rol_x];
|
|
function RolDWord(Const AValue : DWord;Dist : Byte): DWord;[internproc:fpc_in_rol_x_x];
|
|
|
|
function RorQWord(Const AValue : QWord): QWord;[internproc:fpc_in_ror_x];
|
|
function RorQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_ror_x_x];
|
|
|
|
function RolQWord(Const AValue : QWord): QWord;[internproc:fpc_in_rol_x];
|
|
function RolQWord(Const AValue : QWord;Dist : Byte): QWord;[internproc:fpc_in_rol_x_x];
|
|
|
|
function SarShortint(Const AValue : Shortint): Shortint;[internproc:fpc_in_sar_x];
|
|
function SarShortint(Const AValue : Shortint;Shift : Byte): Shortint;[internproc:fpc_in_sar_x_y];
|
|
|
|
function SarSmallint(Const AValue : Smallint): Smallint;[internproc:fpc_in_sar_x];
|
|
function SarSmallint(Const AValue : Smallint;Shift : Byte): Smallint;[internproc:fpc_in_sar_x_y];
|
|
|
|
function SarLongint(Const AValue : Longint): Longint;[internproc:fpc_in_sar_x];
|
|
function SarLongint(Const AValue : Longint;Shift : Byte): Longint;[internproc:fpc_in_sar_x_y];
|
|
|
|
function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
|
|
function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
|
|
|
|
|
|
{$i compproc.inc}
|
|
|
|
{$i ustringh.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;
|
|
|
|
|
|
{$i sstrings.inc}
|
|
{$i astrings.inc}
|
|
{$i ustrings.inc}
|
|
{$i rtti.inc}
|
|
{$i jrec.inc}
|
|
{$i jset.inc}
|
|
{$i jint64.inc}
|
|
{$i jpvar.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
|
|
dst[i]:=FpcBaseRecordType(src[srcstart+i].clone);
|
|
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
|
|
dst[i]:=JUEnumSet(src[srcstart+i].clone);
|
|
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
|
|
dst[i]:=JUBitset(src[srcstart+i].clone);
|
|
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
|
|
dst[i]:=FpcBaseProcVarType(src[srcstart+i].clone);
|
|
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
|
|
dst[i]:=ShortstringClass(src[srcstart+i].clone);
|
|
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;
|
|
|
|
|
|
{i jdynarr.inc end}
|
|
|
|
|
|
|
|
{*****************************************************************************
|
|
Misc. System Dependent Functions
|
|
*****************************************************************************}
|
|
|
|
procedure TObject.Free;
|
|
begin
|
|
if not DestructorCalled then
|
|
begin
|
|
DestructorCalled:=true;
|
|
Destroy;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TObject.Destroy;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure TObject.Finalize;
|
|
begin
|
|
Free;
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
SystemUnit Initialization
|
|
*****************************************************************************}
|
|
|
|
end.
|
|
|