Mega Code Archive
Garbage Collector for Delphi Applications
<![CDATA[
Title: Garbage Collector for Delphi Applications
Question: How to implement a garbage collector in Delphi?
Answer:
One of the top characteristics of C++ is that destructors are
called automatically. In Object Pascal we must call destructors
explicitlly.
Objects based on IUnknown interface, when loosing scope, calls
_Release() method automatically. The TInterfacedObject class
implements the _Release(), calling the class destructor (See
$(DELPHI)\Source\RTL\SYS\System.pas).
To implement a garbage colletor the only thing we have to do is to create
an object that instantiates our TObject derived objects for us
and, when the destructor is called, it destroys our object
automatically. I.e, an proxy object.
-----------%unit GarbageCollector;
interface
type
ISafeGuard = type IUnknown;
// Use the Guard function to instantiate the object!
function Guard(Obj : TObject; out SafeGuard : ISafeGuard) : TObject;
implementation
type
TSafeGuard = class(TInterfacedObject, ISafeGuard)
private
FObj : TObject;
public
constructor Create(Obj : TObject);
destructor Destroy; override;
end;
constructor TSafeGuard.Create(Obj : TObject);
begin
FObj := Obj;
end;
destructor TSafeGuard.Destroy;
begin
if Assigned(FObj) then
begin
FObj.Free;
FObj := nil;
end;
inherited Destroy;
end;
function Guard(Obj : TObject; out SafeGuard : ISafeGuard) : TObject;
begin
Result := Obj;
SafeGuard := TSafeGuard.Create(Obj); // Create the proxy obj.
end;
end.
-----------%
To create a new object derived from TObject, simply do this:
-----------% var obj : TMyObj;
SafeGuard : ISafeGuard;
obj := TMyObj(Guard(TMyObj.Create, SafeGuard));
-----------%
where TMyObj is a TObject decendant.
Here, an console application example:
-----------%{$APPTYPE CONSOLE}
program Test;
uses GarbageCollector;
{ --- Test class --- }
type
TTest = class(TObject)
public
constructor Create;
destructor Destroy; override;
procedure Test;
end;
{ ---- Test members --- }
constructor TTest.Create;
begin
WriteLn('Create()');
end;
destructor TTest.Destroy;
begin
WriteLn('Destroy()');
inherited;
end;
procedure TTest.Test;
begin
WriteLn('Test()');
end;
{ ---- End Of Test members --- }
{ ---- Test Procedure --- }
procedure TestProc;
var SafeGuard : ISafeGuard;
obj : TTest;
begin
obj := TTest(Guard(obj.Create, SafeGuard)); // Create!
obj.Test;
{ Notice that we are not explicitlly destroying the object here! }
end;
{ ---- End Of Test Procedure --- }
begin
TestProc;
end.
-----------%
This trick is documented on JCL (Project Jedi Component Library).
It is not my ideia, only a simplification. The original code was
designed by Jeroen Speldekamp
]]>