DelphiXE下的泛型

[zwjchina]

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

  //! 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>)
...

[zwjchina]

楼上没理解我的意图,顺便多问一句,你是在O吧?

[日立奔腾浪潮微软松下联想]

可以写Class Helper补TObject.NewInstance;

[zwjchina]

有高人来,太好了.
其实是这样的.我可能需要解释下:

如果有如下结构
TVector = record
x,y,z: Integer;
end;

TMesh = record
...
end;

使用的时候:
VectorPtr := TIrrAllocator<TVector>.GetMemNode(10);
MeshPtr := TIrrAllocator<TMesh>.GetMemNode(12);

...
//则,在程序运行期间,可以很方便的统计,观察 TVector 和 TMesh的数量.

那么,对于对象类型,如果也能使用这种方法就好了.因此,
我想,如果有
TIrrAllocator<TSomeClass>.GetMemNode(10);就好了.
但是,这里比较麻烦的是,无法给Class分配内存.

更完美的情况是,调用TSomeClass.Create()也能进入到
TIrrAllocator<TSomeClass>.GetMemNode(10),由TIrrAllocator<TSomeClass>统一管理
就舒服了.

但是,我目前无法完成这一目标.

[日立奔腾浪潮微软松下联想]

那你就写个TObject.Create的Class Helper，在其中调用你的统计过程。