////////////////////////////////////////////////////////////////////////////////
// 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 safe Critical Sections with addition features.         //
////////////////////////////////////////////////////////////////////////////////

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

unit _crw_critsect; //  Critical Sections - 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;

 {
 TSysCriticalSection - the safe wrapper for TRTLCriticalSection.
 NB: direct usage of low level TRTLCriticalSection is not good idea,
 because (at least in some OS) TRTLCriticalSection requires data alignment,
 i.e. option $ALIGN SizeOf(Pointer), which is not always maybe switched on.
 Otherwise pthread runtime error may be occured with errno code 6 (ENXIO):
 "The futex facility returned an unexpected error code."
 So it's better to use TSysCriticalSection class.
 }
type
 ESysCriticalSection = class(Exception);
 PSysCriticalSection = ^TSysCriticalSection;
 TSysCriticalSection = class(TObject)        // Class implements CriticalSection
 private
  myCriticalSection : TRTLCriticalSection;   // CriticalSection, must be aligned
  myMaster  : PSysCriticalSection;           // Master pointer for auto-cleaning
  procedure HandleUnAligned;
  procedure HandleNilRef;
 public
  procedure Enter;
  function  TryEnter:Boolean;
  procedure Leave;
 public
  function  SetSpinCount(aCount:Cardinal):Cardinal;
 public
  constructor Create(aMaster:PSysCriticalSection=nil);
  destructor  Destroy;override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 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 NewSysCriticalSection(aMaster:PSysCriticalSection=nil):TSysCriticalSection;
function InitSysCriticalSection(var C:TSysCriticalSection):TSysCriticalSection;
function BornSysCriticalSection(var C:TSysCriticalSection):TSysCriticalSection;
procedure Kill(var TheObject:TSysCriticalSection); overload;

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 NewSysCriticalSection(aMaster:PSysCriticalSection=nil):TSysCriticalSection;
begin
 Result:=nil;
 try
  Result:=TSysCriticalSection.Create(aMaster);
 except
  on E:Exception do begin
   Result:=nil;
   if TSysCriticalSection.PrintOnFail
   then PrintToStdError(EOL+'Exception '+E.ClassName+': '+E.Message+EOL);
  end;
 end;
end;

function InitSysCriticalSection(var C:TSysCriticalSection):TSysCriticalSection;
begin
 if Assigned(C) then Result:=C else Result:=BornSysCriticalSection(C);
end;

function BornSysCriticalSection(var C:TSysCriticalSection):TSysCriticalSection;
begin
 Result:=NewSysCriticalSection(@C);
 C:=Result;
end;

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

/////////////////////////////////////
// TSysCriticalSection implementation
/////////////////////////////////////

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

constructor TSysCriticalSection.Create(aMaster:PSysCriticalSection=nil);
begin
 Inherited Create;
 myMaster:=aMaster;
 System.InitCriticalSection(myCriticalSection);
 if (PointerAlignment(@myCriticalSection)<>0) then HandleUnAligned;
end;

destructor TSysCriticalSection.Destroy;
begin
 System.DoneCriticalSection(myCriticalSection);
 myMaster:=nil;
 inherited Destroy;
end;

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

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

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

procedure TSysCriticalSection.HandleUnAligned;
const Msg='Unaligned SysCriticalSection address.';
begin
 if PrintOnUnAligned then PrintToStdError(EOL+Msg+EOL);
 if RaiseOnUnAligned then Raise ESysCriticalSection.Create(Msg);
end;

procedure TSysCriticalSection.HandleNilRef;
const Msg='Nil SysCriticalSection reference.';
begin
 if PrintOnNilRef then PrintToStdError(EOL+Msg+EOL);
 if RaiseOnNilRef then Raise ESysCriticalSection.Create(Msg);
end;

function  TSysCriticalSection.TryEnter:Boolean;
begin
 Result:=false;
 if (Self=nil) then begin HandleNilRef; Exit; end;
 Result:=System.TryEnterCriticalSection(myCriticalSection)<>0;
end;

procedure TSysCriticalSection.Enter;
begin
 if (Self=nil) then begin HandleNilRef; Exit; end;
 System.EnterCriticalSection(myCriticalSection);
end;

procedure TSysCriticalSection.Leave;
begin
 if (Self=nil) then begin HandleNilRef; Exit; end;
 System.LeaveCriticalSection(myCriticalSection);
end;

function TSysCriticalSection.SetSpinCount(aCount:Cardinal):Cardinal;
begin
 Result:=0;
 if (Self=nil) then begin HandleNilRef; Exit; end;
 {$IFDEF WINDOWS}
 Result:=Windows.SetCriticalSectionSpinCount(myCriticalSection,aCount);
 {$ENDIF ~WINDOWS}
end;

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

procedure Init_crw_critsect;
begin
 TSysCriticalSection.PrintOnFail:=true;
 TSysCriticalSection.PrintOnNilRef:=true;
 TSysCriticalSection.RaiseOnNilRef:=false;
 TSysCriticalSection.PrintOnUnAligned:=true;
 TSysCriticalSection.RaiseOnUnAligned:=true;
end;

procedure Free_crw_critsect;
begin
end;

initialization

 Init_crw_critsect;

finalization

 Free_crw_critsect;

end.

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

