Micro-optimizations around instance initialization/cleanup

Author: EricGrange

Libraries/DatabaseLib/dwsDatabase.pas

@@ -316,6 +316,8 @@ destructor TdwsDataSet.Destroy;
    NotifyDestroy(FID);
    SetLength(FFields, 0);
    FFieldCount := -1;
+   FDataBase := nil;
+
    inherited;
 end;
 

Libraries/DatabaseLib/dwsDatabaseLibModule.pas

@@ -183,6 +183,7 @@    TDataField = class
    vPools : TSimpleNameObjectHash<TDataBaseQueue>;
    vPoolsCS : TMultiReadSingleWrite;
    vPoolsCount : Integer;
+   vScriptDataSetCloneConstructor : TClassCloneConstructor<TScriptDataSet>;
 
 // NotifyDataSetCreate
 //
@@ -732,7 +733,7 @@ function TdwsDatabaseLib.dwsDatabaseClassesDataBaseMethodsQueryFastEval(
    if TdwsDataSet.CallbacksRegistered then
       dsID := TdwsDataSet.NotifyCreate(args.Expr)
    else dsID := 0;
-   dataSet := TScriptDataSet.Create;
+   dataSet := vScriptDataSetCloneConstructor.Create;
    try
       dataSet.FIntf := dbo.Intf.Query(sql, scriptDyn, args.Expr);
    except
@@ -1138,9 +1139,13 @@ initialization
 
    vPoolsCS := TMultiReadSingleWrite.Create;
 
+   vScriptDataSetCloneConstructor.Initialize(TScriptDataSet.Create);
+
 finalization
 
    vPoolsCS.Free;
    vPoolsCS:=nil;
 
+   vScriptDataSetCloneConstructor.Finalize;
+
 end.

Source/SourceUtils/dwsGabelouStdRules.pas

@@ -400,8 +400,6 @@ procedure TGR_TypesNaming.EvaluateSymbol(const aSymbolList : TSymbolPositionList
       isException := False;
 
       typeSymbol := TTypeSymbol(aSymbolList.Symbol).UnAliasedType;
-      if typeSymbol is TFuncSymbol then Exit;
-
       if typeSymbol is TClassSymbol then begin
          classSymbol := TClassSymbol(typeSymbol);
          while classSymbol.Parent <> nil do begin

Source/dwsDynamicArrays.pas

@@ -70,6 +70,7 @@    TScriptDynamicDataArray = class (TDataContext, IScriptDynArray)//(TInterfaced
          function SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean;
 
       public
+         procedure FreeInstance; override;
 
          function ScriptTypeName : String; override;
 
@@ -112,8 +113,13 @@    TScriptDynamicDataArray = class (TDataContext, IScriptDynArray)//(TInterfaced
          property AsString[index : NativeInt] : String write SetAsString;
    end;
 
-   TScriptDynamicValueArray = class (TScriptDynamicDataArray)
+   TScriptDynamicValueArray = class sealed (TScriptDynamicDataArray)
       public
+         class function NewInstance: TObject; override;
+
+         class procedure PrepareInstanceTemplate; static;
+         class procedure ReleaseInstanceTemplate; static;
+
          procedure Swap(i1, i2 : NativeInt); override;
    end;
 
@@ -356,6 +362,7 @@    TScriptDynamicNativeBaseInterfaceArray = class (TScriptDynamicNativeArray)
 
       public
          class function InterfaceToDataOffset : Integer; override; final;
+         procedure FreeInstance; override;
 
          procedure SetArrayLength(n : NativeInt);
 
@@ -413,8 +420,13 @@    TScriptDynamicNativeInterfaceArray = class (TScriptDynamicNativeBaseInterface
          procedure AddFromExpr(exec : TdwsExecution; valueExpr : TExprBase);
          function SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean;
    end;
-   TScriptDynamicNativeObjectArray = class (TScriptDynamicNativeBaseInterfaceArray, IScriptDynArray)
+   TScriptDynamicNativeObjectArray = class sealed (TScriptDynamicNativeBaseInterfaceArray, IScriptDynArray)
       public
+         class function NewInstance: TObject; override;
+
+         class procedure PrepareInstanceTemplate; static;
+         class procedure ReleaseInstanceTemplate; static;
+
          procedure AddFromExpr(exec : TdwsExecution; valueExpr : TExprBase);
          function SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean;
    end;
@@ -492,7 +504,8 @@    TScriptDynamicNativeBooleanArray = class (TScriptDynamicNativeArray, IScriptD
          procedure WriteToJSON(writer : TdwsJSONWriter);
    end;
 
-procedure CreateNewDynamicArray(elemTyp : TTypeSymbol; var result : IScriptDynArray);
+function CreateNewDynamicArray(elemTyp : TTypeSymbol) : TInterfacedObject; overload;
+procedure CreateNewDynamicArray(elemTyp : TTypeSymbol; var result : IScriptDynArray); inline; overload;
 
 // ------------------------------------------------------------------
 // ------------------------------------------------------------------
@@ -535,9 +548,9 @@ procedure DynamicArrayAddStrings(const dyn : IScriptDynArray; sl : TStrings);
       dyn.AsString[i+n] := sl[i];
 end;
 
-// CreateNewDynamicArray
+// CreateNewDynamicArray (func)
 //
-procedure CreateNewDynamicArray(elemTyp : TTypeSymbol; var result : IScriptDynArray);
+function CreateNewDynamicArray(elemTyp : TTypeSymbol) : TInterfacedObject;
 var
    size : Integer;
    ct : TClass;
@@ -565,6 +578,13 @@ procedure CreateNewDynamicArray(elemTyp : TTypeSymbol; var result : IScriptDynAr
    end else Result := TScriptDynamicDataArray.Create(elemTyp);
 end;
 
+// CreateNewDynamicArray (proc IScriptDynArray)
+//
+procedure CreateNewDynamicArray(elemTyp : TTypeSymbol; var result : IScriptDynArray);
+begin
+   result := CreateNewDynamicArray(elemTyp) as IScriptDynArray;
+end;
+
 // ------------------
 // ------------------ TScriptDynamicDataArray ------------------
 // ------------------
@@ -723,6 +743,14 @@ function TScriptDynamicDataArray.SetFromExpr(index : NativeInt; exec : TdwsExecu
    end else Result := False;
 end;
 
+// FreeInstance
+//
+procedure TScriptDynamicDataArray.FreeInstance;
+begin
+   ClearData;
+   FreeMemory(Self);
+end;
+
 // AddStrings
 //
 procedure TScriptDynamicDataArray.AddStrings(sl : TStrings);
@@ -975,6 +1003,43 @@ function TScriptDynamicDataArray.GetElementType : TTypeSymbol;
 // ------------------ TScriptDynamicValueArray ------------------
 // ------------------
 
+// NewInstance
+//
+var
+   vDynamicValueArrayInstanceTemplate : Pointer;
+class function TScriptDynamicValueArray.NewInstance: TObject;
+begin
+   if vDynamicValueArrayInstanceTemplate = nil then begin
+      Result := inherited NewInstance;
+      vDynamicValueArrayInstanceTemplate := GetMemory(InstanceSize);
+      System.Move(Pointer(Result)^, vDynamicValueArrayInstanceTemplate^, InstanceSize);
+   end else begin
+      Result := GetMemory(InstanceSize);
+      System.Move(vDynamicValueArrayInstanceTemplate^, Pointer(Result)^, InstanceSize);
+   end;
+end;
+
+// PrepareInstanceTemplate
+//
+class procedure TScriptDynamicValueArray.PrepareInstanceTemplate;
+var
+   a : TScriptDynamicValueArray;
+begin
+   a := TScriptDynamicValueArray.Create(nil);
+   a.Free;
+end;
+
+// ReleaseInstanceTemplate
+//
+class procedure TScriptDynamicValueArray.ReleaseInstanceTemplate;
+var
+   p : Pointer;
+begin
+   p := vDynamicValueArrayInstanceTemplate;
+   vDynamicValueArrayInstanceTemplate := nil;
+   FreeMem(p);
+end;
+
 // Swap
 //
 procedure TScriptDynamicValueArray.Swap(i1, i2 : NativeInt);
@@ -2606,6 +2671,14 @@ class function TScriptDynamicNativeBaseInterfaceArray.InterfaceToDataOffset : In
    Result := NativeInt(@instance.FData) - NativeInt(intf);
 end;
 
+// FreeInstance
+//
+procedure TScriptDynamicNativeBaseInterfaceArray.FreeInstance;
+begin
+   FData := nil;
+   FreeMemory(Self);
+end;
+
 // ------------------
 // ------------------ TScriptDynamicNativeInterfaceArray ------------------
 // ------------------
@@ -2634,6 +2707,43 @@ procedure TScriptDynamicNativeInterfaceArray.AddFromExpr(exec : TdwsExecution; v
 // ------------------ TScriptDynamicNativeObjectArray ------------------
 // ------------------
 
+// NewInstance
+//
+var
+   vDynamicNativeObjectArrayInstanceTemplate : Pointer;
+class function TScriptDynamicNativeObjectArray.NewInstance: TObject;
+begin
+   if vDynamicNativeObjectArrayInstanceTemplate = nil then begin
+      Result := inherited NewInstance;
+      vDynamicNativeObjectArrayInstanceTemplate := GetMemory(InstanceSize);
+      System.Move(Pointer(Result)^, vDynamicNativeObjectArrayInstanceTemplate^, InstanceSize);
+   end else begin
+      Result := GetMemory(InstanceSize);
+      System.Move(vDynamicNativeObjectArrayInstanceTemplate^, Pointer(Result)^, InstanceSize);
+   end;
+end;
+
+// PrepareInstanceTemplate
+//
+class procedure TScriptDynamicNativeObjectArray.PrepareInstanceTemplate;
+var
+   a : TScriptDynamicNativeObjectArray;
+begin
+   a := TScriptDynamicNativeObjectArray.Create(nil);
+   a.Free;
+end;
+
+// ReleaseInstanceTemplate
+//
+class procedure TScriptDynamicNativeObjectArray.ReleaseInstanceTemplate;
+var
+   p : Pointer;
+begin
+   p := vDynamicNativeObjectArrayInstanceTemplate;
+   vDynamicNativeObjectArrayInstanceTemplate := nil;
+   FreeMem(p);
+end;
+
 // SetFromExpr
 //
 function TScriptDynamicNativeObjectArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean;
@@ -3112,4 +3222,20 @@ procedure TScriptDynamicNativeBooleanArray.WriteToJSON(writer : TdwsJSONWriter);
    writer.EndArray;
 end;
 
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+initialization
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+
+   TScriptDynamicValueArray.PrepareInstanceTemplate;
+   TScriptDynamicNativeObjectArray.PrepareInstanceTemplate;
+
+finalization
+
+   TScriptDynamicValueArray.ReleaseInstanceTemplate;
+   TScriptDynamicNativeObjectArray.ReleaseInstanceTemplate;
+
 end.

Source/dwsExprs.pas

@@ -1717,11 +1717,8 @@ implementation
 // TScriptDynamicArray_InitData
 //
 procedure TScriptDynamicArray_InitData(elemTyp : TTypeSymbol; const resultDC : IDataContext; offset : NativeInt);
-var
-   a : IScriptDynarray;
 begin
-   CreateNewDynamicArray(elemTyp, a);
-   resultDC.AsInterface[offset] := a;
+   resultDC.AsInterface[offset] := CreateNewDynamicArray(elemTyp) as IScriptDynarray;
 end;
 
 { TScriptObjectWrapper }

Source/dwsUtils.pas

@@ -912,7 +912,7 @@    TFastCompareTextList = class (TStringList)
       {$endif}
    end;
 
-   TClassCloneConstructor<T: TRefCountedObject> = record
+   TClassCloneConstructor<T: class> = record
       private
          FTemplate : T;
          FSize : Integer;
@@ -6960,16 +6960,16 @@ procedure TSimpleIntegerStack.SetPeek(const item : Integer);
 //
 procedure TClassCloneConstructor<T>.Initialize(aTemplate : T);
 begin
-   FTemplate:=aTemplate;
-   FSize:= FTemplate.InstanceSize;
+   FTemplate := aTemplate;
+   FSize := FTemplate.InstanceSize;
 end;
 
 // Finalize
 //
 procedure TClassCloneConstructor<T>.Finalize;
 begin
    FTemplate.Free;
-   TObject(FTemplate):=nil; // D2010 bug workaround
+   TObject(FTemplate) := nil; // D2010 bug workaround
 end;
 
 // Create