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

git-svn-id: trunk@29364 -

.gitattributes

@@ -8377,6 +8377,7 @@ rtl/inc/readme -text
 rtl/inc/real2str.inc svneol=native#text/plain
 rtl/inc/resh.inc svneol=native#text/plain
 rtl/inc/rtti.inc svneol=native#text/plain
+rtl/inc/rttih.inc svneol=native#text/plain
 rtl/inc/sfpu128.pp svneol=native#text/pascal
 rtl/inc/sfpux80.pp svneol=native#text/pascal
 rtl/inc/softfpu.pp svneol=native#text/plain

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

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;

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;
+

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);
+
+

rtl/inc/systemh.inc

@@ -1476,6 +1476,14 @@ const
 {$i varianth.inc}
 {$endif FPC_HAS_FEATURE_VARIANTS}
 
+{*****************************************************************************
+                           RTTI support
+*****************************************************************************}
+
+{$ifdef FPC_HAS_FEATURE_RTTI}
+{$i rttih.inc}
+{$endif FPC_HAS_FEATURE_RTTI}
+
 {*****************************************************************************
                    Internal helper routines support
 *****************************************************************************}