Forms con Reference Counting

[[AgustinOrtu]]

En algunos casos puede ser util o necesario tener forms que implementen el conteo de referencias de modo tal que cuando la cantidad de referencias llega a 0, el form se destruye y se libera la memoria; si se desean usar interfaces e implementarlas usando algun descendiente de TForm

Al declarar una interfaz, implicitamente hereda de IInterface, por lo tanto si nuestro form implementa cualquier interfaz, necesariamente debe implementar IInterface; si bien es cierto que la clase TComponent (la cual es ancestro de TForm), implementa IInterface de manera tal que se deshabilita el reference counting, nosotros podemos "re-implementarla" para habilitarlo nuevamente.

Asi podemos utilizar interfaces en lugar de clases obteniendo bastante flexibilidad a la hora de programar; y tambien somos buenos samaritanos y no creamos aplicaciones con fugas de memoria

La implementacion es basicamente "copia y pega" de la clase TInterfacedObject. Necesitaremos una clase para el form con reference counting para el framework VCL y otra para el framework FMX

Primero vamos con la querida Vcl, en donde es algo mas facil ya que es terreno de los compiladores tradicionales para Windows y no tenemos que lidiar con multiplataforma:

Código Delphi [-]
interface

uses
  System.Classes,
  Vcl.Forms;

type
{$REGION 'TInterfacedForm'}
  ///  Form Vcl que implementa Reference Counting 
  TInterfacedForm = class(TForm, IInterface)
  strict private
    FRefCount: Integer;
    FHasOwner: Boolean;

    procedure CheckAssigned(Target: TObject);
  strict protected
{$REGION 'IInterface'}
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
{$ENDREGION}
    property HasOwner: Boolean read FHasOwner;
  public
    constructor Create; reintroduce;
    constructor CreateOwned(AOwner: TComponent);
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
  end;
{$ENDREGION}

implementation

uses
  System.SysUtils;

{$REGION 'TInterfacedForm'}

constructor TInterfacedForm.Create;
begin
  FHasOwner := False;
  inherited Create(nil);
end;

constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
begin
  CheckAssigned(AOwner);
  FHasOwner := True;
  inherited Create(AOwner);
end;

procedure TInterfacedForm.CheckAssigned(Target: TObject);
begin
  if not Assigned(Target) then
    raise EArgumentNilException.Create('null argument');
end;

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

procedure TInterfacedForm.AfterConstruction;
begin
  System.AtomicDecrement(FRefCount);
  inherited AfterConstruction;
end;

procedure TInterfacedForm.BeforeDestruction;
begin
  if (FRefCount <> 0) and (not HasOwner) then
    System.Error(System.TRuntimeError.reInvalidPtr);
end;

{$REGION 'IInterface'}

function TInterfacedForm.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := System.S_OK
  else
    Result := System.E_NOINTERFACE;
end;

function TInterfacedForm._AddRef: Integer;
begin
  if HasOwner then
    Result := -1
  else
    Result := System.AtomicIncrement(FRefCount);
end;

function TInterfacedForm._Release: Integer;
begin
  if HasOwner then
    Result := -1
  else
  begin
    Result := System.AtomicDecrement(FRefCount);
    if Result = 0 then
      Destroy;
  end;
end;

{$ENDREGION}

{$ENDREGION}

Aun asi, decidi dejar la posibilidad de utilizar la clase con el modelo de memoria de TComponent (es decir, basado en Owner).

Tenemos dos constructores: el constructor Create el cual se debe utilizar cuando queremos utilizar el form como una interface; y el constructor CreateOwned el cual es el que se debe utilizar cuando queremos que otro componente maneje el tiempo de vida

Al utilizar el constructor CreateOwned el reference counting se deshabilita; aun asi, se puede seguir utilizando variables de tipo interfaz para referenciar el form, y todo va a estar bien siempre y cuando se haya inicializado con un TComponent como Owner valido

Ahora, la implementacion para FMX, que es un pelin mas compleja:

Código Delphi [-]
interface

uses
  System.Classes,
  FMX.Forms;

