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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// DIM Queue library. See http://dim.web.cern.ch on DIM.                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20201123 - Created by A.K.                                                 //
// 20230501 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_dimq; // DIM Queue

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, contnrs, math,
 _crw_alloc, _crw_rtc, _crw_str, _crw_dim;

 ///////////////////////////////////////////////////////////////////////////////
 // TDimDataHolder - mostly for internal use.
 ///////////////////////////////////////////////////////////////////////////////
type
 TDimDataHolder=class(TMasterObject)
 private
  myTimeStamp  : Int64;
  myLinkedTag  : TDimLong;
  myDataString : LongString;
  myDataFormat : LongString;
  function  GetTimeStamp:Int64;
  function  GetLinkedPtr:Pointer;
  function  GetLinkedTag:TDimLong;
  function  GetDataLength:SizeInt;
  function  GetDataBuffer:Pointer;
  function  GetDataString:LongString;
  function  GetDataFormat:LongString;
 public
  constructor Create;
  destructor  Destroy; override;
 public
  property  TimeStamp  : Int64      read GetTimeStamp;
  property  LinkedPtr  : Pointer    read GetLinkedPtr;
  property  LinkedTag  : TDimLong   read GetLinkedTag;
  property  DataLength : SizeInt    read GetDataLength;
  property  DataBuffer : Pointer    read GetDataBuffer;
  property  DataString : LongString read GetDataString;
  property  DataFormat : LongString read GetDataFormat;
 public
  function  PutData(aTag:TDimLong; aData:Pointer; aLeng:SizeInt; aFormat:PChar):SizeInt;
  procedure ClearData;
 end;

 ///////////////////////////////////////////////////////////////////////////////
 // TDimDataQueue
 // Usage:
 //  var tag:TDimLong; buffer:Pointer; size:Integer; format:TDimNameBuffer;
 //  Producer thread (in DIM user callback):
 //   DimDataQueue.Push(tag,buffer,size,format);
 //  Consumer (handler) thread (polling loop):
 //   while DimDataQueue.Pop(tag,buffer,size,format)>0 do begin
 //    // Handle this data
 //   end;
 // Notes:
 //  1) When using Pop(aHolder) - please never free aHolder manually.
 //  2) aFormat size should be at least MAX_NAME=SizeOf(TDimNameBuffer).
 //  3) By default assume single consumer thread uses for data processing.
 //  4) When N>1 consumer threads uses, increase SafetyPool to N at least.
 //  5) Usage of LastHolder may be unstable, if uses N>1 consumer threads.
 ///////////////////////////////////////////////////////////////////////////////
type
 TDimDataQueue = class(TLatch)
 private
  myList  : TFPObjectList;
  myQueue : TObjectQueue;
  myCache : TObjectQueue;
  myLast  : TDimDataHolder;
  myPool  : Integer;
  function  GetSafetyPool:Integer;
  procedure SetSafetyPool(aPool:Integer);
 public // Push data in producer thread, Pop data in consumer thread.
  function  Push(aTag:TDimLong; aBuffer:Pointer; aSize:Integer; aFormat:PChar=nil):SizeInt;
  function  Pop(out aTag:TDimLong; out aBuffer:Pointer; out aSize:Integer; aFormat:PChar=nil):SizeInt; overload;
  function  Pop(out aTag:Pointer; out aBuffer:Pointer; out aSize:Integer; aFormat:PChar=nil):SizeInt; overload;
  function  Pop(out aHolder:TDimDataHolder):SizeInt; overload;
 public
  function  Count(Who:Char='Q'):Integer; // Q,L,C
  function  LastHolder:TDimDataHolder;
 public
  property  SafetyPool : Integer read GetSafetyPool write  SetSafetyPool;
 public
  constructor Create;
  destructor  Destroy; override;
 end;

const                     // Default value of
 DefaultDimQueuePool = 1; // TDimDataQueue.SafetyPool

procedure Kill(var TheObject:TDimDataQueue); overload;

 ////////////////////////////////////////////////////////
 // DimDataQueue is the general instance of TDimDataQueue
 ////////////////////////////////////////////////////////
function DimDataQueue:TDimDataQueue;

procedure TestDimQueue;

implementation

 /////////////////
 // TDimDataHolder
 /////////////////

