////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit implement Interfaced Master Object classes.                      //
// Interfaced   - working with interfaces, implements IUnknown.               //
// MasterObject - has Master reference pointer, with automatic cleaning.      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20241108 - Created by A.K.                                                 //
// 20241110 - Fatal bug fixed in TInterfacedMasterObject.NewInstance          //
////////////////////////////////////////////////////////////////////////////////

unit _crw_if_masters; //  Interface Master Objects.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes,
 _crw_alloc;

 {
 TInterfacedMasterObject - Master Object with Interface support,
 which uses Reference Count. His lifetime depends of references.
 Implements IUnknown methods.
 }
type
 TInterfacedMasterObject = class(TMasterObject,IUnknown)
 private
  myRefCount     : LongInt;
  myDestroyCount : LongInt;
  function GetRefCount:LongInt;
 protected // implement methods of IUnknown
  function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid:TGuid; out Obj):LongInt; {$I _crw_if_abicall.inc};
  function _AddRef:LongInt;  {$I _crw_if_abicall.inc};
  function _Release:LongInt; {$I _crw_if_abicall.inc};
 public
  destructor Destroy; override;
  procedure AfterConstruction; override;
  procedure BeforeDestruction; override;
  class function NewInstance:TObject; override;
  property RefCount : LongInt read GetRefCount;
 end;
 TInterfacedMasterClass = class of TInterfacedMasterObject;

 {
 TNoRefCountMasterObject - Master Object with Interface support,
 which is NOT USES Reference Count. His lifetime don't depend of
 references and must be controlled with Create/Free methods.
 Implements IUnknown methods.
 }
type
 TNoRefCountMasterObject = class(TMasterObject,IUnknown)
 private
  function GetRefCount:LongInt;
 protected // implement methods of IUnknown
  function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid:TGuid; out Obj):LongInt; {$I _crw_if_abicall.inc};
  function _AddRef:LongInt;  {$I _crw_if_abicall.inc};
  function _Release:LongInt; {$I _crw_if_abicall.inc};
 public
  property RefCount : LongInt read GetRefCount;
 end;
 TNoRefCountMasterClass = class of TNoRefCountMasterObject;

implementation

procedure HandleError(Errno:Longint); external name 'FPC_HANDLEERROR';

/////////////////////////////////////////
// TInterfacedMasterObject implementation
/////////////////////////////////////////

function TInterfacedMasterObject.GetRefCount:LongInt;
begin
 if Assigned(Self)
 then Result:=myRefCount
 else Result:=-1;
end;

function TInterfacedMasterObject.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid:TGuid; out Obj): LongInt; {$I _crw_if_abicall.inc};
begin
 if GetInterface(iid,Obj)
 then Result:=S_OK
 else Result:=LongInt(E_NOINTERFACE);
end;

function TInterfacedMasterObject._AddRef:LongInt; {$I _crw_if_abicall.inc};
begin
 Result:=InterlockedIncrement(myRefCount);
end;

function TInterfacedMasterObject._Release:LongInt; {$I _crw_if_abicall.inc};
begin
 Result:=InterlockedDecrement(myRefCount);
 if (Result=0) then begin
  if (InterlockedIncrement(myDestroyCount)=1)
  then Self.Destroy;
 end;
end;

destructor TInterfacedMasterObject.Destroy;
begin
 // We must explicitly reset. Bug ID 32353
 myRefCount:=0;
 myDestroyCount:=0;
 inherited Destroy;
end;

procedure TInterfacedMasterObject.AfterConstruction;
begin
 { we need to fix the refcount we forced in newinstance }
 { further, it must be done in a thread safe way        }
 InterlockedDecrement(myRefCount);
 inherited;
end;

procedure TInterfacedMasterObject.BeforeDestruction;
begin
 inherited;
 if (myRefCount<>0) then HandleError(204);
end;

class function TInterfacedMasterObject.NewInstance:TObject;
begin
 Result:=inherited NewInstance;
 if Assigned(Result) then TInterfacedMasterObject(Result).myRefCount:=1;
end;

/////////////////////////////////////////
// TNoRefCountMasterObject implementation
/////////////////////////////////////////
function TNoRefCountMasterObject.GetRefCount:LongInt;
begin
 Result:=-1;
end;

function TNoRefCountMasterObject.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid:TGuid; out Obj): LongInt; {$I _crw_if_abicall.inc};
begin
 if GetInterface(iid,Obj)
 then Result:=S_OK
 else Result:=LongInt(E_NOINTERFACE);
end;

function TNoRefCountMasterObject._AddRef:LongInt; {$I _crw_if_abicall.inc};
begin
 Result:=-1;
end;

function TNoRefCountMasterObject._Release:LongInt; {$I _crw_if_abicall.inc};
begin
 Result:=-1;
end;  

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_if_masters;
begin
end;

procedure Free_crw_if_masters;
begin
end;

initialization

 Init_crw_if_masters;

finalization

 Free_crw_if_masters;

end.

//////////////
// END OF FILE
//////////////
