mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-30 23:33:44 +02:00
2c313e397e
o support for copying value parameters at the callee side if they were
passed by reference in hlcg
o JVM g_concatcopy() implementation for arrays
o moved code to get length of an array from njvminl to hlcgcpu so it can
be reused elsewhere as well
o export array copy helpers from system unit for use when assigning one
array to another
o some generic support for types that are normally not implicit pointers,
but which are for the JVM target (such as normal arrays)
* handle assigning nil to a dynamic array by generating a setlength(x,0)
node instead of by hardcoding a call to fpc_dynarray_clear, so
target-specific code can handle it if required
* hook up gethltemp() for JVM ttgjvm so array temps are properly
allocated
git-svn-id: branches/jvmbackend@18388 -
417 lines
12 KiB
ObjectPascal
417 lines
12 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;
|
|
|
|
{*****************************************************************************}
|
|
interface
|
|
{*****************************************************************************}
|
|
|
|
{$define FPC_IS_SYSTEM}
|
|
|
|
{$I-,Q-,H-,R-,V-}
|
|
{$implicitexceptions off}
|
|
{$mode objfpc}
|
|
|
|
Type
|
|
{ The compiler has all integer types defined internally. Here
|
|
we define only aliases }
|
|
DWord = LongWord;
|
|
Cardinal = LongWord;
|
|
Integer = SmallInt;
|
|
UInt64 = QWord;
|
|
|
|
ValReal = Double;
|
|
|
|
{ map comp to int64, }
|
|
Comp = Int64;
|
|
|
|
HResult = type longint;
|
|
|
|
{ Java primitive types }
|
|
jboolean = boolean;
|
|
jbyte = shortint;
|
|
jshort = smallint;
|
|
jint = longint;
|
|
jlong = int64;
|
|
jchar = widechar;
|
|
jfloat = single;
|
|
jdouble = double;
|
|
|
|
const
|
|
{ max. values for longint and int}
|
|
maxLongint = $7fffffff;
|
|
maxSmallint = 32767;
|
|
|
|
maxint = maxsmallint;
|
|
|
|
type
|
|
{ Java base class type }
|
|
TObject = class external 'java.lang' name 'Object'
|
|
protected
|
|
function clone: TObject;
|
|
public
|
|
constructor create;
|
|
function equals(obj: TObject): boolean;
|
|
function hashcode: longint;
|
|
end;
|
|
TJLObject = TObject;
|
|
|
|
TJISerializable = interface external 'java.lang' name 'Serializable'
|
|
end;
|
|
|
|
TJLThrowable = class external 'java.lang' name 'Throwable' (TObject,TJISerializable)
|
|
constructor create;
|
|
end;
|
|
|
|
{ Java Float class type }
|
|
TJFloat = class external 'java.lang' name 'Float'
|
|
constructor create(f: jfloat);
|
|
class function floatToRawIntBits(f: jfloat): jint; static;
|
|
class function intBitsToFloat(j: jint): jfloat; static;
|
|
end;
|
|
|
|
{ Java Dloat class type }
|
|
TJDouble = class external 'java.lang' name 'Double'
|
|
constructor create(d: jdouble);
|
|
class function doubleToRawLongBits(d: jdouble): jlong; static;
|
|
class function longBitsToDouble(l: jlong): jdouble; static;
|
|
end;
|
|
|
|
{$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 fpc_copy_jbyte_array(src, dst: TJByteArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jshort_array(src, dst: TJShortArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jint_array(src, dst: TJIntArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jlong_array(src, dst: TJLongArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jchar_array(src, dst: TJCharArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jfloat_array(src, dst: TJFloatArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jdouble_array(src, dst: TJDoubleArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(dst)) do
|
|
dst[i]:=src[i];
|
|
end;
|
|
|
|
|
|
procedure fpc_copy_jobject_array(src, dst: TJObjectArray);
|
|
var
|
|
i: longint;
|
|
begin
|
|
for i:=0 to min(high(src),high(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
|
|
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;
|
|
begin
|
|
if deepcopy or
|
|
(length(aorg)<>length(anew)) 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 deepcopy or
|
|
(length(aorg)<>length(anew)) then
|
|
begin
|
|
if docopy then
|
|
fpc_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:=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
|
|
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 high(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 high(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 high(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 high(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 high(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 high(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 high(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 high(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 high(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
|
|
*****************************************************************************}
|
|
|
|
{*****************************************************************************
|
|
SystemUnit Initialization
|
|
*****************************************************************************}
|
|
|
|
end.
|