这两天在看一个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返回类型,但是,那是在运行期.
而不是在编译期.因此,不能编译通过也是正常的.不知道有没有高手有好的想法.
在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返回类型,但是,那是在运行期.
而不是在编译期.因此,不能编译通过也是正常的.不知道有没有高手有好的想法.
解决方案 »
- 现在用Delphi开发一个企业进销存,用哪个版本最好?
- 有个问题请教
- query1.sql.add('insert into DKH valus(select fname,fXH from users where usercode='free')');怎么不可以呀?好象问题就出在引号上了,
- 请问d6有没有赋空串,如我想再:a+b+c中的b的空串的长度动态变化,我要用那个函数!
- 请问如何制作OFFICE助手中的ACS文件
- 如何实现如下格式的报表!
- delphi中excel有关问题,高手帮帮忙
- 如何将delphi 6源程序转换成 delphi 5源程序?有办法吗?一定加分到150!
- 请教 大家一个问题
- 怎么样提取一个EXE里面的所有资源保存为res!
- sql server
- DELPHI中的combobox显示数据库表中字段的请求
...
其实是这样的.我可能需要解释下:如果有如下结构
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>统一管理
就舒服了.但是,我目前无法完成这一目标.