Objetos com contagem de referência

Imagine um data module, que por motivo de economia de memória é criado e destruído com a aplicação em execução. Imagine este data module sendo referenciado por mais de um formulário ao mesmo tempo. Como garantir que o data module será destruído apenas quando nenhum formulário estiver apontando para ele?

Este é o objetivo da contagem de referência. Um membro da classe guarda a quantidade de objetos que apontam para ele. Logo que esta contagem cai para zero, significa que o objeto pode ser destruído. A estrutura da classe base fica assim:

TRefCountObject = class(TObject)
private
  FRefCount: Integer;
public
  function AddRef;
  class function NewInstance: TObject; override;
  function Release;
end;

e as respectivas implementações:

function TRefCountObject.AddRef;
begin
  Result := InterlockedIncrement(FRefCount);
end;

class function TRefCountObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TRefCountObject(Result).FRefCount := 1;
end;

function TRefCountObject.Release;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Free;
end;

Como isto funciona? Quando o programador cria uma instância, o FRefCount é setado para 1. Não importa como ele chama o construtor, ou se ele sobrecarrega algum método e não chama inherited, o FRefCount sempre começa em 1. Cada nova referência, indicada através da chamada ao método AddRef, aumenta o contador de referências do objeto. Cada um que liberar aquele objeto chama o método Release. O último que liberar o objeto, fará com que ele se auto destrua.

Na implementação acima, as rotinas Interlocked trabalham de forma segura em ambiente multi thread, ao contrário do inc e dec tradicionais. Elas estão declaradas na unit Windows no Delphi, e na unit System no FPC. O método NewInstance intercepta o momento exato em que a instância é criada, e neste momento seta o valor do contador de referência.

Agora a primeira limitação desta implementação: programadores habituados com o controle do tempo de vida do objeto no Object Pascal tradicional vão precisar alterar todas as suas chamadas a .Destroy e a .Free para que a rotina funcione corretamente. E mesmo depois de alterar, precisarão habituar-se com esta nova filosofia, o que pode gerar códigos mais sujeitos a erros. O culpado é o destructor que, independente de ser virtual, uma vez chamado fará com que a instância seja destruída.

Por sorte, assim como existe um método virtual que é responsável por criar a instância, existe também outro que é responsável por destrui-la. Sobrecarregar este método e tratá-lo da mesma forma que o release, fará com que o .Free não destrua o objeto antes da hora. Veja a nova declaração da classe:

TRefCountObject = class(TObject)
private
  FRefCount: Integer;
  function Release;
public
  function AddRef;
  function FreeInstance; override;
  class function NewInstance: TObject; override;
end;

e a implementação. Note que o Release tem que ser reescrito para entrar no jogo do novo FreeInstance:

function TRefCountObject.Release;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result < 0 then
    raise Exception.Create('Não é possível liberar a instância');
end;

function TRefCountObject.FreeInstance;
begin
  if Release = 0 then
    inherited;
end;

Os demais métodos continuam idênticos, e o Release passa a ser um coadjuvante. Ele até poderia ser usado para liberar contagem de referência, mas não é capaz de destruir uma instância a fim de evitar repetição de código. Por este motivo ele foi movido para a área private e passa a ser usado apenas internamente.

Este novo modelo está quase perfeito. Ao criar o objeto sua contagem é um. Ao chamar AddRef a contagem salta para dois. Ao chamar Destroy ou Free a contagem de referências cai para 1 e o inherited FreeInstance não é chamado, o que mantém o objeto na memória. Na segunda chamada ao Free, o objeto é liberado pois ninguém mais aponta para ele (FRefCount igual a zero).

A falha deste modelo é, ao meu ver, uma limitação do modelo de objeto do Object Pascal. O TObject foi desenhado pensando em um modelo aonde o tempo de vida de um objeto é determinado fora da instância. Ou seja, uma instância A que faz referência a uma instância B é a responsável por destruí-la, enquanto um modelo com um certo grau de coerência deveria deixar esta decisão para a própria instância B, e a instância A deveria limitar-se a avisar B que tem menos gente apontando para ela.

A parte do controle do tempo de vida do objeto já está resolvido, FreeInstance foi sobrecarregado e .Free vai meramente decrementar a contagem de referência quando esta for maior do que 1. No entanto o destructor padrão do TObject, o método Destroy, é virtual e é a opção lógica para ser sobrecarregado quando uma determinada ação é necessária durante a destruição do objeto. O problema do nosso novo modelo é que FreeInstance é chamado depois do Destroy, e qualquer rotina escrita em um Destroy sobrecarregado será chamado mesmo que a instância não seja destruída.