type
{$REGION 'TInterfacedForm'}
  ///  Form FMX que implementa Reference Counting 
  TInterfacedForm = class(TForm, IInterface)
  strict private const
    objDestroyingFlag = Integer($80000000);
  strict private
    FHasOwner: Boolean;

    CheckAssigned(Target: TObject);

{$IFNDEF AUTOREFCOUNT}
    [Volatile] FRefCount: Integer;
    function GetRefCount: Integer; { inline; }
    class procedure __MarkDestroying(const Obj); static; { inline; }
    property RefCount: Integer read GetRefCount;
{$ENDIF AUTOREFCOUNT}
  strict protected
{$REGION 'IInterface'}
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
{$ENDREGION}
    property HasOwner: Boolean read FHasOwner;
  public
    constructor Create; reintroduce;
    constructor CreateOwned(AOwner: TComponent);
{$IFNDEF AUTOREFCOUNT}
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
{$ENDIF AUTOREFCOUNT}
  end;
{$ENDREGION}

implementation

uses
  System.SysUtils;

{$REGION 'TInterfacedForm'}

constructor TInterfacedForm.Create;
begin
  FHasOwner := False;
  inherited Create(nil);
end;

constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
begin
  CheckAssigned(AOwner);
  FHasOwner := True;
  inherited Create(AOwner);
end;

procedure TInterfacedForm.CheckAssigned(Target: TObject);
begin
  if not Assigned(Target) then
    raise EArgumentNilException.Create('null argument');
end;

{$IFNDEF AUTOREFCOUNT}

class procedure TInterfacedForm.__MarkDestroying(const Obj);
var
  LRef: Integer;
begin
  repeat
    LRef := TInterfacedForm(Obj).FRefCount;
  until AtomicCmpExchange(TInterfacedForm(Obj).FRefCount, LRef or objDestroyingFlag, LRef) = LRef;
end;

function TInterfacedForm.GetRefCount: Integer;
begin
  Result := FRefCount and not objDestroyingFlag;
end;

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

procedure TInterfacedForm.AfterConstruction;
begin
  System.AtomicDecrement(FRefCount);
end;

procedure TInterfacedForm.BeforeDestruction;
begin
  if (RefCount <> 0) and (not HasOwner) then
    System.Error(System.TRuntimeError.reInvalidPtr);
end;

{$ENDIF AUTOREFCOUNT}

{$REGION 'IInterface'}

function TInterfacedForm.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := System.S_OK
  else
    Result := System.E_NOINTERFACE;
end;

function TInterfacedForm._AddRef: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  if HasOwner then
    Result := -1
  else
    Result := System.AtomicIncrement(FRefCount);
{$ELSE}
  Result := __ObjAddRef;
{$ENDIF AUTOREFCOUNT}
end;

function TInterfacedForm._Release: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  if HasOwner then
    Result := -1
  else
  begin
    Result := System.AtomicDecrement(FRefCount);
    if Result = 0 then
    begin
      // Mark the refcount field so that any refcounting during destruction doesn't infinitely recurse.
      __MarkDestroying(Self);
      Destroy;
    end;
  end;
{$ELSE}
  Result := __ObjRelease;
{$ENDIF AUTOREFCOUNT}
end;

{$ENDREGION}

{$ENDREGION}

Si bien la implementacion parece muy de bajo nivel, como comentaba mas arriba, es una replica de lo que hace TInterfacedObject

Solo he podido probar las dos clases en Windows y Android y todo parece ir bien

Saludos

[Casimiro Notevi]

[[newtron]]

Empezado por Casimiro Notevi

Oye Antonio.... ¿este tío tan listo de dónde lo habéis sacado? ¿es un marciano o algo?

[Casimiro Notevi]

Es un robot con inteligencia artificial que hemos puesto en marcha

[miado]

Gracias compi,
Curioso el tema este.

[[AgustinOrtu]]

Empezado por newtron

Oye Antonio.... ¿este tío tan listo de dónde lo habéis sacado? ¿es un marciano o algo?

Empezado por Casimiro Notevi

Es un robot con inteligencia artificial que hemos puesto en marcha

Venga, venga, no es para tanto

[roman]

¡Caramba! Hoy está que echa lumbre!

LineComment Saludos