Einzelnen Beitrag anzeigen

Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#22

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?

  Alt 20. Mär 2015, 20:02
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;
Projekte:
- GitHub (Profil, zyantific)
- zYan Disassembler Engine ( Zydis Online, Zydis GitHub)

Geändert von Zacherl (21. Mär 2015 um 16:23 Uhr)
  Mit Zitat antworten Zitat