////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Data acquisition system tags database.                                     //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20020204 - Creation (uses CRW16) & test                                    //
// 20171115 - HashList to improve performance of FindTag                      //
// 20171202 - ReinitTags, use _HASH library and HashList_DefaultHasher        //
// 20190320 - LockTags,UnLockTags                                             //
// 20190321 - iAtomicTagOp,rAtomicTagOp                                       //
// 20200615 - CountTags                                                       //
// 20210423 - GetTagColor,GetTagParam,GetTagTimer                             //
// 20221116 - tag_type_nil,tag_type_int,tag_type_real,tag_type_string         //
// 20230523 - Modified for FPC (A.K.)                                         //
// 20230614 - SetTagsSpinlockCount                                            //
// 20250129 - Use TAtomicCounter                                              //
// 20260610 - GetTagCookie/SetTagCookie                                       //
// 20260801 - TagRange functions                                              //
////////////////////////////////////////////////////////////////////////////////

unit _crw_daqtags; // Data Acquision system tags.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, graphics,
 _crw_alloc, _crw_fifo, _crw_str, _crw_fio, _crw_hl,
 _crw_fpu, _crw_tgrng;

 {
 *******************************************************************************
 Daq tags is thread - safety database of common variables, uses by data
 acquisition system. Tags high protected against crash and errors.
 Each tag has:
  1) Unique name, a string to search variable by name from any thread.
  2) Unique reference, a integer value to access variable.
  3) Type of variable: 1=Integer, 2=Real=Double, 3=String.
  4) Value of specified type (iGetTag,rGetTag,sGetTag).
  5) Associated attributes (GetTagColor,GetTagParam,GetTagTimer,GetTagCookie).
 To access tag, you need find tag reference by known name via FindTag call and
 use this reference to access tag variable via xGetTag/xSetTag calls.
 If tag is not exists, FindTag returns 0, TypeTag returns 0, NameTag returns
 empty string.
 The typical code of tags usage are:
  var tag:Integer; Value:Double;
  begin
   tag:=FindTag('name');             // Find tag reference in database by name.
   if TypeTag(tag)=2 then begin      // Check, is tag of real type?
    Value:=rGetTag(tag);             // Read  real tag value.
    rSetTag(tag,Value);              // Write real tag value.
   end else Echo('Invalid tag!');    // Tag not found or has another type.
  end;
 Notes:
  1) Tag Cookie contains EOL separated list of key=value items.
  2) GetTagCookie returns Cookie list. Use CookieScan to extract key values.
  3) SetTagCookie UPDATEs Cookie list. Use SetTagCookie(ASCII_DEL) to clear.
  4) SetTagCookie modifies only keys/values passed in argument & keeps others.
 *******************************************************************************
 }

const
 OriginTags = 256;                       // Low range of tag index
 MaxNumTags = 1024 * 64;                 // Maximum namber of tags

function  TagBugs:SizeInt;               // Internal bugs (errors) counter
procedure SetTagBugs(aValue:SizeInt);    // For example, R/W wrong tag type

const                                    // For program logic consistency
 TAG_REF_MIN = OriginTags;               // Must be TAG_REF_MIN > TASK_REF_MAX = 255
 TAG_REF_MAX = OriginTags+MaxNumTags-1;  // Must be TAG_REF_MAX < ObjectRegistryOffset

const                                   // TypeTag values:
 tag_type_nil    = 0;                   // Tag not initialized or invalid
 tag_type_int    = 1;                   // Tag has Integer type => Integer
 tag_type_real   = 2;                   // Tag has Real    type => Double
 tag_type_string = 3;                   // Tag has String  type => AnsiString

