Garbage Collector For Delphi Objects and Components

Abstract: Automatic memory management of Delphi objects and components. By Rossen Assenov.

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.

Delphi provides three ways of object management :

1. Create/destroy the objects using try..finally.
2. Use TComponent descendants - create a component and let its owner free it.
3. Interfaces - when the reference count for an interface becomes 0 the object which implements it is destroyed.

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.

THE OBJECT SAFE

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.

Lets name the interface IObjectSafe and the reference counted TComponent descendent which implements it - TObjectSafe.

Here is the source code for SafeUnit.pas :


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.

How do you use a safe ? It's pretty simple :


procedure TestTheSafe;

 var aMyObject    : TMyObject;
     aMyComponent : TMyComponent;

begin
 with ObjectSafe do
 begin
  New (aMyObject, TMyObject.Create);

  // or
  // aMyObject := TMyObject.Create; Guard (aMyObject);
 
  aMyComponent := TMyComponent.Create (Safe);
 end;
end;

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.  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.

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.

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  in the destructor.

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.

THE EXCEPTION SAFE

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 :


for aIndex := 1 to 10 do
try
 // do something which might raise an exception
except
end;

and ignore the exceptions, but it's better to remember the exception messages and show them later.

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 :


with ExceptionSafe do
try
 for aIndex := 1 to 10 do
 try
  // do something which might raise an exception
 except
  SaveException; 
 end;

 for aIndex := 10 to 20 do
 try
  // do something which might raise an exception
 except
  SaveException; 
 end;

 // do something which might raise an exception
except
 SaveException;
end;

THE 'IsAs' OPERATOR

Often you need to check the type of some object and typecast it to a reference using the 'is' and 'as' operators, like this :


if aSomeObject is TMyObject then
begin
 aMyObject := aSomeObject as TMyObject;

 // do something with aMyObject
end;

With the 'IsAs' function you can accomplish all this in just one line : 


if IsAs (aMyObject, aSomeObject, TMyObject) then
begin
 // do something with aMyObject
end;

As you can see 'untyped' pointer types can be quite handy.

CONCLUSION

By using the presented techniques you can greatly simplify the memory management of Delphi objects/components and make your programs safer.
Suggestions and comments are welcomed -- just write me!
The source code is available at CodeCentral