////////////////////////////////////////////////////////////////////////////////
// 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 Atomic Counters based on Interlocked operations.       //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20250128 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_atomic; //  Atomic Counters - safe and robust implementation.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

///////////////////////////////////////////////////////
{$I _crw_align_abi.inc} // NB: UNIT MUST BE ALIGNED !!!
///////////////////////////////////////////////////////

interface

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

 {
 ///////////////////////////////////////////////////////////////////////
 // TAtomicCounter applies Counter with Atomic (interlocked) operations.
 // Usage of TAtomicCounter guarantees high safety and robustness.
 // For example, Interlocked functions strongly depends on counter
 // address alignment according to SizeOf(Pointer). If it is not
 // aligned, result is unpredictable. TAtomicCounter guarangees
 // correct alignment of Counter. Also Counter is protected and
 // could not be changed in wrong way from outside. So usage of
 // TAtomicCounter more safe then direct call of Interlocked functions.
 ///////////////////////////////////////////////////////////////////////
 }
type
 EAtomicCounter = class(Exception);
 PAtomicCounter = ^TAtomicCounter;
 TAtomicCounter = class(TObject)             // Class implements Atomic Counters
 private
  myCounter : SizeInt;                       // Private Counter, must be aligned
  myMaster  : PAtomicCounter;                // Master pointer for auto-cleaning
  procedure HandleUnAligned;
  function  HandleNilRef:SizeInt;
 public
  constructor Create(aMaster:PAtomicCounter=nil);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public // Locked functions returns result counter value (after operation)
  function LockedInc:SizeInt;
  function LockedDec:SizeInt;
  function LockedAdd(Value:SizeInt):SizeInt;
  function LockedSub(Value:SizeInt):SizeInt;
 public // Exchange functions returns original counter value (before operation)
  function LockedGet:SizeInt;
  function LockedSet(Value:SizeInt):SizeInt;
  function LockedExchangeInc:SizeInt;
  function LockedExchangeDec:SizeInt;
  function LockedExchangeAdd(Value:SizeInt):SizeInt;
  function LockedExchangeSub(Value:SizeInt):SizeInt;
  function LockedExchange(Value:SizeInt):SizeInt;
  function LockedCompareExchange(Exch,Comp:SizeInt):SizeInt;
 public
  class function Population:SizeInt;         // Create/Destroy balance
  class var PrintOnFail:Boolean;             // Print to StdErr on exceptions
  class var PrintOnNilRef:Boolean;           // Print to StdErr on NIL reference
  class var RaiseOnNilRef:Boolean;           // Raise exception on NIL reference
  class var PrintOnUnAligned:Boolean;        // Print to StdErr if not unaligned
  class var RaiseOnUnAligned:Boolean;        // Raise exception if not unaligned
 end;

function NewAtomicCounter(aMaster:PAtomicCounter=nil):TAtomicCounter;
function InitAtomicCounter(var C:TAtomicCounter):TAtomicCounter;
function BornAtomicCounter(var C:TAtomicCounter):TAtomicCounter;
procedure Kill(var TheObject:TAtomicCounter); overload;

 {
 /////////////////////////////////////////////////////////////////////
 // Simplified interface to use AtomicCounters.
 // Example:
 //  var ac:TAtomicCounter=nil;
 //  AtomicCounter_Init(ac);
 //  writeln(AtomicCounter_Inc(ac));
 //  writeln(AtomicCounter_Dec(ac));
 //  AtomicCounter_Free(ac);
 // Notes:
 //  1. AtomicCounter should be assigned to NIL before initialization.
 //  2. Atomic counter reguired Free after usage and became NIL value.
 /////////////////////////////////////////////////////////////////////
 }
function  AtomicCounter_Init(var C:TAtomicCounter):TAtomicCounter;
procedure AtomicCounter_Free(var C:TAtomicCounter);
function  AtomicCounter_Inc(const C:TAtomicCounter):SizeInt; inline;
function  AtomicCounter_Dec(const C:TAtomicCounter):SizeInt; inline;
function  AtomicCounter_Get(const C:TAtomicCounter):SizeInt; inline;
function  AtomicCounter_Set(const C:TAtomicCounter; Value:SizeInt):SizeInt; inline;
function  AtomicCounter_Add(const C:TAtomicCounter; Value:SizeInt):SizeInt; inline;
function  AtomicCounter_Sub(const C:TAtomicCounter; Value:SizeInt):SizeInt; inline;

function Test_AtomicCounters(const a,b:SizeInt):String;

implementation

///////////////////////////
// Internal helper routines
///////////////////////////

const
  EOL=LineEnding;

function PointerToPtrUInt(P:Pointer):PtrUInt;
var I : PtrUInt absolute P;
begin
 Result:=I;
end;