procedure ClearTags;
function  CountTags:Integer;
function  UnifyTagAlias(Name:LongString):LongString;
function  FindTag(Name:LongString):Integer;
function  InitTag(Name:LongString; Typ:Integer):Integer;
function  FreeTag(tag:Integer):Boolean;
function  TypeTag(tag:Integer):Integer;
function  NameTag(tag:Integer):LongString;
function  iGetTag(tag:Integer):Integer;
function  rGetTag(tag:Integer):Double;
function  sGetTag(tag:Integer):LongString;
function  iSetTag(tag:Integer; i:Integer):Boolean;
function  rSetTag(tag:Integer; r:Double):Boolean;
function  sSetTag(tag:Integer; const s:LongString):Boolean;
function  GetTagColor(tag:Integer):Integer;
function  SetTagColor(tag:Integer; c:Integer):Boolean;
function  GetTagParam(tag:Integer):Double;
function  SetTagParam(tag:Integer; p:Double):Boolean;
function  GetTagTimer(tag:Integer):Double;
function  SetTagTimer(tag:Integer; t:Double):Boolean;
function  GetTagCookie(tag:Integer):LongString;
function  SetTagCookie(tag:Integer; const c:LongString):Boolean;
function  GetTagList(P:TText):TText;
procedure ReadTags(const IniFile,SectionName:LongString; Warnings:TText);
procedure ReadTagsRanges(const IniFile,SectionName:LongString; Warnings:TText);
procedure ReinitTags;
procedure LockTags;
procedure UnLockTags;
function  SetTagsSpinlockCount(SpinCount:Integer):Integer;

 {
 Atomic Tag Operations.
 op is operator ( + - * / ^ ) for Real,
 op is operator ( + - * / % & | ^ < > ) for Integer,
 Example: iAtomicTagOp(tag,'+',1); - atomic tag increment
 }
function iAtomicTagOp(tag:Integer; op:Char; arg:Integer):Boolean;
function rAtomicTagOp(tag:Integer; op:Char; arg:Double):Boolean;

 {
 TagRange routines.
 }
function GetTagRanges(tag,i:Integer):Double; overload;
function GetTagRanges(tag:Integer):TTagRangeEdges; overload;
function SetTagRanges(tag,i:Integer; X:Double):Boolean; overload;
function SetTagRanges(tag:Integer; const args:LongString):Boolean; overload;
function SetTagRanges(tag:Integer; const X:TTagRangeEdges):Boolean; overload;
function GetTagRangeColor(tag:Integer; Def:TColor=clNone):Integer;
function GetTagRangeIndex(tag:Integer):Integer;
function CalcTagRangeIndex(tag:Integer; x:Double):Integer;
function CalcTagRangeColor(tag:Integer; x:Double):Integer;
function TagRangeIndexToColor(tag:Integer; i:Integer):Integer;
function GetTagRangesColorsAsText(tag:Integer):LongString;
function SetTagRangesColorsAsText(tag:Integer; aColors:LongString):Boolean;

implementation

const
 AvailTyps = [tag_type_int,tag_type_real,tag_type_string];
 NumerTyps = [tag_type_int,tag_type_real];

var
 myLatch    : TSysCriticalSection = nil;
 myTags     : packed array[TAG_REF_MIN..TAG_REF_MAX] of packed record
               Typ    : Integer;
               Name   : LongString;
               iVal   : Integer;
               rVal   : Double;
               sVal   : LongString;
               Color  : Integer;
               Param  : Double;
               Timer  : Double;
               Cookie : LongString;
               Ranges : TTagRange;
              end;
 myTagCount : TAtomicCounter = nil;
 myHashBugs : TAtomicCounter = nil;
 myHashList : THashList      = nil;
 myTagBugs  : TAtomicCounter = nil;

procedure InitTagCounters;
begin
 LockedInit(myTagCount);
 LockedInit(myHashBugs);
 LockedInit(myTagBugs);
end;

procedure FreeTagCounters;
begin
 LockedFree(myTagCount);
 LockedFree(myHashBugs);
 LockedFree(myTagBugs);
end;

function TagBugs:SizeInt;
begin
 Result:=LockedGet(myTagBugs);
