+ support for (only named, for now) records in the JVM target:

    implemented via classes, all descending from system.FpcBaseRecordType
    (records are also considered to be "related" to system.FpcBaseRecordType
     on the JVM target)
  * several routines are auto-generated for all record-classes: apart
    from a default constructor (if there is none), also clone (which
    returns a new instance containing a deep copy of the current
    instance) and deepCopy (which copies all fields of one instance
    into another one)
   o added new field "synthetickind" to tprocdef that indicates what
     kind of synthetically generated method it is (if any), and
     mark such methods also as "synthetic" in the JVM assembler code
   o split off the JVM-specific parser code (e.g., to add default
     constructors) into pjvm.pas

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/jvmbackend@18450 3ad0048d-3df7-0310-abae-a5850022a9f2

6 files changed, 114 insertions, 0 deletions

diff --git a/rtl/java/compproc.inc b/rtl/java/compproc.inc
index 408b846674..91973de0c7 100644
--- a/rtl/java/compproc.inc
+++ b/rtl/java/compproc.inc
@@ -52,4 +52,5 @@ Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
   dynamic array types, and add an extra parameter to determine the first
   level elements types of the array) }
 procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint);compilerproc;
+procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseRecordType);compilerproc;
 
diff --git a/rtl/java/jdynarrh.inc b/rtl/java/jdynarrh.inc
index 3e541a784b..119db807ef 100644
--- a/rtl/java/jdynarrh.inc
+++ b/rtl/java/jdynarrh.inc
@@ -24,6 +24,7 @@ type
   TJFloatArray = array of jfloat;
   TJDoubleArray = array of jdouble;
   TJObjectArray = array of JLObject;
+  TJRecordArray = array of FpcBaseRecordType;
 
 const
   FPCJDynArrTypeJByte   = 'B';
@@ -34,6 +35,7 @@ const
   FPCJDynArrTypeJFloat  = 'F';
   FPCJDynArrTypeJDouble = 'D';
   FPCJDynArrTypeJObject = 'A';
+  FPCJDynArrTypeRecord  = 'R';
 
 { 1-dimensional setlength routines
 
@@ -49,6 +51,7 @@ function fpc_setlength_dynarr_jchar(aorg, anew: TJCharArray; deepcopy: boolean):
 function fpc_setlength_dynarr_jfloat(aorg, anew: TJFloatArray; deepcopy: boolean): TJFloatArray;
 function fpc_setlength_dynarr_jdouble(aorg, anew: TJDoubleArray; deepcopy: boolean): TJDoubleArray;
 function fpc_setlength_dynarr_jobject(aorg, anew: TJObjectArray; deepcopy: boolean; docopy : boolean = true): TJObjectArray;
+function fpc_setlength_dynarr_jrecord(aorg, anew: TJRecordArray; deepcopy: boolean): TJRecordArray;
 
 { array copying helpers }
 
@@ -60,6 +63,7 @@ procedure fpc_copy_jchar_array(src, dst: TJCharArray);
 procedure fpc_copy_jfloat_array(src, dst: TJFloatArray);
 procedure fpc_copy_jdouble_array(src, dst: TJDoubleArray);
 procedure fpc_copy_jobject_array(src, dst: TJObjectArray);
+procedure fpc_copy_jrecord_array(src, dst: TJRecordArray);
 
 { multi-dimendional setlength routine: all intermediate dimensions are arrays
   of arrays, so that's the same for all array kinds. Only the type of the final
diff --git a/rtl/java/jrec.inc b/rtl/java/jrec.inc
new file mode 100644
index 0000000000..fce9183167
--- /dev/null
+++ b/rtl/java/jrec.inc
@@ -0,0 +1,32 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file implements support infrastructure for records under the JVM
+
+    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.
+
+ **********************************************************************}
+
+  constructor FpcBaseRecordType.create;
+    begin
+    end;
+
+
+  function FpcBaseRecordType.clone: JLObject;
+    begin
+      result:=inherited;
+    end;
+
+
+  function FpcBaseRecordType.newEmpty: FpcBaseRecordType;
+    begin
+      result:=FpcBaseRecordType(inherited clone);
+    end;
+
diff --git a/rtl/java/jrech.inc b/rtl/java/jrech.inc
new file mode 100644
index 0000000000..f6dc0855d1
--- /dev/null
+++ b/rtl/java/jrech.inc
@@ -0,0 +1,28 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by Jonas Maebe,
+    members of the Free Pascal development team.
+
+    This file declares support infrastructure for records under the JVM
+
+    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.
+
+ **********************************************************************}
+
+type
+  { the JLCloneable interface does not declare any methods, but JLObject.clone()
+    throws an exception if you try to clone a class that does not implement this
+    interface }
+  FpcBaseRecordType = class abstract (JLObject, JLCloneable)
+    constructor create;
+    { create a deep copy, overridden by actual record types }
+    function clone: JLObject;override;
+    { create an empty instance of the current type }
+    function newEmpty: FpcBaseRecordType;
+  end;
+
diff --git a/rtl/java/rtti.inc b/rtl/java/rtti.inc
index d5fcadb3a2..42ae5d5741 100644
--- a/rtl/java/rtti.inc
+++ b/rtl/java/rtti.inc
@@ -30,3 +30,21 @@ procedure fpc_initialize_array_dynarr(arr: TJObjectArray; normalarrdim: longint)
       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;
+
diff --git a/rtl/java/system.pp b/rtl/java/system.pp
index 44f5ecf572..3d7c8f58f3 100644
--- a/rtl/java/system.pp
+++ b/rtl/java/system.pp
@@ -97,6 +97,7 @@ type
 
 {$i innr.inc}
 {$i jmathh.inc}
+{$i jrech.inc}
 {$i jdynarrh.inc}
 
 {$i compproc.inc}
@@ -124,6 +125,7 @@ type
 }
 
 {$i rtti.inc}
+{$i jrec.inc}
 
 function min(a,b : longint) : longint;
   begin
@@ -208,6 +210,15 @@ procedure fpc_copy_jobject_array(src, dst: TJObjectArray);
   end;
 
 
+procedure fpc_copy_jrecord_array(src, dst: TJRecordArray);
+  var
+    i: longint;
+  begin
+    for i:=0 to min(high(src),high(dst)) do
+      dst[i]:=FpcBaseRecordType(src[i].clone);
+  end;
+
+
 { 1-dimensional setlength routines }
 
 function fpc_setlength_dynarr_jbyte(aorg, anew: TJByteArray; deepcopy: boolean): TJByteArray;
@@ -315,6 +326,19 @@ function fpc_setlength_dynarr_jobject(aorg, anew: TJObjectArray; deepcopy: boole
   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;
+
+
 { multi-dimensional setlength routine }
 function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: boolean; ndim: longint; eletype: jchar): TJObjectArray;
   var
@@ -395,6 +419,13 @@ function fpc_setlength_dynarr_multidim(aorg, anew: TJObjectArray; deepcopy: bool
               for i:=succ(partdone) to high(result) do
                 result[i]:=TObject(fpc_setlength_dynarr_jobject(nil,TJObjectArray(anew[i]),deepcopy,true));
             end;
+          FPCJDynArrTypeRecord:
+            begin
+              for i:=low(result) to partdone do
+                result[i]:=TObject(fpc_setlength_dynarr_jrecord(TJRecordArray(aorg[i]),TJRecordArray(anew[i]),deepcopy));
+              for i:=succ(partdone) to high(result) do
+                result[i]:=TObject(fpc_setlength_dynarr_jrecord(nil,TJRecordArray(anew[i]),deepcopy));
+          end;
         end;
       end
     else