constructor TDimDataHolder.Create;
begin
 inherited Create;
 ClearData;
end;

destructor TDimDataHolder.Destroy;
begin
 ClearData;
 inherited Destroy;
end;

function  TDimDataHolder.GetTimeStamp:Int64;
begin
 if Assigned(Self) then Result:=myTimeStamp else Result:=0;
end;

function  TDimDataHolder.GetLinkedTag:TDimLong;
begin
 if Assigned(Self) then Result:=myLinkedTag else Result:=0;
end;

function  TDimDataHolder.GetLinkedPtr:Pointer;
begin
 if Assigned(Self) then Result:=PtrIntToPointer(myLinkedTag) else Result:=nil;
end;

function  TDimDataHolder.GetDataLength:SizeInt;
begin
 if Assigned(Self) then Result:=Length(myDataString) else Result:=0;
end;

function  TDimDataHolder.GetDataBuffer:Pointer;
begin
 if Assigned(Self) then Result:=Pointer(myDataString) else Result:=nil;
end;

function  TDimDataHolder.GetDataString:LongString;
begin
 if Assigned(Self) then Result:=myDataString;
end;

function  TDimDataHolder.GetDataFormat:LongString;
begin
 if Assigned(Self) then Result:=myDataFormat;
end;

function  TDimDataHolder.PutData(aTag:TDimLong; aData:Pointer; aLeng:SizeInt; aFormat:PChar):SizeInt;
begin
 Result:=0;
 if Assigned(Self) then
 try
  ClearData;
  myLinkedTag:=aTag;
  myTimeStamp:=IntMSecNow;
  if Assigned(aData) and (aLeng>0)
  then myDataString:=StringBuffer(aData,aLeng);
  if Assigned(aFormat) and (myDataString<>'')
  then myDataFormat:=Copy(StrPas(aFormat),1,High(TDimNameBuffer));
  Result:=Length(myDataString);
 except
  on E:Exception do BugReport(E,Self,'PutData');
 end;
end;

procedure  TDimDataHolder.ClearData;
begin
 if Assigned(Self) then begin
  myDataString:='';
  myDataFormat:='';
  myTimeStamp:=0;
  myLinkedTag:=0;
 end;
end;

 ////////////////
 // TDimDataQueue
 ////////////////

constructor TDimDataQueue.Create;
begin
 inherited Create;
 myList:=TFPObjectList.Create;
 myQueue:=TObjectQueue.Create;
 myCache:=TObjectQueue.Create;
 myPool:=DefaultDimQueuePool;
 myLast:=nil;
end;

destructor TDimDataQueue.Destroy;
begin
 myLast:=nil;
 FreeAndNil(myCache);
 FreeAndNil(myQueue);
 FreeAndNil(myList);
 inherited Destroy;
end;

function TDimDataQueue.Push(aTag:TDimLong; aBuffer:Pointer; aSize:Integer; aFormat:PChar=nil):SizeInt;
var Holder:TDimDataHolder; Obj:TObject;
begin
 Result:=0;
 if (aTag<>0) then
 if (aSize>0) then
 if (aBuffer<>nil) then
 if Assigned(Self) then
 try
  Lock;
  try
   if (myCache.Count>SafetyPool) // Keep at least SafetyPool of last poped
   then Obj:=myCache.Pop         // data holders to avoid influence
   else Obj:=nil;                // to data processing thread(s)
   if (Obj is TDimDataHolder) then begin
    Holder:=TDimDataHolder(Obj);
    myQueue.Push(Holder);
   end else begin
    Holder:=TDimDataHolder.Create;
    myQueue.Push(Holder);
    myList.Add(Holder);
   end;
   Result:=Holder.PutData(aTag,aBuffer,aSize,aFormat);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Push');
 end;
end;

function TDimDataQueue.Pop(out aHolder:TDimDataHolder):SizeInt;
var Obj:TObject;
begin
 Result:=0;
 aHolder:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   Obj:=myQueue.Pop;
   if (Obj is TDimDataHolder) then begin
    aHolder:=TDimDataHolder(Obj);
    Result:=aHolder.DataLength;
    myCache.Push(Obj);
    myLast:=aHolder;
   end;
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Pop');
 end;
end;

function TDimDataQueue.Pop(out aTag:TDimLong; out aBuffer:Pointer; out aSize:Integer; aFormat:PChar=nil):SizeInt;
var aHolder:TDimDataHolder;
begin
 Result:=Pop(aHolder);
 if (Result>0) and Assigned(aHolder) then begin
  aBuffer:=aHolder.DataBuffer; aSize:=aHolder.DataLength; aTag:=aHolder.LinkedTag;
  if (aFormat<>nil) then StrPLCopy(aFormat,aHolder.DataFormat,High(TDimNameBuffer));
 end else begin
  Result:=0;
  aBuffer:=nil; aSize:=0; aTag:=0;
  if (aFormat<>nil) then StrCopy(aFormat,'');
 end;
end;

function TDimDataQueue.Pop(out aTag:Pointer; out aBuffer:Pointer; out aSize:Integer; aFormat:PChar=nil):SizeInt;
var aHolder:TDimDataHolder;
begin
 Result:=Pop(aHolder);
 if (Result>0) and Assigned(aHolder) then begin
  aBuffer:=aHolder.DataBuffer; aSize:=aHolder.DataLength; aTag:=aHolder.LinkedPtr;
  if (aFormat<>nil) then StrPLCopy(aFormat,aHolder.DataFormat,High(TDimNameBuffer));
 end else begin
  Result:=0;
  aBuffer:=nil; aTag:=nil; aSize:=0;
  if (aFormat<>nil) then StrCopy(aFormat,'');
 end;
end;

function TDimDataQueue.Count(Who:Char='Q'):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   case UpCase(Who) of
    'L' : Result:=myList.Count;
    'Q' : Result:=myQueue.Count;
    'C' : Result:=myCache.Count;
   end;
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Count');
 end;
end;

function TDimDataQueue.LastHolder:TDimDataHolder;
begin
 if Assigned(Self) then Result:=myLast else Result:=nil;
end;

function  TDimDataQueue.GetSafetyPool:Integer;
begin
 if Assigned(Self) then Result:=myPool else Result:=0;
end;

procedure TDimDataQueue.SetSafetyPool(aPool:Integer);
begin
 if Assigned(Self) then myPool:=Max(1,aPool);
end;

procedure TestDimQueue;
var i,n:Integer; Tag:TDimLong; S:LongString; Buf:Pointer;
 procedure Report(Msg:LongString);
 begin
  writeln(Msg,' ',Tag,' ',S,' ',n,
          '  Q:',DimDataQueue.Count('Q'),
          '  C:',DimDataQueue.Count('C'),
          '  L:',DimDataQueue.Count('L'),
          '  Format:',DimDataQueue.LastHolder.DataFormat);
 end;
begin
 try
  // Push data to queue
  for i:=1 to 10 do begin
   Tag:=i; S:=Format('Data[%d]',[i]);
   n:=DimDataQueue.Push(Tag,PChar(S),Length(s),'C');
   Report('Push');
  end;
  // Extract data from queue
  while DimDataQueue.Pop(Tag,Buf,n)>0 do begin
   S:=StringBuffer(Buf,n);
   Report('Pop');
   DimDataQueue.LastHolder.ClearData;
  end;
  // Push data to queue
  for i:=1 to 10 do begin
   Tag:=i; S:=Format('Data[%d]',[i]);
   n:=DimDataQueue.Push(Tag,PChar(S),Length(s),'C');
   Report('Push');
  end;
  // Extract data from queue
  while DimDataQueue.Pop(Tag,Buf,n)>0 do begin
   S:=StringBuffer(Buf,n);
   Report('Pop');
   DimDataQueue.LastHolder.ClearData;
  end;
 except
  on E:Exception do BugReport(E,nil,'TestDimQueue');
 end;
end;

procedure Kill(var TheObject:TDimDataQueue); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

var
 TheDimDataQueue : TDimDataQueue = nil;

function DimDataQueue:TDimDataQueue;
begin
 if not Assigned(TheDimDataQueue) then begin
  TheDimDataQueue:=TDimDataQueue.Create;
 end;
 Result:=TheDimDataQueue;
end;

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

procedure Init_crw_dimq;
begin
end;

procedure Free_crw_dimq;
begin
 Kill(TheDimDataQueue);
end;

initialization

 Init_crw_dimq;

finalization

 Free_crw_dimq;

end.

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