end;

procedure SetTagBugs(aValue:SizeInt);
begin
 LockedSet(myTagBugs,aValue);
end;

procedure InitTags;
begin
 try
  LockTags;
  try
   LockedSet(myTagCount,0);
   SafeFillChar(myTags,sizeof(myTags),0);
   myHashList:=NewHashList(true,HashList_DefaultHasher);
   myHashList.Master:=@myHashList;
   LockedSet(myHashBugs,0);
  finally
   UnLockTags;
  end;
 except
  on E:Exception do BugReport(E,nil,'InitTags');
 end;
end;

procedure FreeTags;
begin
 try
  LockTags;
  try
   ClearTags;
   LockedSet(myHashBugs,0);
   Kill(myHashList);
   LockedSet(myTagCount,0);
   SafeFillChar(myTags,sizeof(myTags),0);
  finally
   UnLockTags;
  end;
 except
  on E:Exception do BugReport(E,nil,'FreeTags');
 end;
end;

procedure ReinitTags;
begin
 try
  LockTags;
  try
   FreeTags;
   InitTags;
  finally
   UnLockTags;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReinitTags');
 end;
end;

procedure LockTags;
begin
 EnterCriticalSection(myLatch);
end;

procedure UnLockTags;
begin
 LeaveCriticalSection(myLatch);
end;

function  SetTagsSpinlockCount(SpinCount:Integer):Integer;
begin
 Result:=-1;
 {$IFDEF WINDOWS}
 if (SpinCount>=0) then Result:=SetCriticalSectionSpinCount(myLatch,SpinCount);
 {$ENDIF ~WINDOWS}
end;

procedure ClearTags;
var tag:Integer;
begin
 try
  EnterCriticalSection(myLatch);
  try
   for tag:=Low(myTags) to High(myTags) do FreeTag(tag);
   myHashList.Clear;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'ClearTags');
 end;
end;

function CountTags:Integer;
begin
 Result:=LockedGet(myTagCount);
end;

function UnifyTagAlias(Name:LongString):LongString;
begin
 Result:=UpCaseStr(Trim(Name));
end;

function  FindTag(Name:LongString):Integer;
var tag,i:Integer;
begin
 Result:=0;
 try
  EnterCriticalSection(myLatch);
  try
   Name:=UnifyTagAlias(Name);
   if IsNonEmptyStr(Name) then
   if Assigned(myHashList) then begin
    i:=myHashList.IndexOf(Name);
    if i>=0 then begin
     tag:=myHashList.Links[i];
     if (Low(myTags)<=tag) and (tag<=High(myTags)) then
     if (myTags[tag].Typ in AvailTyps) and IsSameText(myTags[tag].Name,Name)
     then Result:=tag else LockedInc(myHashBugs);
    end;
   end else // obsolete version
   for tag:=Low(myTags) to High(myTags) do
   if (myTags[tag].Typ in AvailTyps) and IsSameText(myTags[tag].Name,Name) then begin
    Result:=tag;
    break;
   end;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'FindTag');
 end;
end;

function  InitTag(Name:LongString; Typ:Integer):Integer;
var tag:Integer;
begin
 Result:=0;
 try
  EnterCriticalSection(myLatch);
  try
   Name:=UnifyTagAlias(Name);
   if (Typ in AvailTyps) and IsNonEmptyStr(Name) then begin
    tag:=FindTag(Name);
    if tag>0 then begin
     if TypeTag(tag)=Typ then Result:=tag;
    end else begin
     for tag:=Low(myTags) to High(myTags) do
     if (myTags[tag].Typ=0) and (Length(myTags[tag].Name)=0) then begin
      FreeTag(tag);
      if Assigned(myHashList) then begin
       myHashList.KeyedLinks[Name]:=tag;
      end;
      LockedInc(myTagCount);
      myTags[tag].Name:=Name;
      myTags[tag].Typ:=Typ;
      Result:=tag;
      break;
     end;
    end;
   end;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'InitTag');
 end;
