fpc/rtl/java/rtti.inc
Jonas Maebe 37aa2d8443 + full support for sets on the JVM target
o sets of enums are handled as JUEnumSet instances, others as JUBitSet
     derivatives (both smallsets and varsets, to make interoperability with
     Java easier)
   o special handling of set constants: these have to be constructed at run
     time. In case of constants in the code, create an internal constsym to
     represent them. These and regular constsyms are then aliased by an
     another internal staticvarsym that is used to initialise them in the
     unit initialisation code.
   o until they are constructed at run time, set constants are encoded as
     constant Java strings (with the characters containing the set bits)
   o hlcgobj conversion of tcginnode.pass_generate_code() for the genjumps
     part (that's the only part of the generic code that's used by the JVM
     target)
   o as far as explicit typecasting support is concerned, currently the
     following ones are supported (both from/to setdefs): ordinal types,
     enums, any other set types (whose size is the same on native targets)
   o enum setdefs also emit signatures
   o overloading routines for different ordinal set types, or for different
     enum set types, is not supported on the JVM target

git-svn-id: branches/jvmbackend@18662 -
2011-08-20 08:22:22 +00:00

150 lines
4.7 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
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.
**********************************************************************}
procedure fpc_initialize_array_jstring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_unicodestring';
procedure fpc_initialize_array_unicodestring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_jstring_intern(TJObjectArray(arr[i]),normalarrdim-1);
end
else
begin
for i:=low(arr) to high(arr) do
unicodestring(arr[i]):='';
end;
end;
procedure fpc_initialize_array_ansistring_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_ansistring';
procedure fpc_initialize_array_ansistring(arr: TJObjectArray; normalarrdim: longint);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_ansistring_intern(TJObjectArray(arr[i]),normalarrdim-1);
end
else
begin
for i:=low(arr) to high(arr) do
ansistring(arr[i]):='';
end;
end;
procedure fpc_initialize_array_dynarr_intern(arr: TJObjectArray; normalarrdim: longint); external name 'fpc_initialize_array_dynarr';
procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_dynarr_intern(TJObjectArray(arr[i]),normalarrdim-1);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=nil;
end;
end;
procedure fpc_initialize_array_record_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType); external name 'fpc_initialize_array_record';
procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_record_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=inst.clone;
end;
end;
{ exactly the same as fpc_initialize_array_record, but can't use generic
routine because of Java clonable design :( (except by rtti/invoke, but that's
not particularly fast either) }
procedure fpc_initialize_array_bitset_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet); external name 'fpc_initialize_array_bitset';
procedure fpc_initialize_array_bitset(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_bitset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=inst.clone;
end;
end;
{ idem }
procedure fpc_initialize_array_enumset_intern(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet); external name 'fpc_initialize_array_enumset';
procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_enumset_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=inst.clone;
end;
end;
procedure fpc_initialize_array_shortstring_intern(arr: TJObjectArray; normalarrdim: longint; maxlen: byte); external name 'fpc_initialize_array_shortstring';
procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_shortstring_intern(TJObjectArray(arr[i]),normalarrdim-1,maxlen);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=ShortstringClass.CreateEmpty(maxlen);
end;
end;