////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// FEBUS - fast event bus. Uses share memory for fast data event transfer.    //
////////////////////////////////////////////////////////////////////////////////

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

unit _crw_febus; //  Fast event bus

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_ef, _crw_str, _crw_fio, _crw_dynar, _crw_sharm;

{$IFDEF SKIP_DRAFT}
TODO: FEBUS implementation
{$ENDIF ~SKIP_DRAFT}

const
 RAM_PAGE_SIZE = 1024*4;            // Memory page size, 4K for x86
 FEB_CBLK_SIZE = 1024*1;            // FEBUS Control Block size
 FEB_HEAD_SIZE = RAM_PAGE_SIZE*16;  // FEBUS header size for Cookie
 FEB_COOK_SIZE = FEB_HEAD_SIZE-FEB_CBLK_SIZE; // Cookie buffer size
 FEB_MAXB_SIZE = 1024*1024*256;     // FEBUS maximal buffer size

type
 TFebusFormat = packed array[0..31] of Char; // Format
 TFebusCookie = packed array[0..FEB_COOK_SIZE-1] of Char;
 PFebusCB = ^TFebusCB;          //////////////////////
 TFebusCB = packed record       // FEBUS Control Block
  case LongInt of               //////////////////////
  0: (                          // FEBUS Control Block
   RingHead : QWord;            // DataRing head count
   RingTail : QWord;            // DataRing tail count
   cwrCount : LongInt;          // Cookie writer count
   dwrCount : LongInt;          // Data   writer count
   DataSize : LongInt;          // Data Buffer -- size
   EvntSize : LongInt;          // DataEvent byte size
   EvntFrmt : TFebusFormat      // EventFormat I:2;D:2
     );                         //////////////////////
  1: (                          // ControlBlockRawData
   Raw      : packed array[0..FEB_CBLK_SIZE-1] of Char;
     );                         //////////////////////
 end;                           //////////////////////
 PFebusHead = ^TFebusHead;      //////////////////////
 TFebusHead = packed record     // FEBUS Head
  case LongInt of               //////////////////////
  0: (                          // FEBUS Head
   CBlock : TFebusCB;           // FEBUS Control Block
   Cookie : TFebusCookie        // FEBUS Cookie Buffer
     );                         //////////////////////
  1: (                          // FEBUS Head Raw data
   Raw    : packed array[0..FEB_HEAD_SIZE-1] of Char;
     );                         //////////////////////
 end;                           //////////////////////
 PFebusBuffer = ^TFebusBuffer;  //////////////////////
 TFebusBuffer = packed record   // FEBUS Events Buffer
  Head : TFebusHead;            // ControlBlock+Cookie
  Data : record end;            // Events: Data Buffer
 end;                           //////////////////////

type
 TFebusIO = class(TMasterObject)
 private
  myIsServer : Boolean;
  myEvntCpct : Integer;
  myEvntSize : Integer;
  myEvntFrmt : LongString;
  myBuffer   : PFebusBuffer;
  mySharm    : TSharedMemory;
 public
  constructor Create(const aName:LongString; const aFormat:LongString;
                     aCapacity:Integer; aIsServer:Boolean; aMode:Integer=0);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  class function SpecCharSize(c:Char):LongInt;
  class function CalcFormatSize(const aFormat:LongString):LongInt;
 end;

procedure Kill(var TheObject:TFebusIO); overload;

 ///////////////////////////////////////////////
 // Full list of all existing TFebusIO instances
 ///////////////////////////////////////////////
function  FullFebusIOList:TObjectStorage;

////////////////////////////////////////////////////////////
// Fast Event BUS API
// febus_init(arg) - init with (arg), return reference or 0
//  arg='CLIENT name FORMAT i:2;d:2 BUFFER size'
//  arg='SERVER name FORMAT i:2;d:2 BUFFER size'
// febus_free(feb) - free reference (feb)
////////////////////////////////////////////////////////////

function febus_init(arg:String):Integer;
function febus_ref(feb:Integer):TFebusIO;
function febus_free(feb:Integer):Boolean;
function febus_ctrl(feb:Integer; arg:String):String;
function febus_rget(feb:Integer; offs:Integer):Double;
function febus_iget(feb:Integer; offs:Integer):Integer;
function febus_rset(feb:Integer; offs:Integer; v:Double):Boolean;
function febus_iset(feb:Integer; offs:Integer; v:Integer):Boolean;
function febus_valid(feb:Integer):Boolean;
function febus_count(feb:Integer):Integer;
function febus_space(feb:Integer):Integer;
function febus_push(feb:Integer):Boolean;
function febus_pop(feb:Integer):Boolean;

implementation

function MinPowerOfTwo(n:Integer):Integer;
begin
 Result:=1; while (Result<n) do Result:=Result shl 1;
end;

constructor TFebusIO.Create(const aName:LongString; const aFormat:LongString;
                     aCapacity:Integer; aIsServer:Boolean; aMode:Integer=0);
