Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
CC#17286: Garbage Collector for Delphi Objects and Components: https://cc.embarcadero.com/Item/17286
<html>
<head>
<title>Garbage Collector For Delphi Objects and Components</title>
</head>
<body>
<b>Garbage Collector For Delphi Objects and Components</b><br>
<p> </p>
<blockquote class="abstract"><b>Abstract: </b>Automatic memory management
of Delphi objects and components. By Rossen Assenov.</blockquote>
<p> </p>
<p>One of the fundamental questions in object oriented programming is how
the memory management of objects should be done. Different languages
take different approaches. C++ calls the constructor/destructor of
stack allocated objects automaticaly, but for heap allocated objects
you have to do it manually and there is no try..finally statement. In
Java you create the objects when you need them and the garabage collector
takes care of the memory cleanup, but there are no destructors, so you
can not explictly say you don't need an object anymore and there is little
control over the process of garbage collection.<br>
<br>
Delphi provides three ways of object management :<br>
<br>
1. Create/destroy the objects using try..finally.<br>
2. Use TComponent descendants - create a component and
let its owner free it.<br>
3. Interfaces - when the reference count for an interface
becomes 0 the object which implements it is destroyed.<br>
<br>
Interfaces are great for new development - start using
them ! ;) - but sometimes they can be an overhead because there are
two declarations of the same thing. Also, most of the base VCL classes
- TList, TStream, etc. - are not components or interface enabled -
so you have to create/destroy them explicitly.</p>
<h3>THE OBJECT SAFE</h3>
The Delphi help says you shouldn't mix the TComponent
owner approach with the interface memory management, but as always
the forbidden fruit is the sweetest ;). As you'll see it is really
useful to have a TComponent descendant which implements an interface
and at the same time IS reference counted so when it goes out of scope
it frees itself and all the components it owns. We'll extend it so it
keeps a list of TObjects and frees them too.<br>
<br>
Lets name the interface IObjectSafe and the reference counted
TComponent descendent which implements it - TObjectSafe.<br>
<p>Here is the source code for <i>SafeUnit.pas</i> :</p>
<pre class="sourcecode"><code><br><b>unit</b> SafeUnit;<br><br><b>interface</b><br><br><b>uses</b> Classes;<br><br><b>type</b> IObjectSafe = <b>interface</b><br> <b>function</b> Safe : TComponent;<br><br> <b>function</b> New (<b>out</b> aReference <font color="#003399"><i>{: Pointer}</i></font>;<br> <b>const</b> aObject : TObject) : IObjectSafe;<br><br> <b>procedure</b> Guard (<b>const</b> aObject : TObject);<br><br> <b>procedure</b> Dispose (<b>var</b> aReference <font color="#003399"><i>{: Pointer}</i></font>);<br> <b>end</b>;<br><br> IExceptionSafe = <b>interface</b><br> <b>procedure</b> SaveException;<br> <b>end</b>;<br><br><b>function</b> ObjectSafe : IObjectSafe; overload;<br><b>function</b> ObjectSafe (<b>out</b> aObjectSafe : IObjectSafe) : IObjectSafe; overload;<br><b>function</b> ExceptionSafe : IExceptionSafe;<br><br><b>function</b> IsAs (<b>out</b> aReference <font color="#003399"><i>{: Pointer}</i></font>;<br> <b>const</b> aObject : TObject;<br> <b>const</b> aClass : TClass) : Boolean;<br><br><b>implementation</b><br><br><b>uses</b> Windows, SysUtils;<br><br><b>type</b> TExceptionSafe = <b>class</b> (TInterfacedObject, IExceptionSafe)<br> <b>private</b><br> FMessages : <b>String</b>;<br> <b>public</b><br> <b>destructor</b> Destroy; override;<br><br> <b>procedure</b> SaveException;<br> <b>end</b>;<br><br> TInterfacedComponent = <b>class</b> (TComponent)<br> <b>private</b><br> FRefCount : Integer;<br> <b>protected</b><br> <b>function</b> _AddRef : Integer; <b>stdcall</b>;<br> <b>function</b> _Release : Integer; <b>stdcall</b>;<br> <b>public</b><br> <b>procedure</b> BeforeDestruction; override;<br> <b>end</b>;<br><br> TAddObjectMethod = <b>procedure</b> (<b>const</b> aObject : TObject) <b>of</b> <b>object</b>;<br><br> TObjectSafe = <b>class</b> (TInterfacedComponent, IObjectSafe)<br> <b>private</b><br> FObjects : <b>array</b> <b>of</b> TObject;<br> FEmptySlots : <b>array</b> <b>of</b> Integer;<br> AddObject : TAddObjectMethod;<br><br> <b>procedure</b> AddObjectAtEndOfList (<b>const</b> aObject : TObject);<br> <b>procedure</b> AddObjectInEmptySlot (<b>const</b> aObject : TObject);<br><br> <b>procedure</b> RemoveObject (<b>const</b> aObject : TObject);<br> <b>public</b><br> <b>constructor</b> Create (aOwner : TComponent); override;<br> <b>destructor</b> Destroy; override;<br><br> <b>function</b> Safe : TComponent;<br> <b>function</b> New (<b>out</b> aReference;<br> <b>const</b> aObject : TObject) : IObjectSafe;<br> <b>procedure</b> Guard (<b>const</b> aObject : TObject);<br> <b>procedure</b> Dispose (<b>var</b> aReference) ;<br> <b>end</b>;<br><br><b>function</b> TInterfacedComponent._AddRef : Integer;<br><b>begin</b><br> Result := InterlockedIncrement (FRefCount);<br><b>end</b>;<br><br><b>function</b> TInterfacedComponent._Release : Integer;<br><b>begin</b><br> Result := InterlockedDecrement (FRefCount);<br><br> <b>if</b> Result = 0<br> <b>then</b> Destroy;<br><b>end</b>;<br><br><b>procedure</b> TInterfacedComponent.BeforeDestruction;<br><b>begin</b><br> <b>if</b> FRefCount &lt;&gt; 0<br> <b>then</b> <b>raise</b> Exception.Create (ClassName + <font color="#9933cc">' not freed correctly'</font>);<br><b>end</b>;<br><br><font color="#003399"><i>{ TObjectSafe }</i></font><br><br><b>constructor</b> TObjectSafe.Create (aOwner : TComponent);<br><b>begin</b><br> <b>inherited</b> Create (aOwner);<br><br> AddObject := AddObjectAtEndOfList;<br><b>end</b>;<br><br><b>destructor</b> TObjectSafe.Destroy;<br> <b>var</b> aIndex : Integer;<br> aComponent : TComponent;<br><b>begin</b><br> <b>with</b> ExceptionSafe <b>do</b><br> <b>begin</b><br> <b>for</b> aIndex := High (FObjects) <b>downto</b> Low (FObjects) <b>do</b><br> <b>try</b><br> FObjects [aIndex].Free;<br> <b>except</b><br> SaveException;<br> <b>end</b>;<br><br> <b>for</b> aIndex := Pred (ComponentCount) <b>downto</b> 0 <b>do</b><br> <b>try</b><br> aComponent := Components [aIndex];<br> <b>try</b><br> RemoveComponent (aComponent);<br> <b>finally</b><br> aComponent.Free;<br> <b>end</b>;<br> <b>except</b><br> SaveException;<br> <b>end</b>;<br><br> <b>try</b><br> <b>inherited</b> Destroy;<br> <b>except</b><br> SaveException;<br> <b>end</b>;<br> <b>end</b>;<br><b>end</b>;<br><br><b>function</b> TObjectSafe.Safe : TComponent;<br><b>begin</b><br> Result := Self;<br><b>end</b>;<br><br><b>procedure</b> TObjectSafe.AddObjectAtEndOfList (<b>const</b> aObject : TObject);<br><b>begin</b><br> SetLength (FObjects, Succ (Length (FObjects)));<br> FObjects [High (FObjects)] := aObject;<br><b>end</b>;<br><br><b>procedure</b> TObjectSafe.AddObjectInEmptySlot (<b>const</b> aObject : TObject);<br><b>begin</b><br> FObjects [FEmptySlots [High (FEmptySlots)]] := aObject;<br> SetLength (FEmptySlots, High (FEmptySlots));<br><br> <b>if</b> Length (FEmptySlots) = 0<br> <b>then</b> AddObject := AddObjectAtEndOfList;<br><b>end</b>;<br><br><b>procedure</b> TObjectSafe.RemoveObject (<b>const</b> aObject : TObject);<br> <b>var</b> aIndex : Integer;<br><b>begin</b><br> <b>for</b> aIndex := High (FObjects) <b>downto</b> Low (FObjects) <b>do</b><br> <b>begin</b><br> <b>if</b> FObjects [aIndex] = aObject <b>then</b><br> <b>begin</b><br> FObjects [aIndex] := <b>Nil</b>;<br><br> SetLength (FEmptySlots, Succ (Length (FEmptySlots)));<br> FEmptySlots [High (FEmptySlots)] := aIndex;<br> AddObject := AddObjectInEmptySlot;<br> <br> Exit;<br> <b>end</b>;<br> <b>end</b>;<br><b>end</b>;<br><br><b>procedure</b> TObjectSafe.Dispose (<b>var</b> aReference);<br><b>begin</b><br> <b>try</b><br> <b>try</b><br> <b>if</b> TObject (aReference) <b>is</b> TComponent<br> <b>then</b> RemoveComponent (TComponent (TObject (aReference)))<br> <b>else</b> RemoveObject (TObject (aReference));<br> <b>finally</b><br> TObject (aReference).Free;<br> <b>end</b>;<br> <b>finally</b><br> TObject (aReference) := <b>Nil</b>;<br> <b>end</b>;<br><b>end</b>;<br><br><b>procedure</b> TObjectSafe.Guard (<b>const</b> aObject : TObject);<br><b>begin</b><br> <b>try</b><br> <b>if</b> aObject <b>is</b> TComponent <b>then</b><br> <b>begin</b><br> <b>if</b> TComponent (aObject).Owner &lt;&gt; Self<br> <b>then</b> InsertComponent (TComponent (aObject));<br> <b>end</b><br> <b>else</b> AddObject (aObject);<br> <b>except</b><br> aObject.Free;<br><br> <b>raise</b>;<br> <b>end</b>;<br><b>end</b>;<br><br><b>function</b> TObjectSafe.New (<b>out</b> aReference; <b>const</b> aObject : TObject) : IObjectSafe;<br><b>begin</b><br> <b>try</b><br> Guard (aObject);<br><br> TObject (aReference) := aObject;<br> <b>except</b><br> TObject (aReference) := <b>Nil</b>;<br><br> <b>raise</b>;<br> <b>end</b>;<br><br> Result := Self;<br><b>end</b>;<br><br><font color="#003399"><i>{ TExceptionSafe }</i></font><br><br><b>destructor</b> TExceptionSafe.Destroy;<br><b>begin</b><br> <b>try</b><br> <b>if</b> Length (FMessages) &gt; 0<br> <b>then</b> <b>raise</b> Exception.Create (FMessages);<br> <b>finally</b><br> <b>try</b> <b>inherited</b> Destroy; <b>except</b> <b>end</b>;<br> <b>end</b>;<br><b>end</b>;<br><br><b>procedure</b> TExceptionSafe.SaveException;<br><b>begin</b><br> <b>try</b><br> <b>if</b> (ExceptObject &lt;&gt; <b>Nil</b>) <b>and</b> (ExceptObject <b>is</b> Exception)<br> <b>then</b> FMessages := FMessages + Exception (ExceptObject).Message + #13#10;<br> <b>except</b><br> <b>end</b>; <br><b>end</b>;<br><br><b>function</b> ExceptionSafe : IExceptionSafe;<br><b>begin</b><br> Result := TExceptionSafe.Create;<br><b>end</b>;<br><br><b>function</b> ObjectSafe : IObjectSafe;<br><b>begin</b><br> Result := TObjectSafe.Create (<b>Nil</b>);<br><b>end</b>;<br><br><b>function</b> ObjectSafe (<b>out</b> aObjectSafe : IObjectSafe) : IObjectSafe; overload;<br><b>begin</b><br> Result := ObjectSafe;<br><br> aObjectSafe := Result;<br><b>end</b>;<br><br><b>function</b> IsAs (<b>out</b> aReference <font color="#003399"><i>{: Pointer}</i></font>;<br> <b>const</b> aObject : TObject;<br> <b>const</b> aClass : TClass) : Boolean;<br><b>begin</b><br> Result := (aObject &lt;&gt; <b>Nil</b>) <b>and</b> (aObject <b>is</b> aClass);<br><br> <b>if</b> Result<br> <b>then</b> TObject (aReference) := aObject;<br><b>end</b>;<br><br><b>end</b>.<br><br></code></pre>
<p>How do you use a safe ? It's pretty simple :<br>
</p>
<pre class="sourcecode"><code><br><b>procedure</b> TestTheSafe;<br><br> <b>var</b> aMyObject : TMyObject;<br> aMyComponent : TMyComponent;<br><br><b>begin</b><br> <b>with</b> ObjectSafe <b>do</b><br> <b>begin</b><br> New (aMyObject, TMyObject.Create);<br><br> <font color="#003399"><i>// or</i></font><br> <font color="#003399"><i>// aMyObject := TMyObject.Create; Guard (aMyObject);</i></font><br> <br> aMyComponent := TMyComponent.Create (Safe);<br> <b>end</b>;<br><b>end</b>;<br><br></code></pre>
<p>Notice the use of the 'with' statement - you can use a safe without
having to declare a local variable for it. When you create a component just
pass the 'safe' component as the owner to the constructor.&nbsp; When the
execution of the code reaches the 'end' of the 'with' statement the reference
count of IObjectSafe will hit 0, the destructor of TObjectSafe will be called
and all the components and objects it owns will be freed. So now you have
the best of both worlds - you can create an object when you need it, be sure
it will be automaticaly destroyed and know exactly when it will happen.<br>
<br>
The 'New'/'Dispose' methods of IObjectSafe use the 'untyped'
pointer type to return a reference to an object - this will cause
exception if you mismatch the types of the reference and the actual
object created (there won't be a memory leak though), but it is flexible
and shorter to type. If you want to play it safe use the 'Guard' function
instead.<br>
<br>
You can also create one IObjectSafe in the constructor
of a complex object which uses a lot of internal objects so you don't
need to explicitly free them&nbsp; in the destructor.<br>
<br>
Take a look at the implementation of the AddObject 'procedure'
inside TObjectSafe. This is a method pointer technique you can use
when you need to do one operation most of the time - add an object
at the end of the array - and some other operation rarely - put an object
into an empty slot - and you don't want to check each time which one
of them to perform.<br>
</p>
<h3>THE EXCEPTION SAFE</h3>
<p>Another useful safe used in the implementation of TObjectSafe is IExceptionSafe.
Many times you need to perform an action over many objects but sometimes
you can get an exception. The usual practice is to write something
like :</p>
<pre class="sourcecode"><code><br><b>for</b> aIndex := 1 <b>to</b> 10 <b>do</b><br><b>try</b><br> <font color="#003399"><i>// do something which might raise an exception</i></font><br><b>except</b><br><b>end</b>;<br><br></code></pre>
<p>and ignore the exceptions, but it's better to remember the exception
messages and show them later.<br>
<br>
That's what IExceptionSafe is used for. It has only one procedure
'SaveException' without parameters - it uses the system function 'ExceptObject'
to get a pointer to the current exception. Create a new ExceptionSafe
interface at the start of the block where you want to remember the exceptions
and when the execution reaches the end of the 'with' statement the destructor
of TExcetionSafe checks if there were any exceptions remembered and raises
a new exception with all of the exception messages :<br>
</p>
<pre class="sourcecode"><code><br><b>with</b> ExceptionSafe <b>do</b><br><b>try</b><br> <b>for</b> aIndex := 1 <b>to</b> 10 <b>do</b><br> <b>try</b><br> <font color="#330099"><i>// do something which might raise an exception</i></font><br> <b>except</b><br> SaveException; <br> <b>end</b>;<br><br> <b>for</b> aIndex := 10 <b>to</b> 20 <b>do<br> try</b><br> </code><code><font color="#330099"><i>// do something which might raise an exception</i></font></code><br><code> <b>except</b><br> SaveException; <br> <b>end</b>;<br><br> </code><code><font color="#330099"><i>// do something which might raise an exception</i></font></code><br><code><b>except</b><br> SaveException;<br><b>end</b>;<br><br></code></pre>
<h3>THE 'IsAs' OPERATOR</h3>
<p>Often you need to check the type of some object and typecast it to a
reference using the 'is' and 'as' operators, like this :</p>
<pre class="sourcecode"><code><br><b>if</b> aSomeObject <b>is</b> TMyObject <b>then</b><br><b>begin</b><br> aMyObject := aSomeObject <b>as</b> TMyObject;<br><br> <font color="#330099"><i>// do something with aMyObject</i></font><br><b>end</b>;<br><br></code></pre>
<p>With the 'IsAs' function you can accomplish all this in just one line
: </p>
<pre class="sourcecode"><code><br><b>if</b> IsAs (aMyObject, aSomeObject, TMyObject) <b>then<br>begin</b><br> <font color="#330099"><i>// do something with aMyObject</i></font><br><b>end</b>;<br><br></code></pre>
<p>As you can see 'untyped' pointer types can be quite handy.</p>
<h3>CONCLUSION</h3>
<p>By using the presented techniques you can greatly simplify the memory
management of Delphi objects/components and make your programs safer.<br>
Suggestions and comments are welcomed -- just <a href="mailto:rossen_assenov@yahoo.com">
write me</a>!<br>
The source code is available at <a href="http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=17286">
CodeCentral</a><br>
</p>
</body>
</html>
// Viewing SafeUit.pas from CC#17286: Garbage Collector for Delphi Objects and Components
unit SafeUnit;
interface
uses Classes;
type IObjectSafe = interface
function Safe : TComponent;
function New (out aReference {: Pointer};
const aObject : TObject) : IObjectSafe;
procedure Guard (const aObject : TObject);
procedure Dispose (var aReference {: Pointer});
end;
IExceptionSafe = interface
procedure SaveException;
end;
function ObjectSafe : IObjectSafe; overload;
function ObjectSafe (out aObjectSafe : IObjectSafe) : IObjectSafe; overload;
function ExceptionSafe : IExceptionSafe;
function IsAs (out aReference {: Pointer};
const aObject : TObject;
const aClass : TClass) : Boolean;
implementation
uses Windows, SysUtils;
type TExceptionSafe = class (TInterfacedObject, IExceptionSafe)
private
FMessages : String;
public
destructor Destroy; override;
procedure SaveException;
end;
TInterfacedComponent = class (TComponent)
private
FRefCount : Integer;
protected
function _AddRef : Integer; stdcall;
function _Release : Integer; stdcall;
public
procedure BeforeDestruction; override;
end;
TAddObjectMethod = procedure (const aObject : TObject) of object;
TObjectSafe = class (TInterfacedComponent, IObjectSafe)
private
FObjects : array of TObject;
FEmptySlots : array of Integer;
AddObject : TAddObjectMethod;
procedure AddObjectAtEndOfList (const aObject : TObject);
procedure AddObjectInEmptySlot (const aObject : TObject);
procedure RemoveObject (const aObject : TObject);
public
constructor Create (aOwner : TComponent); override;
destructor Destroy; override;
function Safe : TComponent;
function New (out aReference;
const aObject : TObject) : IObjectSafe;
procedure Guard (const aObject : TObject);
procedure Dispose (var aReference) ;
end;
function TInterfacedComponent._AddRef : Integer;
begin
Result := InterlockedIncrement (FRefCount);
end;
function TInterfacedComponent._Release : Integer;
begin
Result := InterlockedDecrement (FRefCount);
if Result = 0
then Destroy;
end;
procedure TInterfacedComponent.BeforeDestruction;
begin
if FRefCount <> 0
then raise Exception.Create (ClassName + ' not freed correctly');
end;
{ TObjectSafe }
constructor TObjectSafe.Create (aOwner : TComponent);
begin
inherited Create (aOwner);
AddObject := AddObjectAtEndOfList;
end;
destructor TObjectSafe.Destroy;
var aIndex : Integer;
aComponent : TComponent;
begin
with ExceptionSafe do
begin
for aIndex := High (FObjects) downto Low (FObjects) do
try
FObjects [aIndex].Free;
except
SaveException;
end;
for aIndex := Pred (ComponentCount) downto 0 do
try
aComponent := Components [aIndex];
try
RemoveComponent (aComponent);
finally
aComponent.Free;
end;
except
SaveException;
end;
try
inherited Destroy;
except
SaveException;
end;
end;
end;
function TObjectSafe.Safe : TComponent;
begin
Result := Self;
end;
procedure TObjectSafe.AddObjectAtEndOfList (const aObject : TObject);
begin
SetLength (FObjects, Succ (Length (FObjects)));
FObjects [High (FObjects)] := aObject;
end;
procedure TObjectSafe.AddObjectInEmptySlot (const aObject : TObject);
begin
FObjects [FEmptySlots [High (FEmptySlots)]] := aObject;
SetLength (FEmptySlots, High (FEmptySlots));
if Length (FEmptySlots) = 0
then AddObject := AddObjectAtEndOfList;
end;
procedure TObjectSafe.RemoveObject (const aObject : TObject);
var aIndex : Integer;
begin
for aIndex := High (FObjects) downto Low (FObjects) do
begin
if FObjects [aIndex] = aObject then
begin
FObjects [aIndex] := Nil;
SetLength (FEmptySlots, Succ (Length (FEmptySlots)));
FEmptySlots [High (FEmptySlots)] := aIndex;
AddObject := AddObjectInEmptySlot;
Exit;
end;
end;
end;
procedure TObjectSafe.Dispose (var aReference);
begin
try
try
if TObject (aReference) is TComponent
then RemoveComponent (TComponent (TObject (aReference)))
else RemoveObject (TObject (aReference));
finally
TObject (aReference).Free;
end;
finally
TObject (aReference) := Nil;
end;
end;
procedure TObjectSafe.Guard (const aObject : TObject);
begin
try
if aObject is TComponent then
begin
if TComponent (aObject).Owner <> Self
then InsertComponent (TComponent (aObject));
end
else AddObject (aObject);
except
aObject.Free;
raise;
end;
end;
function TObjectSafe.New (out aReference; const aObject : TObject) : IObjectSafe;
begin
try
Guard (aObject);
TObject (aReference) := aObject;
except
TObject (aReference) := Nil;
raise;
end;
Result := Self;
end;
{ TExceptionSafe }
destructor TExceptionSafe.Destroy;
begin
try
if Length (FMessages) > 0
then raise Exception.Create (FMessages);
finally
try inherited Destroy; except end;
end;
end;
procedure TExceptionSafe.SaveException;
begin
try
if (ExceptObject <> Nil) and (ExceptObject is Exception)
then FMessages := FMessages + Exception (ExceptObject).Message + #13#10;
except
end;
end;
function ExceptionSafe : IExceptionSafe;
begin
Result := TExceptionSafe.Create;
end;
function ObjectSafe : IObjectSafe;
begin
Result := TObjectSafe.Create (Nil);
end;
function ObjectSafe (out aObjectSafe : IObjectSafe) : IObjectSafe; overload;
begin
Result := ObjectSafe;
aObjectSafe := Result;
end;
function IsAs (out aReference {: Pointer};
const aObject : TObject;
const aClass : TClass) : Boolean;
begin
Result := (aObject <> Nil) and (aObject is aClass);
if Result
then TObject (aReference) := aObject;
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment