DelphiXE下的泛型

2012-04-27 11:48:08 417 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

三运放仪表放大器电路设计全解析：从原理到PCB布局避坑指南本文深度解析三运放仪表放大器电路设计，从差分放大器原理演进到经典三运放架构，详细阐述了其高共模抑制比(CMRR)和高输入阻抗的核心优势。文章重点剖析了电阻匹配、PCB布局对称性等关键设计要点对性能的影响，并提供了基于LTspice的仿真分析与从原理图到PCB布局、焊接调试的全流程实战避坑指南，助力实现高精度信号调理。阅读详情

这两天在看一个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返回类型,但是,那是在运行期.
而不是在编译期.因此,不能编译通过也是正常的.

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

...全文