Ir al contenido


Foto

Forms con Reference Counting

ARC Reference Counting Forms Multiplataforma

  • Por favor identifícate para responder
2 respuestas en este tema

#1 Agustin Ortu

Agustin Ortu

    Advanced Member

  • Moderadores
  • PipPipPip
  • 831 mensajes
  • LocationArgentina

Escrito 21 febrero 2017 - 11:54

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:


delphi
  1. interface
  2.  
  3. uses
  4.   System.Classes,
  5.   Vcl.Forms;
  6.  
  7. type
  8. {$REGION 'TInterfacedForm'}
  9.   /// <summar> Form Vcl que implementa Reference Counting </summary>
  10.   TInterfacedForm = class(TForm, IInterface)
  11.   strict private
  12.     FRefCount: Integer;
  13.     FHasOwner: Boolean;
  14.  
  15.     procedure CheckAssigned(Target: TObject);
  16.   strict protected
  17. {$REGION 'IInterface'}
  18.     function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  19.     function _AddRef: Integer; stdcall;
  20.     function _Release: Integer; stdcall;
  21. {$ENDREGION}
  22.     property HasOwner: Boolean read FHasOwner;
  23.   public
  24.     constructor Create; reintroduce;
  25.     constructor CreateOwned(AOwner: TComponent);
  26.     procedure AfterConstruction; override;
  27.     procedure BeforeDestruction; override;
  28.     class function NewInstance: TObject; override;
  29.   end;
  30. {$ENDREGION}
  31.  
  32. implementation
  33.  
  34. uses
  35.   System.SysUtils;
  36.  
  37. {$REGION 'TInterfacedForm'}
  38.  
  39. constructor TInterfacedForm.Create;
  40. begin
  41.   FHasOwner := False;
  42.   inherited Create(nil);
  43. end;
  44.  
  45. constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
  46. begin
  47.   CheckAssigned(AOwner);
  48.   FHasOwner := True;
  49.   inherited Create(AOwner);
  50. end;
  51.  
  52. procedure TInterfacedForm.CheckAssigned(Target: TObject);
  53. begin
  54.   if not Assigned(Target) then
  55.     raise EArgumentNilException.Create('null argument');
  56. end;
  57.  
  58. class function TInterfacedForm.NewInstance: TObject;
  59. begin
  60.   Result := inherited NewInstance;
  61.   TInterfacedForm(Result).FRefCount := 1;
  62. end;
  63.  
  64. procedure TInterfacedForm.AfterConstruction;
  65. begin
  66.   System.AtomicDecrement(FRefCount);
  67.   inherited AfterConstruction;
  68. end;
  69.  
  70. procedure TInterfacedForm.BeforeDestruction;
  71. begin
  72.   if (FRefCount <> 0) and (not HasOwner) then
  73.     System.Error(System.TRuntimeError.reInvalidPtr);
  74. end;
  75.  
  76. {$REGION 'IInterface'}
  77.  
  78. function TInterfacedForm.QueryInterface(const IID: TGUID; out Obj): HResult;
  79. begin
  80.   if GetInterface(IID, Obj) then
  81.     Result := System.S_OK
  82.   else
  83.     Result := System.E_NOINTERFACE;
  84. end;
  85.  
  86. function TInterfacedForm._AddRef: Integer;
  87. begin
  88.   if HasOwner then
  89.     Result := -1
  90.   else
  91.     Result := System.AtomicIncrement(FRefCount);
  92. end;
  93.  
  94. function TInterfacedForm._Release: Integer;
  95. begin
  96.   if HasOwner then
  97.     Result := -1
  98.   else
  99.   begin
  100.     Result := System.AtomicDecrement(FRefCount);
  101.     if Result = 0 then
  102.       Destroy;
  103.   end;
  104. end;
  105.  
  106. {$ENDREGION}
  107.  
  108. {$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:
 


delphi
  1. interface
  2.  
  3. uses
  4.   System.Classes,
  5.   FMX.Forms;
  6.  
  7. type
  8. {$REGION 'TInterfacedForm'}
  9.   /// <summar> Form FMX que implementa Reference Counting </summary>
  10.   TInterfacedForm = class(TForm, IInterface)
  11.   strict private const
  12.     objDestroyingFlag = Integer($80000000);
  13.   strict private
  14.     FHasOwner: Boolean;
  15.  
  16.     CheckAssigned(Target: TObject);
  17. {$IFNDEF AUTOREFCOUNT}
  18.     [Volatile] FRefCount: Integer;
  19.     function GetRefCount: Integer; { inline; }
  20.     class procedure __MarkDestroying(const Obj); static; { inline; }
  21.     property RefCount: Integer read GetRefCount;
  22. {$ENDIF AUTOREFCOUNT}
  23.   strict protected
  24. {$REGION 'IInterface'}
  25.     function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
  26.     function _AddRef: Integer; stdcall;
  27.     function _Release: Integer; stdcall;
  28. {$ENDREGION}
  29.     property HasOwner: Boolean read FHasOwner;
  30.   public
  31.     constructor Create; reintroduce;
  32.     constructor CreateOwned(AOwner: TComponent);
  33. {$IFNDEF AUTOREFCOUNT}
  34.     procedure AfterConstruction; override;
  35.     procedure BeforeDestruction; override;
  36.     class function NewInstance: TObject; override;
  37. {$ENDIF AUTOREFCOUNT}
  38.   end;
  39. {$ENDREGION}
  40.  
  41. implementation
  42.  
  43. uses
  44.   System.SysUtils;
  45.  
  46. {$REGION 'TInterfacedForm'}
  47.  
  48. constructor TInterfacedForm.Create;
  49. begin
  50.   FHasOwner := False;
  51.   inherited Create(nil);
  52. end;
  53.  
  54. constructor TInterfacedForm.CreateOwned(AOwner: TComponent);
  55. begin
  56.   CheckAssigned(AOwner);
  57.   FHasOwner := True;
  58.   inherited Create(AOwner);
  59. end;
  60.  
  61. procedure TInterfacedForm.CheckAssigned(Target: TObject);
  62. begin
  63.   if not Assigned(Target) then
  64.     raise EArgumentNilException.Create('null argument');
  65. end;
  66.  
  67. {$IFNDEF AUTOREFCOUNT}
  68. class procedure TInterfacedForm.__MarkDestroying(const Obj);
  69. var
  70.   LRef: Integer;
  71. begin
  72.   repeat
  73.     LRef := TInterfacedForm(Obj).FRefCount;
  74.   until AtomicCmpExchange(TInterfacedForm(Obj).FRefCount, LRef or objDestroyingFlag, LRef) = LRef;
  75. end;
  76.  
  77. function TInterfacedForm.GetRefCount: Integer;
  78. begin
  79.   Result := FRefCount and not objDestroyingFlag;
  80. end;
  81.  
  82. class function TInterfacedForm.NewInstance: TObject;
  83. begin
  84.   Result := inherited NewInstance;
  85.   TInterfacedForm(Result).FRefCount := 1;
  86. end;
  87.  
  88. procedure TInterfacedForm.AfterConstruction;
  89. begin
  90.   System.AtomicDecrement(FRefCount);
  91. end;
  92.  
  93. procedure TInterfacedForm.BeforeDestruction;
  94. begin
  95.   if (RefCount <> 0) and (not HasOwner) then
  96.     System.Error(System.TRuntimeError.reInvalidPtr);
  97. end;
  98. {$ENDIF AUTOREFCOUNT}
  99.  
  100. {$REGION 'IInterface'}
  101.  
  102. function TInterfacedForm.QueryInterface(const IID: TGUID; out Obj): HResult;
  103. begin
  104.   if GetInterface(IID, Obj) then
  105.     Result := System.S_OK
  106.   else
  107.     Result := System.E_NOINTERFACE;
  108. end;
  109.  
  110. function TInterfacedForm._AddRef: Integer;
  111. begin
  112. {$IFNDEF AUTOREFCOUNT}
  113.   if HasOwner then
  114.     Result := -1
  115.   else
  116.     Result := System.AtomicIncrement(FRefCount);
  117. {$ELSE}
  118.   Result := __ObjAddRef;
  119. {$ENDIF AUTOREFCOUNT}
  120. end;
  121.  
  122. function TInterfacedForm._Release: Integer;
  123. begin
  124. {$IFNDEF AUTOREFCOUNT}
  125.   if HasOwner then
  126.     Result := -1
  127.   else
  128.   begin
  129.     Result := System.AtomicDecrement(FRefCount);
  130.     if Result = 0 then
  131.     begin
  132.       // Mark the refcount field so that any refcounting during destruction doesn't infinitely recurse.
  133.       __MarkDestroying(Self);
  134.       Destroy;
  135.     end;
  136.   end;
  137. {$ELSE}
  138.   Result := __ObjRelease;
  139. {$ENDIF AUTOREFCOUNT}
  140. end;
  141.  
  142. {$ENDREGION}
  143.  
  144. {$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

Editado por Agustin Ortu, 21 febrero 2017 - 11:56 .

  • 1

#2 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.459 mensajes
  • LocationMéxico

Escrito 22 febrero 2017 - 08:53

Excelente aporte y muy interesante asunto este de las interfaces. (y)

 

Saludos


  • 0

#3 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 566 mensajes
  • LocationEspaña

Escrito 23 febrero 2017 - 12:03

Gracias por el aporte

 

Saludos


  • 0





Etiquetado también con una o más de estas palabras: ARC, Reference, Counting, Forms, Multiplataforma

IP.Board spam blocked by CleanTalk.