Showing posts with label TInterlockedEx. Show all posts
Showing posts with label TInterlockedEx. Show all posts

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...)