* system unit additions from mantis #27206. Exports some dynarray related RTTI functions.

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@29364 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 132 insertions, 0 deletions

diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
index 4b799f77cc..214fd3b5b8 100644
--- a/rtl/inc/dynarr.inc
+++ b/rtl/inc/dynarr.inc
@@ -303,6 +303,88 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
 procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
   external name 'FPC_DYNARR_SETLENGTH';
 
+function DynArraySize(a : pointer): tdynarrayindex;
+  external name 'FPC_DYNARRAY_LENGTH';
+
+procedure DynArrayClear(var a: Pointer; typeInfo: Pointer);
+  external name 'FPC_DYNARRAY_CLEAR';
+
+function DynArrayDim(typeInfo: Pointer): Integer;
+  begin
+    result:=0;
+    while (typeInfo <> nil) and (pdynarraytypeinfo(typeInfo)^.kind = tkDynArray) do
+    begin
+      { skip kind and name }
+      typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+
+      { element type info}
+      typeInfo:=pdynarraytypedata(typeInfo)^.elType2;
+
+      Inc(result);
+    end;
+  end;
+
+function DynArrayBounds(a: Pointer; typeInfo: Pointer): TBoundArray;
+  var
+    i,dim: sizeint;
+  begin
+    dim:=DynArrayDim(typeInfo);
+    SetLength(result, dim);
+
+    for i:=0 to pred(dim) do
+      if a = nil then
+        exit
+      else
+      begin
+        result[i]:=DynArraySize(a)-1;
+        a:=PPointerArray(a)^[0];
+      end;
+  end;
+
+function IsDynArrayRectangular(a: Pointer; typeInfo: Pointer): Boolean;
+  var
+    i,j: sizeint;
+    dim,count: sizeint;
+  begin
+    dim:=DynArrayDim(typeInfo);
+    for i:=1 to pred(dim) do
+    begin
+      count:=DynArraySize(PPointerArray(a)^[0]);
+
+      for j:=1 to Pred(DynArraySize(a)) do
+        if count<>DynArraySize(PPointerArray(a)^[j]) then
+          exit(false);
+
+      a:=PPointerArray(a)^[0];
+    end;
+    result:=true;
+  end;
+
+function DynArrayIndex(a: Pointer; const indices: array of SizeInt; typeInfo: Pointer): Pointer;
+  var
+    i,h: sizeint;
+  begin
+    h:=High(indices);
+    for i:=0 to h do
+    begin
+      if i<h then
+        a := PPointerArray(a)^[indices[i]];
+
+      { skip kind and name }
+      typeInfo:=(typeInfo+2+PByte(typeInfo)[1]);
+      { element type info}
+      typeInfo:=pdynarraytypedata(typeInfo)^.elType2;
+
+      if typeInfo=nil then
+        exit(nil);
+    end;
+
+    { skip kind and name }
+    typeInfo:=(typeInfo+2+PByte(typeInfo)[1]);
+
+    result:=@(PByte(a)[indices[h]*pdynarraytypedata(typeInfo)^.elSize]);
+  end;
+
 { obsolete but needed for bootstrapping }
 procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_DECR_REF']; compilerproc;
   begin
diff --git a/rtl/inc/dynarrh.inc b/rtl/inc/dynarrh.inc
index c355227d4c..515dd3c3fd 100644
--- a/rtl/inc/dynarrh.inc
+++ b/rtl/inc/dynarrh.inc
@@ -30,4 +30,12 @@ type
   end;
   
 procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
+function DynArraySize(a : pointer): tdynarrayindex;
+procedure DynArrayClear(var a: Pointer; typeInfo: Pointer);
+function DynArrayDim(typeInfo: Pointer): Integer;
+function DynArrayBounds(a: Pointer; typeInfo: Pointer): TBoundArray;
+
+function IsDynArrayRectangular(a: Pointer; typeInfo: Pointer): Boolean;
+function DynArrayIndex(a: Pointer; const indices: array of SizeInt; typeInfo: Pointer): Pointer;
+
 procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex); compilerproc;
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index fdf3954759..6991b573f2 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -392,3 +392,19 @@ procedure fpc_decref_array(data,typeinfo: pointer; count: SizeInt); [public,alia
     int_finalizeArray(data,typeinfo,count);
   end;
 
+procedure InitializeArray(p, typeInfo: Pointer; count: SizeInt);
+  external name 'FPC_INITIALIZE_ARRAY';
+
+procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
+  external name 'FPC_FINALIZE_ARRAY';
+
+procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
+  var
+    i, size: SizeInt;
+  begin
+    size:=RTTISize(typeInfo);
+    if size>0 then
+      for i:=0 to count-1 do
+        fpc_Copy_internal(source+size*i, dest+size*i, typeInfo);
+  end;
+
diff --git a/rtl/inc/rttih.inc b/rtl/inc/rttih.inc
new file mode 100644
index 0000000000..d092088fc6
--- /dev/null
+++ b/rtl/inc/rttih.inc
@@ -0,0 +1,18 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2014 by Maciej Izak
+
+    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 InitializeArray(p, typeInfo: Pointer; count: SizeInt);
+procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
+procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
+
+
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index b23eb1230b..a763bd84a2 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -1477,6 +1477,14 @@ const
 {$endif FPC_HAS_FEATURE_VARIANTS}
 
 {*****************************************************************************
+                           RTTI support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_RTTI}
+{$i rttih.inc}
+{$endif FPC_HAS_FEATURE_RTTI}
+
+{*****************************************************************************
                    Internal helper routines support
 *****************************************************************************}