Title: Avoiding Repeated Allocation of Memory by using a Factory class -
Question: If a application creates and frees a large number of objects (of varying sizes) it will fragment the heap and ultimately exhaust the swap file. How do you avoid this?
Answer:
This is a cut down version of a full article that appeared in Delphi Developer.
The factory pattern is a way to define an object class that can provide objects on request without creating and subsequently freeing the object. The code with this article is a test program with the factory class code- It needs a label and button dropped on a form and an event handler hooked up to the onclick to try it out.
The factory class is constructed knowing what class of object it is to make and the maximum number of objects it must hold. These are allocated in one go - this is much more memory efficient and allows recycling and reuse of objects. The manufactured objects must inherit from a FactoryObject class as this contains a reference to the factory that made them os they can be returned to the factory. When the Manufactured object is no longer needed, just call RecycleSelf.
The objects are created by allocating all objects out of a large memory block that is allocated in one operation. Keen readers will notice that the request_obj has two sets of result statements that are commented out. Strictly when an object is created, all fields are set to zero and this is what the InitInstance call does (as well as setting up the VMT). However it is slow. The VMT is always set up when the factory is constructed so if you clear the relevant member variables in your own code then there is no need to call initinstance again.
This approach was used in a complex financial simulation that ran for over 200 hours processing 440 days of financial data. In the final version I used 11 factories and several thousand objects which were destroyed and recreated after each days processing. On a 256 Mb ram PC, the first version which created and freed objects ground to a halt after processing just 18 days. It had fragmented the heap ram and kept requesting memory from the swap file until blam- no more virtual ram. The version with factories ran non stop for 200 hours (on a pII 266 Mhz PC) with 160Mb of data in use- and at the end, the difference between ram allocated at the start and end was about 20Kb.
unit testfact;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
Const
Numints = 5000;
MaxObjs = 2000;
type
TchFactoryObject = class;
TchFactory = class
private
fdata : pointer;
fsize : integer;
fDataList : PPointerList; // from classes unit
fdatacount : integer;
fFreeList : PPointerList;
fFreeCount : integer;
fCapacity : integer;
fcLass : Tclass;
public
constructor Create(FactoryObjectClass : Tclass;Capacity : integer);
destructor Destroy; override;
function Request_Obj : TchFactoryObject;
procedure Recycle(FactoryObject : TchFactoryObject);
property Capacity : integer read fCapacity;
property CountUsed : integer read fdataCount;
property CountFree : integer read fFreeCount;
end;
TchFactoryObject = class
private
fFactory : TchFactory;
public
procedure RecycleSelf;
property Factory : TchFactory read fFactory write fFactory;
end;
TchObj= class(TchFactoryObject)
private
Avalue : array[1..NumInts] of integer;
function GetValue(Index:integer):integer;
procedure SetValue(Index,Value:integer);
public
procedure FillSelf;
property Value[Index : integer] : integer read GetValue write SetValue;
end;
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
Afactory : TchFactory;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TchObj.GetValue(Index:integer):integer;
begin
result := avalue[Index];
end;
procedure TchObj.SetValue(Index,Value:integer);
begin
avalue[index]:= Value;
end;
procedure TchObj.FillSelf;
var index:integer;
begin
for Index := 1 to Numints do
avalue[index] := random(10000);
end;
{^ TchFactory implementation}
// ------------------------------- TchFactory --------------------------------
constructor TchFactory.Create(FactoryObjectClass : tclass;Capacity : integer);
var Index : integer;
fptr : pointer;
fObj : TchFactoryObject;
begin
fClass := FactoryObjectClass;
fsize := fclass.InstanceSize;
fcapacity := Capacity;
getmem(fdata,fsize*capacity);
getmem(fDatalist,sizeof(Pointer)*capacity);
getmem(ffreelist,sizeof(Pointer)*capacity);
fdatacount :=0;
ffreecount :=0;
fptr := fdata;
for index := 0 to Capacity-1 do
begin
fdatalist[fdatacount]:= fptr;
fobj := Fclass.InitInstance(fptr) as TchFactoryObject;
fobj.factory := self;
fptr := pointer(integer(fptr)+fsize);
inc(fDataCount);
end;
end;
destructor TchFactory.Destroy;
begin
Freemem(fdata);
freemem(fdatalist);
Freemem(ffreelist);
end;
function TchFactory.Request_Obj : TchFactoryObject;
begin
if fFreecount0 then
begin
dec(fFreeCount);
Result := TchFactoryObject(ffreelist[fFreeCount]) as TchFactoryObject; // fast
//result := fClass.InitInstance(ffreelist[fFreeCount]) as TchFactoryObject;
end
else
if fDatacount=0 then
raise exception.Create('Exceeded capacity')
else
begin
dec(fdataCount);
Result := TchFactoryObject(fdatalist[fDataCount]) as TchFactoryObject; // fast
//result := fClass.InitInstance(fdatalist[fDataCount]) as TchFactoryObject;
end;
Result.Factory := self;
end;
procedure TchFactory.Recycle(FactoryObject : TchFactoryObject);
begin
if fFreeCount = fCapacity then
raise Exception.Create('Attempt to Recycle exceeds Capacity');
ffreelist[fFreeCount] := Factoryobject;
inc(ffreeCount);
end;
procedure TchFactoryObject.RecycleSelf;
begin
ffactory.Recycle(self);
end;
procedure TForm1.Button1Click(Sender: TObject);
var Objs:array[1..Maxobjs] of TchObj;
trial,Index,loop : integer;
startused,endused,MemUsed : cardinal;
begin
Startused := Getheapstatus.TotalAllocated;
Afactory := TchFactory.Create(TchObj,MaxObjs);
Memused := Getheapstatus.TotalAllocated-Startused;
for Index := 1 to MaxObjs do
Objs[Index] := Afactory.Request_obj as TchObj;
for trial := 1 to 100 do
begin
// Pick ranom object
for loop := 1 to MaxObjs do
begin
repeat
Index := random(MaxObjs)+1;
until assigned(Objs[Index]);
// Release Object
Objs[Index].Recycleself;
Objs[Index]:=nil;
end;
// Allocate Object
for Index := 1 to MaxObjs do
Objs[Index] := Afactory.Request_obj as TchObj;
end;
for loop := 1000 downto 1 do
begin
Index := random(MaxObjs)+1;
Objs[Index].FillSelf;
end;
Afactory.Free;
EndUsed := Getheapstatus.TotalAllocated;
label1.caption :='Start = '+inttostr(StartUsed)+' End= '+
inttostr(EndUsed)+' Allocated = '+inttostr(MemUsed);
end;
end.