TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?

[Sir Rufo]

Dann brauchst du das, was hier beschrieben ist
Working with TMultiReadExclusiveWriteSynchronizer

[Zacherl]

Habe mir jetzt für die primitiven Typen mal folgendes Konstrukt gebastelt. Damit kann ich alle Ordinaltypen, sowie Enums und Booleans meinen Vorstellungen entsprechend (und sehr performant) synchronisieren:

Delphi-Quellcode:

{$DEFINE ATOMIC_TYPE_CHECK}
{$IFDEF ATOMIC_TYPE_CHECK}
const
  AllowedAtomicTypes   = [tkEnumeration, tkRecord, tkFloat, tkInteger, tkChar, tkWChar];
  AllowedAtomicTypes64 = [tkEnumeration, tkRecord, tkFloat, tkInt64];
{$ENDIF}
type
  {**
   * @brief Implements an atomic ordinal value with a maximum size of 4 bytes.
   * }
  TAtomicOrdinal<T> = record
  strict private type
    PUInt32 = ^UInt32;
    PType   = ^T;
  strict private
    FValue: UInt32;
  strict private
    procedure CheckRequirements; inline;
    procedure CheckArithmetical; inline;
  public
    {**
     * @brief   Returns the value of the current @c TAtomicOrdinal instance. This operation is NOT
     *          atomic.
     * @return  The value of the current @c TAtomicOrdinal instance.
     *
     * Use this method only, if no other thread can ever change the value of the current
     * @c TAtomicOrdinal instance at the same time.
     * }
    function GetValue: T; inline;
    {**
     * @brief   Returns the value of the current @c TAtomicOrdinal instance. This operation is
     *          atomic.
     * @return  The value of the current @c TAtomicOrdinal instance.
     * }
    function AtomicGetValue: T; inline;
    {**
     * @brief   Sets the value of the current @c TAtomicOrdinal instance. This operation is NOT
     *          atomic.
     *
     * Use this method only, if no other thread can ever read or change the value of the current
     * @c TAtomicOrdinal instance at the same time.
     * }
    procedure SetValue(const Value: T); inline;
    {**
     * @brief   Sets the value of the current @c TAtomicOrdinal instance. This operation is
     *          atomic.
     * }
    procedure AtomicSetValue(const Value: T); inline;
  public
    {**
     * @brief   Exchanges the value of the current @c TAtomicOrdinal instance. This operation is
     *          atomic.
     * @param   Value The new value.
     * @return  The old value of the current @c TAtomicOrdinal instance.
     * }
    function AtomicExchangeValue(Value: T): T; inline;
    function AtomicCompareExchangeValue(NewValue: T; Comparand: T): T; inline;
  public
    {**
     * @brief   Adds to the value of the current @c TAtomicOrdinal instance. This operation is
     *          atomic.
     * @param   Value The summand.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicAdd(Value: T); inline;
    {**
     * @brief   Subtracts from the value of the current @c TAtomicOrdinal instance. This operation
     *          is atomic.
     * @param   Value The subtrahend.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicSubtract(Value: T); inline;
    {**
     * @brief   Increments the value of the current @c TAtomicOrdinal instance by one. This
     *          operation is atomic.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicInc; inline;
    {**
     * @brief   Decrements the value of the current @c TAtomicOrdinal instance by one. This
     *          operation is atomic.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicDec; inline;
  public
    {**
     * @brief   Implicit cast to the generic type. This operation is atomic.
     * @param   A The @c TAtomicOrdinal type
     * @return  The generic type value.
     * }
    class operator Implicit(A: TAtomicOrdinal<T>): T; inline;
    {**
     * @brief   Equality check. The read operation from the @c A instance is atomic. The
     *          comparison itself works with a temporal snapshot of the @c A value.
     * @param   A The @c TAtomicOrdinal type
     * @param   B The generic type to compare with.
     * @return  True, if the values are equal, false if not.
     * }
    class operator Equal(A: TAtomicOrdinal<T>; B: T): Boolean; inline;
  end;

  {**
   * @brief Implements an atomic ordinal value with a size of 8 bytes.
   * }
  TAtomicOrdinal64<T> = record
  strict private type
    PUInt64 = ^UInt64;
    PType   = ^T;
  strict private
    FValue: UInt64;
  strict private
    procedure CheckRequirements; inline;
    procedure CheckArithmetical; inline;
  public
    {**
     * @brief   Returns the value of the current @c TAtomicOrdinal64 instance. This operation is
     *          NOT atomic.
     * @return  The value of the current @c TAtomicOrdinal64 instance.
     *
     * Use this method only, if no other thread can ever change the value of the current
     * @c TAtomicOrdinal64 instance at the same time.
     * }
    function GetValue: T; inline;
    {**
     * @brief   Returns the value of the current @c TAtomicOrdinal64 instance. This operation is
     *          atomic.
     * @return  The value of the current @c TAtomicOrdinal64 instance.
     * }
    function AtomicGetValue: T; inline;
    {**
     * @brief   Sets the value of the current @c TAtomicOrdinal64 instance. This operation is NOT
     *          atomic.
     *
     * Use this method only, if no other thread can ever read or change the value of the current
     * @c TAtomicOrdinal64 instance at the same time.
     * }
    procedure SetValue(const Value: T); inline;
    {**
     * @brief   Sets the value of the current @c TAtomicOrdinal64 instance. This operation is
     *          atomic.
     * }
    procedure AtomicSetValue(const Value: T); inline;
  public
    {**
     * @brief   Exchanges the value of the current @c TAtomicOrdinal64 instance. This operation is
     *          atomic.
     * @param   Value The new value.
     * @return  The old value of the current @c TAtomicOrdinal64 instance.
     * }
    function AtomicExchangeValue(Value: T): T; inline;
    function AtomicCompareExchangeValue(NewValue: T; Comparand: T): T; inline;
  public
    {**
     * @brief   Adds to the value of the current @c TAtomicOrdinal64 instance. This operation is
     *          atomic.
     * @param   Value The summand.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicAdd(Value: T); inline;
    {**
     * @brief   Subtracts from the value of the current @c TAtomicOrdinal64 instance. This operation
     *          is atomic.
     * @param   Value The subtrahend.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicSubtract(Value: T); inline;
    {**
     * @brief   Increments the value of the current @c TAtomicOrdinal64 instance by one. This
     *          operation is atomic.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicInc; inline;
    {**
     * @brief   Decrements the value of the current @c TAtomicOrdinal64 instance by one. This
     *          operation is atomic.
     *
     * Do not use this method for non-integer types.
     * }
    procedure AtomicDec; inline;
  public
    {**
     * @brief   Implicit cast to the generic type. This operation is atomic.
     * @param   A The @c TAtomicOrdinal64 type
     * @return  The generic type value.
     * }
    class operator Implicit(A: TAtomicOrdinal64<T>): T; inline;
    {**
     * @brief   Equality check. The read operation from the @c A instance is atomic. The
     *          comparison itself works with a temporal snapshot of the @c A value.
     * @param   A The @c TAtomicOrdinal64 type
     * @param   B The generic type to compare with.
     * @return  True, if the values are equal, false if not.
     * }
    class operator Equal(A: TAtomicOrdinal64<T>; B: T): Boolean; inline;
  end;

  TAtomicUInt8   = TAtomicOrdinal<UInt8>;
  TAtomicUInt16  = TAtomicOrdinal<UInt16>;
  TAtomicUInt32  = TAtomicOrdinal<UInt32>;
  TAtomicUInt64  = TAtomicOrdinal64<UInt64>;
  TAtomicInt8    = TAtomicOrdinal<Int8>;
  TAtomicInt16   = TAtomicOrdinal<Int16>;
  TAtomicInt32   = TAtomicOrdinal<Int32>;
  TAtomicInt64   = TAtomicOrdinal64<Int64>;
  TAtomicBoolean = TAtomicOrdinal<LongBool>;
  TAtomicSingle  = TAtomicOrdinal<Single>;
  TAtomicDouble  = TAtomicOrdinal<Double>;

{ TAtomicOrdinal<T> }

procedure TAtomicOrdinal<T>.AtomicAdd(Value: T);
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicIncrement(FValue, PUInt32(@Value)^);
end;

function TAtomicOrdinal<T>.AtomicCompareExchangeValue(NewValue, Comparand: T): T;
var
  Value: UInt32;
begin
  CheckRequirements;
  Value := AtomicCmpExchange(FValue, PUInt32(@NewValue)^, PUInt32(@Comparand)^);
  Result := PType(@Value)^;
end;

function TAtomicOrdinal<T>.AtomicExchangeValue(Value: T): T;
begin
  CheckRequirements;
  Result := PType(AtomicExchange(FValue, PUInt32(@Value)^))^;
end;

function TAtomicOrdinal<T>.AtomicGetValue: T;
begin
  CheckRequirements;
  Result := PType(@FValue)^;
end;

class operator TAtomicOrdinal<T>.Implicit(A: TAtomicOrdinal<T>): T;
begin
  Result := A.AtomicGetValue;
end;

procedure TAtomicOrdinal<T>.AtomicInc;
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicIncrement(FValue);
end;

procedure TAtomicOrdinal<T>.SetValue(const Value: T);
begin
  CheckRequirements;
  FValue := PUInt32(@Value)^;
end;

procedure TAtomicOrdinal<T>.AtomicSubtract(Value: T);
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicDecrement(FValue, PUInt32(@Value)^);
end;

procedure TAtomicOrdinal<T>.CheckArithmetical;
begin
  {$IFDEF ATOMIC_TYPE_CHECK}
  Assert(PTypeInfo(TypeInfo(T))^.Kind = tkInteger,
    'Arithmetical operations are only valid for integer types.');
  {$ENDIF}
end;

procedure TAtomicOrdinal<T>.CheckRequirements;
begin
  {$IFDEF ATOMIC_TYPE_CHECK}
  Assert(PTypeInfo(TypeInfo(T))^.Kind in AllowedAtomicTypes, 'Unsupported generic type.');
  {$ENDIF}
  Assert(SizeOf(T) <= 4, 'The generic ordinal type exceeded the maximum of 4 bytes.');
  Assert((UIntPtr(@FValue) mod 4) = 0, 'Value is not aligned on a 32 bit boundary.');
end;

class operator TAtomicOrdinal<T>.Equal(A: TAtomicOrdinal<T>; B: T): Boolean;
var
  Value: T;
begin
  Value := A.AtomicGetValue;
  Result := PUInt64(@Value)^ = PUInt64(@B)^;
end;

procedure TAtomicOrdinal<T>.AtomicSetValue(const Value: T);
begin
  CheckRequirements;
  AtomicExchange(FValue, PUInt32(@Value)^);
end;

procedure TAtomicOrdinal<T>.AtomicDec;
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicDecrement(FValue);
end;

function TAtomicOrdinal<T>.GetValue: T;
begin
  CheckRequirements;
  Result := PType(@FValue)^;
end;

{ TAtomicOrdinal64<T> }

procedure TAtomicOrdinal64<T>.AtomicAdd(Value: T);
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicIncrement(FValue, PUInt64(@Value)^);
end;

function TAtomicOrdinal64<T>.AtomicCompareExchangeValue(NewValue, Comparand: T): T;
var
  Value: UInt32;
begin
  CheckRequirements;
  Value := AtomicCmpExchange(FValue, PUInt64(@NewValue)^, PUInt64(@Comparand)^);
  Result := PType(@Value)^;
end;

function TAtomicOrdinal64<T>.AtomicExchangeValue(Value: T): T;
begin
  CheckRequirements;
  Result := PType(AtomicExchange(FValue, PUInt64(@Value)^))^;
end;

function TAtomicOrdinal64<T>.AtomicGetValue: T;
{$IFDEF CPU64}
begin
  Result := GetValue;
{$ELSE}
var
  Value: UInt64;
begin
  CheckRequirements;
  Value := AtomicCmpExchange(FValue, 0, 0);
  Result := PType(@Value)^;
{$ENDIF}
end;

class operator TAtomicOrdinal64<T>.Implicit(A: TAtomicOrdinal64<T>): T;
begin
  Result := A.AtomicGetValue;
end;

procedure TAtomicOrdinal64<T>.AtomicInc;
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicIncrement(FValue);
end;

procedure TAtomicOrdinal64<T>.SetValue(const Value: T);
begin
  CheckRequirements;
  FValue := PUInt64(@FValue)^;
end;

procedure TAtomicOrdinal64<T>.AtomicSubtract(Value: T);
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicDecrement(FValue, PUInt64(@Value)^);
end;

procedure TAtomicOrdinal64<T>.CheckArithmetical;
begin
  {$IFDEF ATOMIC_TYPE_CHECK}
  Assert(PTypeInfo(TypeInfo(T))^.Kind = tkInt64,
    'Arithmetical operations are only valid for integer types.');
  {$ENDIF}
end;

procedure TAtomicOrdinal64<T>.CheckRequirements;
begin
  {$IFDEF ATOMIC_TYPE_CHECK}
  Assert(PTypeInfo(TypeInfo(T))^.Kind in AllowedAtomicTypes64, 'Unsupported generic type.');
  {$ENDIF}
  Assert(SizeOf(T) = 8, 'The generic ordinal type is smaller or greater than 8 byte.');
  Assert((UIntPtr(@FValue) mod 8) = 0, 'Value is not aligned on a 64 bit boundary.');
end;

class operator TAtomicOrdinal64<T>.Equal(A: TAtomicOrdinal64<T>; B: T): Boolean;
var
  Value: T;
begin
  Value := A.AtomicGetValue;
  Result := PUInt64(@Value)^ = PUInt64(@B)^;
end;

procedure TAtomicOrdinal64<T>.AtomicSetValue(const Value: T);
begin
  CheckRequirements;
  AtomicExchange(FValue, PUInt64(@Value)^);
end;

procedure TAtomicOrdinal64<T>.AtomicDec;
begin
  CheckRequirements;
  CheckArithmetical;
  AtomicDecrement(FValue);
end;

function TAtomicOrdinal64<T>.GetValue: T;
begin
  CheckRequirements;
  Result := PType(@FValue)^;
end;