end;

function  FreeTag(tag:Integer):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  try
   with myTags[tag] do begin
    if Assigned(myHashList) then begin
     if Name<>'' then myHashList.Delete(Name);
    end;
    if Typ>0 then LockedDec(myTagCount);
    Name:='';
    Typ:=0;
    iVal:=0;
    rVal:=0.0;
    sVal:='';
    Color:=0;
    Param:=0.0;
    Timer:=0.0;
    Cookie:='';
    Kill(Ranges);
   end;
   Result:=true;
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'FreeTag');
 end;
end;

function  TypeTag(tag:Integer):Integer;
begin
 Result:=0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  Result:=myTags[tag].Typ;
  LeaveCriticalSection(myLatch);
 end;
end;

function  NameTag(tag:Integer):LongString;
begin
 Result:='';
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then Result:=myTags[tag].Name;
  LeaveCriticalSection(myLatch);
 end;
end;

function  iGetTag(tag:Integer):Integer;
begin
 Result:=0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ = tag_type_int then Result:=myTags[tag].iVal else LockedInc(myTagBugs);
  LeaveCriticalSection(myLatch);
 end;
end;

function  rGetTag(tag:Integer):Double;
begin
 Result:=0.0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ = tag_type_real then Result:=myTags[tag].rVal else LockedInc(myTagBugs);
  LeaveCriticalSection(myLatch);
 end;
end;

function  sGetTag(tag:Integer):LongString;
begin
 Result:='';
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  try
   if myTags[tag].Typ = tag_type_string then Result:=myTags[tag].sVal else LockedInc(myTagBugs);
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'sGetTag');
 end;
end;

function  iSetTag(tag:Integer; i:Integer):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ = tag_type_int then begin
   myTags[tag].iVal:=i;
   Result:=true;
  end else LockedInc(myTagBugs);
  LeaveCriticalSection(myLatch);
 end;
end;

function  rSetTag(tag:Integer; r:Double):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ = tag_type_real then begin
   myTags[tag].rVal:=r;
   Result:=true;
  end else LockedInc(myTagBugs);
  LeaveCriticalSection(myLatch);
 end;
end;

function  sSetTag(tag:Integer; const s:LongString):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  try
   if myTags[tag].Typ = tag_type_string then begin
    myTags[tag].sVal:=s;
    Result:=true;
   end else LockedInc(myTagBugs);
  finally
   LeaveCriticalSection(myLatch);
  end;
 except
  on E:Exception do BugReport(E,nil,'sSetTag');
 end;
end;

function  GetTagColor(tag:Integer):Integer;
begin
 Result:=0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then Result:=myTags[tag].Color;
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagColor(tag:Integer; c:Integer):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then begin
   myTags[tag].Color:=c;
   Result:=true;
  end;
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagParam(tag:Integer):Double;
begin
 Result:=0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then Result:=myTags[tag].Param;
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagParam(tag:Integer; p:Double):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then begin
   myTags[tag].Param:=p;
   Result:=true;
  end;
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagTimer(tag:Integer):Double;
begin
 Result:=0;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then Result:=myTags[tag].Timer;
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagTimer(tag:Integer; t:Double):Boolean;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then begin
   myTags[tag].Timer:=t;
   Result:=true;
  end;
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagCookie(tag:Integer):LongString;
begin
 Result:='';
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in AvailTyps then Result:=myTags[tag].Cookie;
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagCookie(tag:Integer; const c:LongString):Boolean;
var Mode:Integer;
begin
 Result:=false;
 if (tag>=Low(myTags)) and (tag<=High(myTags)) then begin
  EnterCriticalSection(myLatch);
  try
   Mode:=Ord(';') or csm_Default;
   if myTags[tag].Typ in AvailTyps then begin
    if (c=ASCII_DEL)
    then myTags[tag].Cookie:=''
    else myTags[tag].Cookie:=CookieUpdate(myTags[tag].Cookie,c,Mode);
    Result:=True;
   end;
  finally
   LeaveCriticalSection(myLatch);
  end;
 end;
