DelphiXE下的泛型解决方案

DelphiXE下的泛型
这两天在看一个C++的库,其中建立了一个对于特定类型的内存分配器.觉得挺有价值,因此
在DdelphiXE下也模拟了一个:

Delphi(Pascal) code

  //! defines an allocation strategy  TIrrAllocStragegy =    (      iasSafeAllocate,      iasDoubleAllocate,      iasSortAllocate    );  TIrrAllocInit =    (      iaiDefault,      iaiForce,      iaiNone    );  TIrrAllocatorBase = class;  TIrrAllocatorClass = class of TIrrAllocatorBase;  TIrrAllocatorBase = class(TObject)  protected    class var FClassList: TList<TIrrAllocatorClass>;  public    class constructor Create;    class destructor Destroy;    class function FindClass(AClassName: String; var AClass: TIrrAllocatorClass): Boolean;    class function GetClassListCount: Integer;    class function GetClass(const Index: Integer): TIrrAllocatorClass;    class function GetMemNode(Count: Integer = 1;      InitNode: TIrrAllocInit = iaiDefault): Pointer; virtual; abstract;    class procedure FreeMemNode(P: Pointer;      FinalNode: TIrrAllocInit = iaiDefault); virtual; abstract;  end;  TIrrAllocator<T> = class(TIrrAllocatorBase)  protected    class var TypeInfoPtr: Pointer;    class var TypeDataSize: Integer;    class var ManagedFieldCount: Integer;    class var NodeType: TTypeKind;    class var NeedInit: Boolean;    class var AllocatedInfo: TDictionary<Pointer, Integer>;    class var AllocatedCount: Integer;  public    class function GetMemNode(Count: Integer = 1;      InitNode: TIrrAllocInit = iaiDefault): Pointer; override;    class procedure FreeMemNode(P: Pointer;      FinalNode: TIrrAllocInit = iaiDefault); override;    class constructor Create;    class destructor Destroy;    class function GetNodeCount: Integer; inline;    class function GetNodeSize: Integer; inline;  end;implementation{ TIrrAllocator }{ TIrrAllocatorBase }class constructor TIrrAllocatorBase.Create;begin  FClassList := TList<TIrrAllocatorClass>.Create;end;class destructor TIrrAllocatorBase.Destroy;begin  FClassList.Free;end;class function TIrrAllocatorBase.FindClass(AClassName: String;  var AClass: TIrrAllocatorClass): Boolean;var  i: Integer;begin  for i := 0 to FClassList.Count - 1 do  begin    if UpperCase(FClassList.Items[i].ClassName) = UpperCase(AClassName) then    begin      AClass := FClassList.Items[i];      Result := True;      Exit;    end;  end;  Result := False;end;class function TIrrAllocatorBase.GetClass(  const Index: Integer): TIrrAllocatorClass;begin  Result := FClassList.Items[Index];end;class function TIrrAllocatorBase.GetClassListCount: Integer;begin  Result := FClassList.Count;end;{ TIrrAllocator<T> }class constructor TIrrAllocator<T>.Create;var  TypeDataPtr, NodeTypeDataPtr: PTypeData;  NodeTypePtr: PTypeInfo;begin  TypeInfoPtr := TypeInfo(TIrrAllocator<T>);  TypeDataSize := SizeOf(T);  NodeTypePtr := typeinfo(T);  if Assigned(NodeTypePtr) then  begin    NodeType := NodeTypePtr^.Kind;    NodeTypeDataPtr := GetTypeData(NodeTypePtr);    if Assigned(NodeTypeDataPtr) then      ManagedFieldCount := NodeTypeDataPtr^.ManagedFldCount;  end;  //proceduce init final function  NeedInit := (ManagedFieldCount > 0) or    (NodeType in      [        tkLString,        tkWString,        tkInterface,        tkDynArray,        tkUString,        tkVariant        //tkArray,        //tkRecord      ]    );  if NeedInit then    AllocatedInfo := TDictionary<Pointer, Integer>.Create;  FClassList.Add(TIrrAllocator<T>);end;class destructor TIrrAllocator<T>.Destroy;begin  AllocatedInfo.Free;end;class procedure TIrrAllocator<T>.FreeMemNode(P: Pointer;  FinalNode: TIrrAllocInit = iaiDefault);var  MemCount: Integer;begin  MemCount := 1;  if Assigned(AllocatedInfo) then  begin    if AllocatedInfo.TryGetValue(P, MemCount) then    begin      AllocatedInfo.Remove(P);    end    else    begin      MemCount := 1;    end;  end;    case FinalNode of    iaiDefault:      begin        if NeedInit then        begin          FinalizeArray(P, typeinfo(T), MemCount);        end;      end;  end;  FreeMem(P);  AllocatedCount := AllocatedCount - MemCount;end;class function TIrrAllocator<T>.GetMemNode(Count: Integer;  InitNode: TIrrAllocInit): Pointer;var  P: Pointer;  MemSize: NativeUInt;begin  MemSize := TypeDataSize * Count;  GetMem(P, MemSize);                           AllocatedCount := AllocatedCount + Count;  case InitNode of    iaiDefault:      if NeedInit then      begin        InitializeArray(P, typeinfo(T), Count);        if Count > 1 then          AllocatedInfo.Add(P, Count);                end;    iaiForce:      begin        if NeedInit then        begin          InitializeArray(P, typeinfo(T), Count);          if Count > 1 then            AllocatedInfo.Add(P, Count);        end        else        begin          FillChar(P^, MemSize, 0);        end;      end;  end;  Result := P;end;class function TIrrAllocator<T>.GetNodeCount: Integer;begin  Result := AllocatedCount;end;class function TIrrAllocator<T>.GetNodeSize: Integer;begin  Result := TypeDataSize;end; 
 

这样,对于某类数据结构就可以在程序中方便的作数量统计,内存统计.

然而,这里有个问题,对于记录类型等可以完成功能,但无法应用到对象类型.
主要原因是,对象内存分配是通过NewInstance完成的.

因此,我产生了重写NewInstance的想法.

于是,我试图构造另一个泛型类:

  TMObject = class(TObject)
  class function NewInstance: TObject; override;
  procedure FreeInstance; override;
  end;

  TIrrObjectAllocator<T: TMObject> = class(TIrrAllocatorBase)
  end;

希望,需要统计数量以及内存消耗的类型都通过从 TMObject 派生完成.
然而,当我要去重写 TMObject.NewInstance的实现时,陷入了尴尬的境地
class function TMObject.NewInstance: TObject;
begin
  Result := TIrrObjectAllocator<ClassType>.GetMemNode;
end;

这是无法通过的.原因是虽然, TObject有ClassType返回类型,但是,那是在运行期.
而不是在编译期.因此,不能编译通过也是正常的.

不知道有没有高手有好的想法.

[解决办法]
TIrrObjectAllocator<T:TMObject> = class(TIrrAllocator<T>)
...
[解决办法]
可以写Class Helper补TObject.NewInstance;

查看更多 下一篇