Skip to content

Commit

Permalink
Micro-optimizations around instance initialization/cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
EricGrange committed Jun 27, 2022
1 parent e8910fa commit 9c1da91
Show file tree
Hide file tree
Showing 6 changed files with 144 additions and 16 deletions.
2 changes: 2 additions & 0 deletions Libraries/DatabaseLib/dwsDatabase.pas
Original file line number Diff line number Diff line change
Expand Up @@ -316,6 +316,8 @@ destructor TdwsDataSet.Destroy;
NotifyDestroy(FID);
SetLength(FFields, 0);
FFieldCount := -1;
FDataBase := nil;

inherited;
end;

Expand Down
7 changes: 6 additions & 1 deletion Libraries/DatabaseLib/dwsDatabaseLibModule.pas
Original file line number Diff line number Diff line change
Expand Up @@ -183,6 +183,7 @@ TDataField = class
vPools : TSimpleNameObjectHash<TDataBaseQueue>;
vPoolsCS : TMultiReadSingleWrite;
vPoolsCount : Integer;
vScriptDataSetCloneConstructor : TClassCloneConstructor<TScriptDataSet>;

// NotifyDataSetCreate
//
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -1138,9 +1139,13 @@ initialization

vPoolsCS := TMultiReadSingleWrite.Create;

vScriptDataSetCloneConstructor.Initialize(TScriptDataSet.Create);

finalization

vPoolsCS.Free;
vPoolsCS:=nil;

vScriptDataSetCloneConstructor.Finalize;

end.
2 changes: 0 additions & 2 deletions Source/SourceUtils/dwsGabelouStdRules.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
136 changes: 131 additions & 5 deletions Source/dwsDynamicArrays.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -356,6 +362,7 @@ TScriptDynamicNativeBaseInterfaceArray = class (TScriptDynamicNativeArray)

public
class function InterfaceToDataOffset : Integer; override; final;
procedure FreeInstance; override;

procedure SetArrayLength(n : NativeInt);

Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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 ------------------
// ------------------
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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 ------------------
// ------------------
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -3112,4 +3222,20 @@ procedure TScriptDynamicNativeBooleanArray.WriteToJSON(writer : TdwsJSONWriter);
writer.EndArray;
end;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
initialization
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

TScriptDynamicValueArray.PrepareInstanceTemplate;
TScriptDynamicNativeObjectArray.PrepareInstanceTemplate;

finalization

TScriptDynamicValueArray.ReleaseInstanceTemplate;
TScriptDynamicNativeObjectArray.ReleaseInstanceTemplate;

end.
5 changes: 1 addition & 4 deletions Source/dwsExprs.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down
8 changes: 4 additions & 4 deletions Source/dwsUtils.pas
Original file line number Diff line number Diff line change
Expand Up @@ -912,7 +912,7 @@ TFastCompareTextList = class (TStringList)
{$endif}
end;

TClassCloneConstructor<T: TRefCountedObject> = record
TClassCloneConstructor<T: class> = record
private
FTemplate : T;
FSize : Integer;
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 9c1da91

Please sign in to comment.