var aSize,aLeng:SizeInt;
begin
 inherited Create;
 myIsServer:=aIsServer;
 myEvntFrmt:=Trim(aFormat);
 myEvntCpct:=MinPowerOfTwo(aCapacity);
 myEvntSize:=CalcFormatSize(myEvntFrmt);
 aSize:=myEvntCpct*myEvntSize+FEB_HEAD_SIZE;
 aSize:=EnsureRange(aSize,FEB_HEAD_SIZE,FEB_MAXB_SIZE);
 aSize:=AdjustBufferSize(aSize,RAM_PAGE_SIZE);
 mySharm:=TSharedMemory.Create(aName,aSize,aMode);
 mySharm.Master:=@mySharm;
 myBuffer:=mySharm.Data;
end;

destructor TFebusIO.Destroy;
begin
 myBuffer:=nil;
 Kill(mySharm);
 myEvntFrmt:='';
 inherited Destroy;
end;

procedure TFebusIO.AfterConstruction;
begin
 inherited AfterConstruction;
 FullFebusIOList.Add(Self);
end;

procedure TFebusIO.BeforeDestruction;
begin
 FullFebusIOList.Remove(Self);
 inherited BeforeDestruction;
end;

class function TFebusIO.SpecCharSize(c:Char):LongInt;
begin
 case c of
  'l','L': Result:=SizeOf(LongInt);
  'i','I': Result:=SizeOf(LongInt);
  'd','D': Result:=SizeOf(Double);
  else     Result:=0;
 end;
end;

function fmtIter(n:SizeInt;Line:LongString;Custom:Pointer):Boolean;
var DataSize:PLongInt; sn,sv:LongString; p,l,m:LongInt;
begin
 Result:=true; DataSize:=Custom;
 if IsEmptyStr(Line) then Exit(true);
 p:=ExtractNameValuePair(Line,sn,sv);
 if not Assigned(DataSize) then Exit(false);
 if (p=0) then l:=1 else l:=StrToIntDef(sv,0);
 if (Length(sn)>1) then m:=0 else m:=TFebusIO.SpecCharSize(StrFetch(sn,1));
 if (l<1) or (m<1) then begin DataSize^:=0; Exit(false); end;
 Inc(DataSize^,l*m);
end;

 // Format like: 'I:2;D:2'. Format is char case insensitive.
 // Format rule: TypeSpec1[:Repeater1];TypeSpec2[:Repeater2];…
 // TypeSpec = type specificator [I,L,D]=[Integer=LongInt,Double].
 // Repeater = optional data item repeater, default = 1.
class function TFebusIO.CalcFormatSize(const aFormat:LongString):LongInt;
var Buff:LongString;
begin
 Result:=0;
 if (aFormat<>'') then begin
  Buff:=aFormat;
  Buff:=StringReplace(Buff,';',EOL,[rfReplaceAll]);
  Buff:=StringReplace(Buff,':','=',[rfReplaceAll]);
  ForEachStringLine(Buff,fmtIter,@Result);
 end;
end;

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

/////////////////
// FEBUS easy API
/////////////////

function febus_init(arg:String):Integer;
begin
 Result:=0;
end;

function febus_ref(feb:Integer):TFebusIO;
var Obj:TObject;
begin
 if (feb<>0) then Obj:=ObjectRegistry[feb] else Obj:=nil;
 if (Obj is TFebusIO) then Result:=TFebusIO(Obj) else Result:=nil;
end;

function febus_free(feb:Integer):Boolean;
begin
 Result:=false;
end;

function febus_ctrl(feb:Integer; arg:String):String;
begin
 Result:='';
end;

function febus_rget(feb:Integer; offs:Integer):Double;
begin
 Result:=0;
end;

function febus_iget(feb:Integer; offs:Integer):Integer;
begin
 Result:=0;
end;

function febus_rset(feb:Integer; offs:Integer; v:Double):Boolean;
begin
 Result:=false;
end;

function febus_iset(feb:Integer; offs:Integer; v:Integer):Boolean;
begin
 Result:=false;
end;

function febus_valid(feb:Integer):Boolean;
begin
 Result:=false;
end;

function febus_count(feb:Integer):Integer;
begin
 Result:=0;
end;

function febus_space(feb:Integer):Integer;
begin
 Result:=0;
end;

function febus_push(feb:Integer):Boolean;
begin
 Result:=false;
end;

function febus_pop(feb:Integer):Boolean;
begin
 Result:=false;
end;

 /////////////////////////////////
 // FullFebusIOList implementation
 /////////////////////////////////
const
 TheFullFebusIOList : TObjectStorage = nil;

function FullFebusIOList:TObjectStorage;
begin
 if not Assigned(TheFullFebusIOList) then begin
  TheFullFebusIOList:=NewObjectStorage(false);
  TheFullFebusIOList.Master:=@TheFullFebusIOList;
  TheFullFebusIOList.OwnsObjects:=false;
 end;
 Result:=TheFullFebusIOList;
end;

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

procedure Init_crw_febus;
begin
 FullFebusIOList.Ok;
end;

procedure Free_crw_febus;
begin
 Kill(TheFullFebusIOList);
end;

initialization

 Init_crw_febus;

finalization

 Free_crw_febus;

end.

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

