Faster managed record initialization.

rtl/inc/rtti.inc

@@ -102,42 +102,57 @@ begin
   Result:=PRecordInfoInit(ti)^.InitRecordOpTable;
 end;
 
-Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
+procedure InitializeRecord(Data : pointer;Ri : PRecordInfoInit); forward;
+
+procedure InlinedInitialize(Data,TypeInfo : pointer); inline; { Should come before InitializeRecord for inlining. }
+const
+  Flatten: array[TTypeKind] of uint8 =
+  ( { 0: pointer, 1: record, 2: array, 3: variant, 255: unmanaged. }
+    {tkUnknown} 255, {tkInteger} 255, {tkChar} 255, {tkEnumeration} 255, {tkFloat} 255,
+    {tkSet} 255, {tkMethod} 255, {tkSString} 255, {tkLString} 255, {tkAString} 0,
+    {tkWString} 0, {tkVariant} 3, {tkArray} 2, {tkRecord} 1, {tkInterface} 0,
+    {tkClass} 255, {tkObject} 1, {tkWChar} 255, {tkBool} 255, {tkInt64} 255, {tkQWord} 255,
+    {tkDynArray} 0, {tkInterfaceRaw} 255, {tkProcVar} 255, {tkUString} 0, {tkUChar} 255,
+    {tkHelper} 255, {tkFile} 255, {tkClassRef} 255, {tkPointer} 255
+  );
 var
   ri: PRecordInfoInit;
 begin
-  case PTypeKind(TypeInfo)^ of
-{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
-    tkDynArray,
-{$endif FPC_HAS_FEATURE_DYNARRAYS}
-{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-    tkAstring,
-{$endif FPC_HAS_FEATURE_ANSISTRINGS}
-{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-    tkWstring,tkUString,
-{$endif FPC_HAS_FEATURE_WIDESTRINGS}
-    tkInterface:
-      PPAnsiChar(Data)^:=Nil;
-    tkArray:
+  case cardinal(Flatten[PTypeKind(TypeInfo)^]) of
+    0: { pointer }
+      PPointer(Data)^:=Nil;
+    1: { record }
+      InitializeRecord(Data,RTTIRecordInfoInit(TypeInfo));
+    2: { array }
       with PArrayInfo(aligntoqword(typeInfo+2+PByte(typeInfo)[1]))^ do
         int_InitializeArray(data,ElInfo^,ElCount);
-{$ifdef FPC_HAS_FEATURE_OBJECTS}
-    tkObject,
-{$endif FPC_HAS_FEATURE_OBJECTS}
-    tkRecord:
-      begin
-        ri:=RTTIRecordInfoInit(typeinfo);
-        recordrtti(data,ri,@int_initialize);
-        if Assigned(ri^.recordop) and Assigned(ri^.recordop^.Initialize) then
-          ri^.recordop^.Initialize(data);
-      end;
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
-    tkVariant:
+    3: { variant }
       variant_init(PVarData(Data)^);
 {$endif FPC_HAS_FEATURE_VARIANTS}
   end;
 end;
 
+procedure InitializeRecord(Data : pointer;Ri : PRecordInfoInit);
+var
+  i : longint;
+  Re : PRecordElement;
+begin
+  Re:=AlignTypeData(Pointer(@Ri^.Count)+SizeOf(Ri^.Count));
+  for i:=Ri^.Count downto 1 Do
+    begin
+      InlinedInitialize(Data+Re^.Offset,Re^.TypeInfo^);
+      Inc(Re);
+    end;
+  if Assigned(Ri^.RecordOp) and Assigned(Ri^.RecordOp^.Initialize) then
+    Ri^.RecordOp^.Initialize(Data);
+end;
+
+Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
+begin
+  InlinedInitialize(Data,TypeInfo);
+end;
+
 
 Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
 var
@@ -355,13 +370,22 @@ end;
 procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
   var
     sample,size,i : SizeInt;
+    ri : PRecordInfoInit;
   begin
     sample:=RTTIManagedSizes[PTypeKind(typeinfo)^];
     if sample<>RTTISpecialSize then
       FillChar(data^,sample*count,0)
-    else if RTTIManagementAndSize(typeinfo, rotInitialize, size, false) then
-      for i:=0 to count-1 do
-        int_initialize(data+size*i,typeinfo);
+    else if PTypeKind(typeinfo)^=tkArray then
+      with PArrayInfo(aligntoqword(typeInfo+2+PByte(typeInfo)[1]))^ do
+        int_InitializeArray(data,ElInfo^,count*ElCount)
+    else
+      begin { tkRecord/tkObject. }
+        ri:=RTTIRecordInfoInit(typeinfo);
+        size:=ri^.size;
+        if (ri^.Count>0) or Assigned(Ri^.RecordOp) then { Heuristically replaces the more expensive RTTIManagementAndSize. Can have false positives but they are harmless and won’t occur in practice. }
+          for i:=0 to count-1 do
+            InitializeRecord(data+size*i,ri);
+      end;
   end;