function PointerAlignment(P:Pointer):PtrUInt;
begin
 Result:=PointerToPtrUInt(P) mod SizeOf(Pointer);
end;

procedure PrintToStdError(const Msg:String);
begin
 if (Msg<>'') then FileWrite(StdErrorHandle,PChar(Msg)^,Length(Msg));
end;

function NewAtomicCounter(aMaster:PAtomicCounter=nil):TAtomicCounter;
begin
 Result:=nil;
 try
  Result:=TAtomicCounter.Create(aMaster);
 except
  on E:Exception do begin
   Result:=nil;
   if TAtomicCounter.PrintOnFail
   then PrintToStdError(EOL+'Exception '+E.ClassName+': '+E.Message+EOL);
  end;
 end;
end;

function InitAtomicCounter(var C:TAtomicCounter):TAtomicCounter;
begin
 if Assigned(C) then Result:=C else Result:=BornAtomicCounter(C);
end;

function BornAtomicCounter(var C:TAtomicCounter):TAtomicCounter;
begin
 Result:=NewAtomicCounter(@C);
 C:=Result;
end;

procedure Kill(var TheObject:TAtomicCounter); overload;
begin
 if Assigned(TheObject) then
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do begin
   if TAtomicCounter.PrintOnFail
   then PrintToStdError(EOL+'Exception '+E.ClassName+': '+E.Message+EOL);
  end;
 end;
end;

////////////////////////////////
// TAtomicCounter implementation
////////////////////////////////

const // Create/Destroy balance
 AtomicCounterPopulation:SizeInt=0;

constructor TAtomicCounter.Create(aMaster:PAtomicCounter=nil);
begin
 inherited Create;
 myCounter:=0; myMaster:=aMaster;
 if (PointerAlignment(@myCounter)<>0) then HandleUnAligned;
end;

destructor TAtomicCounter.Destroy;
begin
 myCounter:=0; myMaster:=nil;
 inherited Destroy;
end;

procedure TAtomicCounter.AfterConstruction;
begin
 inherited AfterConstruction;
 {$IFDEF CPU64}
 System.InterlockedIncrement64(AtomicCounterPopulation);
 {$ELSE}
 System.InterlockedIncrement(AtomicCounterPopulation);
 {$ENDIF}
 // Master variable expected to be NIL before construction.
 if (myMaster<>nil) and (myMaster^=nil) then myMaster^:=Self;
end;

procedure TAtomicCounter.BeforeDestruction;
begin
 {$IFDEF CPU64}
 System.InterlockedDecrement64(AtomicCounterPopulation);
 {$ELSE}
 System.InterlockedDecrement(AtomicCounterPopulation);
 {$ENDIF}
 // Master variable must be cleaned if contains Self.
 if (myMaster<>nil) and (myMaster^=Self) then myMaster^:=nil;
 inherited BeforeDestruction;
end;

class function TAtomicCounter.Population:SizeInt;
const Dummy=Low(SizeInt);
begin
 {$IFDEF CPU64}
 Result:=System.InterlockedCompareExchange64(AtomicCounterPopulation,Dummy,Dummy);
 {$ELSE}
 Result:=System.InterlockedCompareExchange(AtomicCounterPopulation,Dummy,Dummy);
 {$ENDIF}
end;

procedure TAtomicCounter.HandleUnAligned;
const Msg='Unaligned AtomicCounter address.';
begin
 if PrintOnUnAligned then PrintToStdError(EOL+Msg+EOL);
 if RaiseOnUnAligned then Raise EAtomicCounter.Create(Msg);
end;

function TAtomicCounter.HandleNilRef:SizeInt;
const Msg='Nil AtomicCounter reference.';
begin
 Result:=0;
 if PrintOnNilRef then PrintToStdError(EOL+Msg+EOL);
 if RaiseOnNilRef then Raise EAtomicCounter.Create(Msg);
end;

function TAtomicCounter.LockedInc:SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedIncrement64(myCounter);
 {$ELSE}
 Result:=System.InterlockedIncrement(myCounter);
 {$ENDIF}
end;

function TAtomicCounter.LockedDec:SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedDecrement64(myCounter);
 {$ELSE}
 Result:=System.InterlockedDecrement(myCounter);
 {$ENDIF}
end;

function TAtomicCounter.LockedGet:SizeInt;
const Dummy=Low(SizeInt);
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedCompareExchange64(myCounter,Dummy,Dummy);
 {$ELSE}
 Result:=System.InterlockedCompareExchange(myCounter,Dummy,Dummy);
 {$ENDIF}
end;

function TAtomicCounter.LockedSet(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchange64(myCounter,Value);
 {$ELSE}
 Result:=System.InterlockedExchange(myCounter,Value);
 {$ENDIF}
end;

function TAtomicCounter.LockedAdd(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,Value)+Value;
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,Value)+Value;
 {$ENDIF}
