Monday, October 3, 2011

TInterlocked

 Delphi XE2? has out of the box the TInterlocked helper functions, but prior to that there is only the Windows API, what's why I have my own version TInterlockedEx:


{ TInterlockedEx }

class function TInterlockedEx.CAS(var aTarget: integer; aCurrentVal, aNewVal: integer): boolean;
begin
  {
  //Compare, if equal then set and return TRUE
  if aTarget = aCurrentVal then
  begin
    aTarget := aNewVal;
    result := true;
  else
    result := false;
  }

  result := InterlockedCompareExchange(aTarget, aNewVal, aCurrentVal) = aCurrentVal;
end;

class procedure TInterlockedEx.Add(var aValue: integer; aCounter: integer);
//EDX,ECX
{$IFDEF WIN32}
ASM
  LOCK  XADD [EDX], ECX
  MOV   EAX, [EDX]
END;
{$ELSE}
begin
  _Lock.Lock;
  try
    System.Inc(aValue, aCounter);
  finally
    _Lock.Unlock;
  end;
end;
{$ENDIF}

{$IFDEF WIN32}
class function TInterlockedEx.CAS(var aTarget: pointer; aCurrentVal, aNewVal: pointer): boolean;
begin
  result := CAS(integer(aTarget), integer(aCurrentVal), integer(aNewVal));
end;

class function TInterlockedEx.CAS(var aTarget: TObject; aCurrentVal, aNewVal: TObject): boolean;
begin
  result := CAS(integer(aTarget), integer(aCurrentVal), integer(aNewVal));
end;
{$ENDIF}

class function TInterlockedEx.Dec(var aValue: integer): integer;
begin
  result := InterlockedDecrement(aValue);
end;

class function TInterlockedEx.Inc(var aValue: int64): integer;
begin
  if _Lock <> nil then  //This is also call by _Lock.Create(), that's why we check first
    _Lock.Lock;
  try
    System.Inc(aValue);
    result := aValue;
  finally
    if _Lock <> nil then
      _Lock.Unlock;
  end;
end;

class function TInterlockedEx.Exchange(var aValA, aValB: integer): integer;
begin
  result := InterlockedExchange(aValA, aValB);
end;

class procedure TInterlockedEx.Sub(var aValue: integer; aCounter: integer);
//EDX,ECX
{$IFDEF WIN32}
ASM
  NEG   ECX //1-3 = 1+(-3)
  LOCK  XADD [EDX], ECX
  MOV   EAX, [EDX]
END;
{$ELSE}
begin
  _Lock.Lock;
  try
    System.Dec(aValue, aCounter);
  finally
    _Lock.Unlock;
  end;
end;
{$ENDIF}

class function TInterlockedEx.Inc(var aValue: integer): integer;
begin
  result := InterlockedIncrement(aValue);
end;

class function TInterlockedEx.CAS(var aTarget: LongBool; aCurrentVal, aNewVal: LongBool): boolean;
begin
  result := CAS(integer(aTarget), integer(aCurrentVal), integer(aNewVal));
end;

class function TInterlockedEx.CAS(var aTarget: cardinal; aCurrentVal, aNewVal: cardinal): boolean;
begin
  result := CAS(integer(aTarget), integer(aCurrentVal), integer(aNewVal));
end;

class function TInterlockedEx.Dec(var aValue: int64): integer;
begin
  _Lock.Lock;
  try
    System.Dec(aValue);
    result := aValue;
  finally
    _Lock.Unlock;
  end;
end;

It works for 32 bits (with optimized assembler) and also for 64 bits (not so optimized yet...)

No comments:

Post a Comment