end;

function  GetTagList(P:TText):TText;
var i,m:Integer;
begin
 Result:=P;
 if P is TText then
 try
  m:=3;
  for i:=Low(myTags) to High(myTags) do m:=max(m,Length(NameTag(i)));
  P.Addln(Pad('ИМЯ',m)+' ¦ ТИП     ¦ ЗНАЧЕНИЕ');
  for i:=Low(myTags) to High(myTags) do begin
   case TypeTag(i) of
    tag_type_int:    P.Addln(Pad(NameTag(i),m)+' ¦ INTEGER ¦ '+format('%d',[iGetTag(i)]));
    tag_type_real:   P.Addln(Pad(NameTag(i),m)+' ¦ REAL    ¦ '+format('%g',[rGetTag(i)]));
    tag_type_string: P.Addln(Pad(NameTag(i),m)+' ¦ STRING  ¦ '+sGetTag(i));
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetTagList');
 end;
end;

procedure AddTag(Index:LongInt; const TextLine:LongString; var Terminate:boolean; CustomData:Pointer);
var tag,err:Integer; SName,SType,SValu:LongString; d:LongInt; r:double; tmp:TParsingBuffer;
begin
 if IsNonEmptyStr(TextLine) then
 try
  err:=0; d:=0; r:=0;
  SName:=ExtractWord(1,TextLine,ScanSpaces);
  if SName<>'' then begin
   SType:=UpcaseStr(ExtractWord(2,TextLine,ScanSpaces));
   if SType<>'' then begin
    SValu := ExtractWord(3,TextLine,ScanSpaces);
    if SameText(SType,'INTEGER') then begin
     tag:=findtag(SName);              if tag>0 then inc(err);
     tag:=inittag(SName,tag_type_int); if tag=0 then inc(err);
     if SValu<>'' then
     if not ((ScanVarLongInt(svAsIs,StrCopyBuff(tmp,SValu),'%d',d)<>nil) and iSetTag(tag,d)) then inc(err);
    end else
    if SameText(SType,'REAL') then  begin
     tag:=findtag(SName);               if tag>0 then inc(err);
     tag:=inittag(SName,tag_type_real); if tag=0 then inc(err);
     if SValu<>'' then
     if not ((ScanVarDouble(svAsIs,StrCopyBuff(tmp,SValu),'%f',r)<>nil) and rSetTag(tag,r)) then inc(err);
    end else
    if SameText(SType,'STRING') then  begin
     tag:=findtag(SName);                 if tag>0 then inc(err);
     tag:=inittag(SName,tag_type_string); if tag=0 then inc(err);
     if not sSetTag(tag,SValu) then inc(err);
    end;
   end;
  end;
  if (err<>0) and TText(CustomData).Ok
  then TText(CustomData).Addln('Can~t init TAG -> "'+TextLine+'"');
 except
  on E:Exception do BugReport(E,nil,'AddTag');
 end;
end;

procedure ReadTags(const IniFile,SectionName:LongString; Warnings:TText);
var P:TText;
begin
 if IsNonEmptyStr(IniFile) and IsNonEmptyStr(SectionName) then
 try
  P:=ExtractListSection(IniFile,SectionName,efConfig);
  if Assigned(P) then
  try
   P.ForEach(AddTag,Warnings);
  finally
   Kill(P);
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadTags');
 end;
end;