A forma de resolver este problema é 'matar' o destructor virtual e impedir que o programador pendure código nele, e por outro lado, criar outro método virtual que é chamado a fim de notificar a destruição real do objeto. A declaração da classe fica assim:

TRefCountObject = class(TObject)
private
  FRefCount: Integer;
  function Release;
protected
  procedure Finit; virtual;
public
  destructor Destroy; reintroduce;
  function AddRef;
  function FreeInstance; override;
  class function NewInstance: TObject; override;
end;

e o que muda na declaração da classe:

destructor TRefCountObject.Destroy;
begin
end;

function TRefCountObject.Finit;
begin
end;

function TRefCountObject.FreeInstance;
begin
  if Release = 0 then
    try
      Finit;
    finally
      inherited;
    end;
end;

Agora a classe está pronta para criar instâncias que entendam contagem de referência sem perder a tradicional interface Create/Destroy/Free do Object Pascal.

Segue abaixo a declaração completa da classe, após todas as alterações:

TRefCountObject = class(TObject)
private
  FRefCount: Integer;
  function Release;
protected
  procedure Finit; virtual;
public
  destructor Destroy; reintroduce;
  function AddRef;
  function FreeInstance; override;
  class function NewInstance: TObject; override;
end;

...

function TRefCountObject.AddRef;
begin
  Result := InterlockedIncrement(FRefCount);
end;

destructor TRefCountObject.Destroy;
begin
end;

function TRefCountObject.Finit;
begin
end;

function TRefCountObject.FreeInstance;
begin
  if Release = 0 then
    try
      Finit;
    finally
      inherited;
    end;
end;

class function TRefCountObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TRefCountObject(Result).FRefCount := 1;
end;

function TRefCountObject.Release;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result < 0 then
    raise Exception.Create('Não é possível liberar a instância');
end;

