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

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:

zusammenfalten · markieren

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;