fpc/rtl/java/rtti.inc
Jonas Maebe 979f55e1db + support for procedural variables for the JVM target
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 -
2011-08-20 08:24:58 +00:00

169 lines
5.3 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;
procedure fpc_initialize_array_procvar_intern(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseProcVarType); external name 'fpc_initialize_array_procvar';
procedure fpc_initialize_array_procvar(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseProcVarType);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_procvar_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;