end;

function TAtomicCounter.LockedSub(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,-Value)-Value;
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,-Value)-Value;
 {$ENDIF}
end;

function TAtomicCounter.LockedExchangeInc:SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,+1);
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,+1);
 {$ENDIF}
end;

function TAtomicCounter.LockedExchangeDec:SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,-1);
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,-1);
 {$ENDIF}
end;

function TAtomicCounter.LockedExchangeAdd(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,Value);
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,Value);
 {$ENDIF}
end;

function TAtomicCounter.LockedExchangeSub(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchangeAdd64(myCounter,-Value);
 {$ELSE}
 Result:=System.InterlockedExchangeAdd(myCounter,-Value);
 {$ENDIF}
end;

function TAtomicCounter.LockedExchange(Value:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedExchange64(myCounter,Value);
 {$ELSE}
 Result:=System.InterlockedExchange(myCounter,Value);
 {$ENDIF}
end;

function TAtomicCounter.LockedCompareExchange(Exch,Comp:SizeInt):SizeInt;
begin
 if (Self=nil) then Exit(HandleNilRef);
 {$IFDEF CPU64}
 Result:=System.InterlockedCompareExchange64(myCounter,Exch,Comp);
 {$ELSE}
 Result:=System.InterlockedCompareExchange(myCounter,Exch,Comp);
 {$ENDIF}
end;

/////////////////////////
// AtomicCounter routines
/////////////////////////

function AtomicCounter_Init(var C:TAtomicCounter):TAtomicCounter;
begin
 Result:=NewAtomicCounter(@C);
 C:=Result;
end;

procedure AtomicCounter_Free(var C:TAtomicCounter);
begin
 Kill(C);
end;

function AtomicCounter_Inc(const C:TAtomicCounter):SizeInt;
begin
 Result:=C.LockedInc;
end;

function AtomicCounter_Dec(const C:TAtomicCounter):SizeInt;
begin
 Result:=C.LockedDec;
end;

function AtomicCounter_Get(const C:TAtomicCounter):SizeInt;
begin
 Result:=C.LockedGet;
end;

function AtomicCounter_Set(const C:TAtomicCounter; Value:SizeInt):SizeInt;
begin
 Result:=C.LockedSet(Value);
end;

function AtomicCounter_Add(const C:TAtomicCounter; Value:SizeInt):SizeInt;
begin
 Result:=C.LockedAdd(Value);
end;

function AtomicCounter_Sub(const C:TAtomicCounter; Value:SizeInt):SizeInt;
begin
 Result:=C.LockedSub(Value);
end;

function Test_AtomicCounters(const a,b:SizeInt):String;
const ac:TAtomicCounter=nil;
 function Test1(op:String; a,v,e:SizeInt):String;
 begin
  Result:=Format('%s(%d) = %d, expect %d',[op,a,v,e]);
 end;
 function Test2(op:String; a,b,v,e:SizeInt):String;
 begin
  Result:=Format('%s(%d,%d) = %d, expect %d',[op,a,b,v,e]);
 end;
begin
 Result:=Format('Test AtomicCounters(%d,%d):',[a,b])+EOL;
 AtomicCounter_Init(ac);
 if (ac=nil) then Result:=Result+'Error: invalid Init.'+EOL;
 Result:=Result+Test1('Set',a,AtomicCounter_Set(ac,a),0)+EOL;
 Result:=Result+Test1('Inc',a,AtomicCounter_Inc(ac),a+1)+EOL;
 Result:=Result+Test1('Get',a+1,AtomicCounter_Get(ac),a+1)+EOL;
 Result:=Result+Test1('Dec',a+1,AtomicCounter_Dec(ac),a)+EOL;
 Result:=Result+Test2('Add',a,b,AtomicCounter_Add(ac,b),a+b)+EOL;
 Result:=Result+Test2('Sub',a+b,b,AtomicCounter_Sub(ac,b),a)+EOL;
 Result:=Result+Format('TAtomicCounter.Population: %d',[TAtomicCounter.Population])+EOL;
 AtomicCounter_Free(ac);
 if (ac<>nil) then Result:=Result+'Error: invalid Free.'+EOL;
 Result:=Result+'Done.'+EOL;
end;

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

procedure Init_crw_atomic;
begin
 TAtomicCounter.PrintOnFail:=true;
 TAtomicCounter.PrintOnNilRef:=true;
 TAtomicCounter.RaiseOnNilRef:=false;
 TAtomicCounter.PrintOnUnAligned:=true;
 TAtomicCounter.RaiseOnUnAligned:=true;
end;

procedure Free_crw_atomic;
begin
end;

initialization

 Init_crw_atomic;

finalization

 Free_crw_atomic;

end.

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

