From 9c1da91c8dc8996dc64597c79eb3ee52c3f8356e Mon Sep 17 00:00:00 2001 From: egrange Date: Mon, 27 Jun 2022 10:51:49 +0200 Subject: [PATCH] Micro-optimizations around instance initialization/cleanup --- Libraries/DatabaseLib/dwsDatabase.pas | 2 + .../DatabaseLib/dwsDatabaseLibModule.pas | 7 +- Source/SourceUtils/dwsGabelouStdRules.pas | 2 - Source/dwsDynamicArrays.pas | 136 +++++++++++++++++- Source/dwsExprs.pas | 5 +- Source/dwsUtils.pas | 8 +- 6 files changed, 144 insertions(+), 16 deletions(-) diff --git a/Libraries/DatabaseLib/dwsDatabase.pas b/Libraries/DatabaseLib/dwsDatabase.pas index 22f456cb..02198351 100644 --- a/Libraries/DatabaseLib/dwsDatabase.pas +++ b/Libraries/DatabaseLib/dwsDatabase.pas @@ -316,6 +316,8 @@ destructor TdwsDataSet.Destroy; NotifyDestroy(FID); SetLength(FFields, 0); FFieldCount := -1; + FDataBase := nil; + inherited; end; diff --git a/Libraries/DatabaseLib/dwsDatabaseLibModule.pas b/Libraries/DatabaseLib/dwsDatabaseLibModule.pas index 431cbe78..5358fa51 100644 --- a/Libraries/DatabaseLib/dwsDatabaseLibModule.pas +++ b/Libraries/DatabaseLib/dwsDatabaseLibModule.pas @@ -183,6 +183,7 @@ TDataField = class vPools : TSimpleNameObjectHash; vPoolsCS : TMultiReadSingleWrite; vPoolsCount : Integer; + vScriptDataSetCloneConstructor : TClassCloneConstructor; // 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. diff --git a/Source/SourceUtils/dwsGabelouStdRules.pas b/Source/SourceUtils/dwsGabelouStdRules.pas index 86941961..c5feac4d 100644 --- a/Source/SourceUtils/dwsGabelouStdRules.pas +++ b/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 diff --git a/Source/dwsDynamicArrays.pas b/Source/dwsDynamicArrays.pas index ebff03bc..03a3c5d5 100644 --- a/Source/dwsDynamicArrays.pas +++ b/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. diff --git a/Source/dwsExprs.pas b/Source/dwsExprs.pas index a5122b8a..b9bdca63 100644 --- a/Source/dwsExprs.pas +++ b/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 } diff --git a/Source/dwsUtils.pas b/Source/dwsUtils.pas index 45453337..807e81c8 100644 --- a/Source/dwsUtils.pas +++ b/Source/dwsUtils.pas @@ -912,7 +912,7 @@ TFastCompareTextList = class (TStringList) {$endif} end; - TClassCloneConstructor = record + TClassCloneConstructor = record private FTemplate : T; FSize : Integer; @@ -6960,8 +6960,8 @@ procedure TSimpleIntegerStack.SetPeek(const item : Integer); // procedure TClassCloneConstructor.Initialize(aTemplate : T); begin - FTemplate:=aTemplate; - FSize:= FTemplate.InstanceSize; + FTemplate := aTemplate; + FSize := FTemplate.InstanceSize; end; // Finalize @@ -6969,7 +6969,7 @@ procedure TClassCloneConstructor.Initialize(aTemplate : T); procedure TClassCloneConstructor.Finalize; begin FTemplate.Free; - TObject(FTemplate):=nil; // D2010 bug workaround + TObject(FTemplate) := nil; // D2010 bug workaround end; // Create