procedure AddTagRange(Index:LongInt; const TextLine:LongString; var Terminate:boolean; CustomData:Pointer);
var tag,err,p:Integer; SName,SExpr:LongString;
begin
 if IsNonEmptyStr(TextLine) then
 try
  err:=0; tag:=0; SName:=''; SExpr:='';
  p:=ExtractNameValuePair(TextLine,SName,SExpr);
  if (p>0) and IsNonEmptyStr(SName) and IsNonEmptyStr(SExpr) then begin
   tag:=findtag(SName);
   case TypeTag(tag) of
    tag_type_int,tag_type_real: begin
     if not SetTagRanges(tag,SExpr) then Inc(err);
    end;
    else inc(err);
   end;
  end;
  if (err<>0) and TText(CustomData).Ok
  then TText(CustomData).Addln('Can~t init TAG RANGE -> "'+TextLine+'"');
 except
  on E:Exception do BugReport(E,nil,'AddTagRange');
 end;
end;

procedure ReadTagsRanges(const IniFile,SectionName:LongString; Warnings:TText);
var P:TText;
begin
 if IsNonEmptyStr(IniFile) and IsNonEmptyStr(SectionName) then
 try
  P:=ExtractListSection(IniFile,SectionName,efConfig);
  if Assigned(P) then
  try
   P.ForEach(AddTagRange,Warnings);
  finally
   Kill(P);
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadTagsRanges');
 end;
end;

function iAtomicTagOp(tag:Integer; op:Char; arg:Integer):Boolean;
begin
 Result:=false;
 if (TypeTag(tag)=tag_type_int) then
 try
  if (op in ['/','%']) then if (arg=0) then Exit; // Prevent EDivByZero
  case op of
   '+' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) +   arg); finally UnLockTags; end; end;
   '-' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) -   arg); finally UnLockTags; end; end;
   '*' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) *   arg); finally UnLockTags; end; end;
   '/' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) div arg); finally UnLockTags; end; end;
   '%' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) mod arg); finally UnLockTags; end; end;
   '&' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) and arg); finally UnLockTags; end; end;
   '|' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) or  arg); finally UnLockTags; end; end;
   '^' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) xor arg); finally UnLockTags; end; end;
   '<' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) shl arg); finally UnLockTags; end; end;
   '>' : begin LockTags; try Result:=iSetTag(tag,iGetTag(tag) shr arg); finally UnLockTags; end; end;
  end;
 except
  on E:Exception do BugReport(E,nil,'iAtomicTagOp');
 end;
end;

function rAtomicTagOp(tag:Integer; op:Char; arg:Double):Boolean;
begin
 Result:=false;
 if TypeTag(tag)=tag_type_real then
 try
  case op of
   '+' : begin LockTags; try Result:=rSetTag(tag,rGetTag(tag) +   arg);    finally UnLockTags; end; end;
   '-' : begin LockTags; try Result:=rSetTag(tag,rGetTag(tag) -   arg);    finally UnLockTags; end; end;
   '*' : begin LockTags; try Result:=rSetTag(tag,rGetTag(tag) *   arg);    finally UnLockTags; end; end;
   '/' : begin LockTags; try Result:=rSetTag(tag,rGetTag(tag) /   arg);    finally UnLockTags; end; end;
   '^' : begin LockTags; try Result:=rSetTag(tag,Power(rGetTag(tag),arg)); finally UnLockTags; end; end;
  end;
 except
  on E:Exception do BugReport(E,nil,'rAtomicTagOp');
 end;
end;