11 thoughts on “Objetos com contagem de referência”

  1. Não. Você não pode chamar .Free de um decendente de TInterfacedObject. A proposta é trabalhar com contagem de referência sem alterar a usabilidade do gerenciamento de memória do TObject.

  2. Se eu entendi bem, o que vc propõe é o que o XmlDocument faz: quando usado como componente, não usa o mecanismo de reference counting, mas quando usado através da interface IXmlDocument, usa reference counting. É isso?

    Eu uso um híbrido de OO/RAD nos meus aplicativos antigos: Criei um datamodule cujo nome é o nome da classe (ex.: Cliente). O datamodule contém um clientdataset que faz o acesso aos dados no DB. Ao mesmo tempo, o DM implementa uma interface (digamos, ICliente) e para que ele trabalhe com reference counting eu implementei algo parecido. Assim, eu posso fazer:

    var
    Cliente: ICliente;
    begin
    Cliente := ClienteFactory.CriarCliente;
    Cliente.ConsultarPeloCodigo(‘0001’);
    ShowMessage(Cliente.Nome)
    end;

    Mas quando usado como componente eu tenho que destruí-lo manualmente:

    var
    Cliente: TCliente;
    begin
    Cliente := TCliente.Create(nil, Connection)
    try
    Cliente.ConsultarPeloCodigo(‘0001’);
    ShowMessage(Cliente.Nome);
    finally
    Cliente.Free;
    end;
    end;

    Assim, eu mantenho o comportamento padrão de um datamodule (sem ref. Counting) e ao mesmo tempo, quando desejado, posso usar o Ref. Counting.

    Um abraço. Legal o seu blog.

    🙂

  3. Não exatamente. Da forma que você propôs eu tenho que usar interfaces para ter contagem de referência. Isto TInterfacedObject já faz. A minha proposta é você usar contagem de referência com objetos, e continuar gerenciando a memória da mesma forma de sempre (com .Free)

    Então posso ter código desta forma:

    begin
    VCliente := TCliente.Create;
    try
    GuardaCliente(VCliente);
    finally
    VCliente.Free;
    end;
    end;

    procedure GuardaCliente(const ACliente: TCliente);
    begin
    FCliente := ACliente;
    FCliente.AddRef;
    end;

    E depois da chamada a VCliente.Free, o objeto continuará na memória para atender o ponteiro FCliente.

  4. Olá João,

    Posso estar errado, mas, não seria assim:


    type
    TRefCountObject = class(TObject)
    private
    FRefCount: Integer;
    function Release: Integer; stdcall;
    protected
    procedure Finit; virtual;
    public
    destructor Destroy; reintroduce;
    function AddRef: Integer; stdcall;
    procedure FreeInstance; override;
    class function NewInstance: TObject; override;
    end;

    implementation

    function TRefCountObject.AddRef;
    begin
    Result := InterlockedIncrement(FRefCount);
    end;

    destructor TRefCountObject.Destroy;
    begin
    end;

    procedure TRefCountObject.Finit;
    begin
    end;

    procedure TRefCountObject.FreeInstance;
    begin
    if Release = 0 then
    try
    Finit;
    finally
    inherited;
    end;
    end;

    class function TRefCountObject.NewInstance: TObject;
    begin
    Result := inherited NewInstance;
    TRefCountObject(Result).FRefCount := 1;
    end;

    function TRefCountObject.Release;
    begin
    Result := InterlockedDecrement(FRefCount);
    if Result < 0 then
    raise Exception.Create(‘Não é possível liberar a instância’);
    end;

    Só assim consegui fazer:


    TCliente = class(TRefCountObject)

    end;

    procedure GuardaCliente(const ACliente: TCliente);
    begin
    FCliente := ACliente;
    FCliente.AddRef;
    end;

    Um grande abraço,
    Silvio Clécio

  5. Olá Silvio, qual a diferença (além do stdcall) e qual o problema que impediu você de compilar e usar o seu código?

  6. Olá João,

    Veja o source de um teste simples:


    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs;

    type
    TForm1 = class(TForm)
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    TRefCountObject = class(TObject)
    private
    FRefCount: Integer;
    function Release;
    protected
    procedure Finit; virtual;
    public
    destructor Destroy; reintroduce;
    function AddRef;
    function FreeInstance; override;
    class function NewInstance: TObject; override;
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    function TRefCountObject.AddRef;
    begin
    Result := InterlockedIncrement(FRefCount);
    end;

    destructor TRefCountObject.Destroy;
    begin
    end;

    function TRefCountObject.Finit;
    begin
    end;

    function TRefCountObject.FreeInstance;
    begin
    if Release = 0 then
    try
    Finit;
    finally
    inherited;
    end;
    end;

    class function TRefCountObject.NewInstance: TObject;
    begin
    Result := inherited NewInstance;
    TRefCountObject(Result).FRefCount := 1;
    end;

    function TRefCountObject.Release;
    begin
    Result := InterlockedDecrement(FRefCount);
    if Result < 0 then
    raise Exception.Create(‘Não é possível liberar a instância’);
    end;

    end.

    Primeiro o compilador esbarra na linha “function Release;”, troco por “function Release: Integer; stdcall;” e passa, depois em “function AddRef;”, troco por “function AddRef: Integer; stdcall;” e passa, depois em “function FreeInstance;”, troco por “procedure FreeInstance; override;” e passa.

    Note que teve houve umas mudanças, de function para procedure, e outras coisas (ex: “: Integer; stdcall”).

    Eu uso Delphi7, será que estou fazendo algo errado?

    Depois que deixei assim não deu mais erros:

    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs;

    type
    TForm1 = class(TForm)
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    TRefCountObject = class(TObject)
    private
    FRefCount: Integer;
    function Release: Integer; stdcall;
    protected
    procedure Finit; virtual;
    public
    destructor Destroy; reintroduce;
    function AddRef: Integer; stdcall;
    procedure FreeInstance; override;
    class function NewInstance: TObject; override;
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    function TRefCountObject.AddRef;
    begin
    Result := InterlockedIncrement(FRefCount);
    end;

    destructor TRefCountObject.Destroy;
    begin
    end;

    procedure TRefCountObject.Finit;
    begin
    end;

    procedure TRefCountObject.FreeInstance;
    begin
    if Release = 0 then
    try
    Finit;
    finally
    inherited;
    end;
    end;

    class function TRefCountObject.NewInstance: TObject;
    begin
    Result := inherited NewInstance;
    TRefCountObject(Result).FRefCount := 1;
    end;

    function TRefCountObject.Release;
    begin
    Result := InterlockedDecrement(FRefCount);
    if Result < 0 then
    raise Exception.Create(‘Não é possível liberar a instância’);
    end;

    end.

    P.S.: João, tem como notificar quando os comentários forem respondidos? Eu tenho muito interesse nas postagens que você faz, elas valem mais que alguns livros sobre ObjectPascal (a maioria mostrando no Delphi) que estão aí no mercado.

    Um grande abraço!
    Silvio Clécio

  7. Oops,

    {…}
    depois em “function FreeInstance;”, troco por “procedure FreeInstance; override;”
    {…}

    O original tb tem override, ficando assim: “function FreeInstance; override”, mas, só compila quando mudo para procedure.

Comments are closed.