Registriert seit: 3. Sep 2004
4.629 Beiträge
Delphi 10.2 Tokyo Starter
|
AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
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;
Geändert von Zacherl (21. Mär 2015 um 16:23 Uhr)
|