function  GetTagRanges(tag:Integer):TTagRangeEdges;
begin
 TTagRange.ResetEdges(Result);
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  Result:=myTags[tag].Ranges.Edges;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagRanges(tag,i:Integer):Double;
begin
 Result:=_Nan;
 if InRange(i,Low(TTagRangeIndex),High(TTagRangeIndex)) then
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  Result:=myTags[tag].Ranges.Edge[i];
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagRanges(tag,i:Integer; X:Double):Boolean;
begin
 Result:=False;
 if InRange(i,Low(TTagRangeIndex),High(TTagRangeIndex)) then
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in NumerTyps then begin
   if not Assigned(myTags[tag].Ranges) then begin
    myTags[tag].Ranges:=NewTagRange;
    myTags[tag].Ranges.Master:=@myTags[tag].Ranges;
   end;
   myTags[tag].Ranges.Edge[i]:=X;
   Result:=True;
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagRanges(tag:Integer; const X:TTagRangeEdges):Boolean;
begin
 Result:=False;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in NumerTyps then begin
   if not Assigned(myTags[tag].Ranges) then begin
    myTags[tag].Ranges:=NewTagRange;
    myTags[tag].Ranges.Master:=@myTags[tag].Ranges;
   end;
   myTags[tag].Ranges.Edges:=X;
   Result:=True;
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagRanges(tag:Integer; const args:LongString):Boolean;
begin
 Result:=False;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if myTags[tag].Typ in NumerTyps then begin
   if not Assigned(myTags[tag].Ranges) then begin
    myTags[tag].Ranges:=NewTagRange;
    myTags[tag].Ranges.Master:=@myTags[tag].Ranges;
   end;
   Result:=myTags[tag].Ranges.AssignFromString(args);
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagRangeIndex(tag:Integer):Integer;
begin
 Result:=tgrng_M0;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if Assigned(myTags[tag].Ranges) then
  case myTags[tag].Typ of
   tag_type_int:  Result:=myTags[tag].Ranges.RangeIndex(myTags[tag].iVal);
   tag_type_real: Result:=myTags[tag].Ranges.RangeIndex(myTags[tag].rVal);
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  GetTagRangeColor(tag:Integer; Def:TColor=clNone):Integer;
begin
 Result:=Def;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if Assigned(myTags[tag].Ranges) then
  case myTags[tag].Typ of
   tag_type_int:  Result:=myTags[tag].Ranges.RangeColor(myTags[tag].iVal,Def);
   tag_type_real: Result:=myTags[tag].Ranges.RangeColor(myTags[tag].rVal,Def);
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  CalcTagRangeIndex(tag:Integer; x:Double):Integer;
begin
 Result:=tgrng_M0;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  Result:=myTags[tag].Ranges.RangeIndex(x);
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  CalcTagRangeColor(tag:Integer; x:Double):Integer;
var i:Integer;
begin
 Result:=tgrng_M0;
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  i:=myTags[tag].Ranges.RangeIndex(x);
  Result:=myTags[tag].Ranges.IndexToColor(i);
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function TagRangeIndexToColor(tag:Integer; i:Integer):Integer;
begin
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if Assigned(myTags[tag].Ranges)
  then Result:=myTags[tag].Ranges.IndexToColor(i)
  else TTagRange.DefIndexToColor(i);
 finally
  LeaveCriticalSection(myLatch);
 end
 else Result:=TTagRange.DefIndexToColor(i);
end;

function  GetTagRangesColorsAsText(tag:Integer):LongString;
begin
 Result:='';
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  Result:=myTags[tag].Ranges.ColorsAsText;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

function  SetTagRangesColorsAsText(tag:Integer; aColors:LongString):Boolean;
begin
 if IsNonEmptyStr(aColors) then
 if InRange(tag,Low(myTags),High(myTags)) then
 try
  EnterCriticalSection(myLatch);
  if myTags[tag].Ranges.ValidColors(aColors) then begin
   myTags[tag].Ranges.ColorsAsText:=aColors;
   Result:=True;
  end;
 finally
  LeaveCriticalSection(myLatch);
 end;
end;

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

procedure Init_crw_daqtags;
begin
 InitTagCounters;
 InitCriticalSection(myLatch);
 InitTags;
end;

procedure Free_crw_daqtags;
begin
 FreeTags;
 DoneCriticalSection(myLatch);
 ResourceLeakageLog(Format('%-60s = %d',['DAQ Tags HashList Bugs',LockedGet(myHashBugs)]));
 FreeTagCounters;
end;

initialization

 Init_crw_daqtags;

finalization

 Free_crw_daqtags;

end.

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

