Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi TInterlocked.Exchange bei Zugriff eines nur lesenden Threads? (https://www.delphipraxis.net/184301-tinterlocked-exchange-bei-zugriff-eines-nur-lesenden-threads.html)

Zacherl 16. Mär 2015 13:43

Delphi-Version: XE7

TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Hallo zusammen,

ich habe zwei Threads die beide auf gemeinsame Felder zugreifen. Der eine Thread kann jeweils nur schreiben, der andere nur lesen. Muss ich nun alle schreibenden Zugriffe z.b. per TInterlocked.Exchange absichern oder ist das bei nur lesendem Zugriff des einen Threads nicht nötig?

Kann es überhaupt passieren, dass die CPU Datentypen wie Byte, Word, DWord nicht atomar schreibt?

Viele Grüße
Zacherl

himitsu 16. Mär 2015 14:14

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Diese Interlocked-Funktionen arbeiten "atomar", so daß beim Schreibzugriff kein anderer Lesen kann.

Falls die CPU es nicht absichert, daß ein anderer Thread gleichzeitig liest, während ein Anderer schreibt, dan könnte es vielleicht passieren, daß zu von den 4 Bytes eines DWORD/INT teilweises noch ein paar Bytes von dem alten wert mit ausliest. :gruebel:

Sir Rufo 16. Mär 2015 14:32

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Der Speicher wird immer in Busbreite ausgelesen/geschreiben. Einen zusammengestückelten Wert wie 2 Bytes vom alten und 2 Bytes vom neuen Wert gibt es nicht.

Wenn du also absolut schreibst (kein addieren) dann kannst du den Wert einfach dort hineinschreiben. Sobald du mehr als einen Zugriff machen musst, um das gewünschte Resultat zu erreichen, musst du den Bereich schützen.

Zacherl 16. Mär 2015 14:42

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

Zitat von Sir Rufo (Beitrag 1293655)
Der Speicher wird immer in Busbreite ausgelesen/geschreiben. Einen zusammengestückelten Wert wie 2 Bytes vom alten und 2 Bytes vom neuen Wert gibt es nicht.

Gut, dann bin ich vorerst beruhigt :stupid:

Zitat:

Zitat von Sir Rufo (Beitrag 1293655)
Wenn du also absolut schreibst (kein addieren) dann kannst du den Wert einfach dort hineinschreiben. Sobald du mehr als einen Zugriff machen musst, um das gewünschte Resultat zu erreichen, musst du den Bereich schützen.

Jap, sowas sichere ich in der Regel mit Critical Sections.

Bei zwei Threads die beide schreiben, muss ich doch theoretisch sogar auch nichts absichern, sofern der neue Wert nicht vom alten Wert abhängt oder?

Sir Rufo 16. Mär 2015 15:09

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

Zitat von Zacherl (Beitrag 1293661)
Bei zwei Threads die beide schreiben, muss ich doch theoretisch sogar auch nichts absichern, sofern der neue Wert nicht vom alten Wert abhängt oder?

Schreib dir einfach einen Thread, der immer wieder in eine "globale" Variable einen zufälligen Wert schreibt.

Schreibe einen weiteren, der aus dieser Variable liest.

Starte jetzt mehrere von beiden Threads und schau, ob da etwas knallt. Dann hat man auch einen Erfahrungswert und wird noch viel ruhiger :)

himitsu 16. Mär 2015 15:57

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
In Richtung Multiplatform betrachtet ... benutzte einfach die neuen Interlocked-Funktionen aus der System-Unit.

Die aus der Windows-Unit kann man bekanntlich nicht überall benutzen.
Aus irgendeinem unerfindlichem Grunde mach der Mac die WinAPIs nicht. :stupid:

Der schöne Günther 16. Mär 2015 16:41

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

Zitat von Sir Rufo (Beitrag 1293655)
Einen zusammengestückelten Wert wie 2 Bytes vom alten und 2 Bytes vom neuen Wert gibt es nicht.

Ausnahme wo einfaches Lesen/Schreiben auch mit "simplen" Typen wie Integer knallt ist in wenn dieser in einem
Delphi-Quellcode:
packed record
steckt.

Außerdem willst du eines Tages vielleicht doch mit mehreren Threads den Wert beschreiben und freust dich dann dass es direkt ohne Anlauf möglich ist. Ich würde einfach
Delphi-Quellcode:
TInterLocked
oder sonst was verwenden und glücklich sein.

Sir Rufo 16. Mär 2015 16:46

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

Zitat von Der schöne Günther (Beitrag 1293674)
Zitat:

Zitat von Sir Rufo (Beitrag 1293655)
Einen zusammengestückelten Wert wie 2 Bytes vom alten und 2 Bytes vom neuen Wert gibt es nicht.

Ausnahme wo einfaches Lesen/Schreiben auch mit "simplen" Typen wie Integer knallt ist in wenn dieser in einem
Delphi-Quellcode:
packed record
steckt.

Das habe ich doch auch implizit erläutert ...

Zacherl 16. Mär 2015 18:43

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

Zitat von Der schöne Günther (Beitrag 1293674)
Außerdem willst du eines Tages vielleicht doch mit mehreren Threads den Wert beschreiben und freust dich dann dass es direkt ohne Anlauf möglich ist. Ich würde einfach
Delphi-Quellcode:
TInterLocked
oder sonst was verwenden und glücklich sein.

Nene die Felder sind in normalen Klassen. Fehlt bei den Interlocked Implementationen von Delphi btw. die 16 Bit Variante oder bin ich blind?

Zu den packed records. Sowas würde also nicht funktionieren? Verstehe ich jetzt nicht ganz .. :shock:
Delphi-Quellcode:
type
  TRec = packed record
    A: Integer;
  end;

..

Rec.A := 100;
Außer des Alignments (was beim ersten Element hier in dem Beispiel natürlich egal wäre), ändert das "packed" Attribut doch eigentlich nichts an der ganzen Geschichte.

Uwe Raabe 16. Mär 2015 20:59

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

Zitat von Zacherl (Beitrag 1293694)
Zu den packed records. Sowas würde also nicht funktionieren? Verstehe ich jetzt nicht ganz .. :shock:
Delphi-Quellcode:
type
  TRec = packed record
    A: Integer;
  end;

..

Rec.A := 100;
Außer des Alignments (was beim ersten Element hier in dem Beispiel natürlich egal wäre), ändert das "packed" Attribut doch eigentlich nichts an der ganzen Geschichte.

So wohl nicht, aber das hier:

Delphi-Quellcode:
type
  TRec = packed record
    B: Byte;
    A: Integer;
  end;
führt dazu, daß A eher nicht auf einer der CPU genehmen Speichergrenze liegt und die damit zwei Zyklen zum Schreiben braucht. Zwischen diesen beiden Zyklen kann aber ein Lesezugriff (ebenfalls zwei Zyklen) erfolgen. Das hängt aber auch konkret von der verwendeten CPU ab.

Zacherl 16. Mär 2015 21:54

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

Zitat von Uwe Raabe (Beitrag 1293706)
So wohl nicht, aber das hier:

Delphi-Quellcode:
type
  TRec = packed record
    B: Byte;
    A: Integer;
  end;
führt dazu, daß A eher nicht auf einer der CPU genehmen Speichergrenze liegt und die damit zwei Zyklen zum Schreiben braucht. Zwischen diesen beiden Zyklen kann aber ein Lesezugriff (ebenfalls zwei Zyklen) erfolgen. Das hängt aber auch konkret von der verwendeten CPU ab.

Das ist ärgerlich. Sollte sowas nicht irgendwo in der x86-64 ISA spezifiziert sein? Ich erwarte ja schon irgendwie konstantes Verhalten auf allen x86 CPUs, wenn ich ein MOV ausführe.

Uwe Raabe 16. Mär 2015 22:45

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

Zitat von Zacherl (Beitrag 1293711)
Das ist ärgerlich. Sollte sowas nicht irgendwo in der x86-64 ISA spezifiziert sein? Ich erwarte ja schon irgendwie konstantes Verhalten auf allen x86 CPUs, wenn ich ein MOV ausführe.

Für x86 CPUs ist das auch einheitlich. Lediglich das Modulo der Startadresse für einen Ein-Zyklus-Zugriff ist zwischen 32- und 64-Bit unterschiedlich. Es gibt aber ja auch noch andere CPUs.

Mavarik 17. Mär 2015 11:31

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Das ist eine Frage der Ausrichtung...

Wenn Du mit {$A1} arbeitest ist es nicht sicher...

Wie ich gelesen haben übrigens auch nicht zu 100% bei einem Interger. Also lieber ein Interlock oder CS

Mavarik

BUG 17. Mär 2015 12:39

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

Zitat von Sir Rufo (Beitrag 1293667)
Dann hat man auch einen Erfahrungswert und wird noch viel ruhiger :)

Erfahrungswerte sind bei Speichersemantik kritisch zu sehen. Fehler sind meisten ziemlich subtil, treten selten auf und sind schlecht reproduzierbar.
Es ist in 99% der Fälle besser die entsprechenden Bibliotheksfunktionen und Datentypen (richtig ausgerichtet) für atomare Zugriffe zu benutzen.

Und es nicht nur der Speicher selbst, auch der Compiler und Out-Of-Order-Execution kann dir reinpfuschen:
Delphi-Quellcode:
// Thread 1
ptr = Class.create():
ptr.value = 1337;
global_ptr = ptr;
Delphi-Quellcode:
// Thread 2
write(global_ptr.foo); // 1337?
Der Compiler weiß nicht, dass global_ptr von mehreren Threads benutzt wird und ordnet das wegen Optimierung so um (oder der Prozessor macht das; warum auch nicht):
Delphi-Quellcode:
// Thread 1
ptr = Class.create():
global_ptr = ptr;
ptr.value = 1337;
Den Fehler finde erst mal :mrgreen:

Die Bibliotheksfunktionen sind entweder dem Compiler bekannt oder zumindest undurchsichtig, so dass er solche Spielchen lässt. Intern wird da sichergestellt, dass der Prozessor nichts umordnet (Memory Barriers oder andere Tricks).


Wenn es nur um Sachen geht, die schiefgehen können (z.B. Integer für Fortschrittsanzeige auslesen) mag das alles gut gehen. Alles darüber hinaus sollte man vorsichtig angehen.

Zacherl 17. Mär 2015 12:52

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Verdammt, dann habe ich wohl etwas Arbeit vor mir :?

Wie gehe ich am besten bei Enumtypen vor? Alles mit $Z4 deklarieren und dann immer die Integer Variante von InterlockedExchange benutzen dürfte die sicherste Methode sein oder? Gibt es analog hierzu auch eine Möglichkeit "ranged types" auf eine bestimmte Größe zu forcen?
Delphi-Quellcode:
type
  TRangedType = 0..1023;

Sir Rufo 17. Mär 2015 14:05

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

Zitat von Zacherl (Beitrag 1293765)
Verdammt, dann habe ich wohl etwas Arbeit vor mir :?

Häh, wieso das denn? Pack die Felder in eine Klasse, gibt der Klasse ein Synchro-Mechanismus an die Hand und dann geht es ab.
Delphi-Quellcode:
TFoo = class
private
  FCS : TCriticalSection;
  FValue : string;
  function GetValue : string;
  procedure SetValue(const Value : string) : string;
public
  constructor Create;
  destructor Destroy; override;

  property Value : string read GetValue write SetValue;
end;

constructor TFoo.Create;
begin
  inherited;
  FCS := TCriticalSection.Create;
end;

destructor TFoo.Destroy;
begin
  FreeAndNil( FCS );
  inherited;
end;

function GetValue : string;
begin
  FCS.Enter;
  try
    Result := FValue;
  finally
    FCS.Leave;
  end;
end;

procedure SetValue(const Value : string) : string;
begin
  FCS.Enter;
  try
    FValue := Value;
  finally
    FCS.Leave;
  end;
end;

Zacherl 17. Mär 2015 14:23

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Klar, das ist sicherlich ein brauchbarer Ansatz (den ich auch partiell schon implementiert hatte). Allerdings habe ich gelesen, dass Critical Sections nicht umbedingt super performant sind. Zumindest bei den Werten, die alle paar Milisekunden aktualisiert werden, wollte ich lieber die Interlocked Funktionen verwenden.

Kann man bezüglich der "ranged types" was machen, oder bin ich hier gezwungen Critical Sections zu benutzen?

Sir Rufo 17. Mär 2015 14:30

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

Zitat von Zacherl (Beitrag 1293785)
Klar, das ist sicherlich ein brauchbarer Ansatz (den ich auch partiell schon implementiert hatte). Allerdings habe ich gelesen, dass Critical Sections nicht umbedingt super performant sind. Zumindest bei den Werten, die alle paar Milisekunden aktualisiert werden, wollte ich lieber die Interlocked Funktionen verwenden.

Kann man bezüglich der "ranged types" was machen, oder bin ich hier gezwungen Critical Sections zu benutzen?

Du brauchst einen Synchro-Mechanismus (den man - wie hier exemplarisch gezeigt - mit einer CriticalSection machen kann, oder mit
Delphi-Quellcode:
TMonitor
, oder, oder, oder, oder, ..... )

Welchen, das hängt eben davon ab, was da atomar ablaufen soll/muss. Ein
Delphi-Quellcode:
TInterlocked
geht eben nur für einen Wert und eben nur für bestimmte Typen
Delphi-Referenz durchsuchenSystem.SyncObjs.TInterlocked

Der schöne Günther 17. Mär 2015 15:08

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Und die Synchronisationsobjekte (unter System.SyncObjs) leiten sich doch alle von einer gemeinsamen Oberklasse ab. Wenn du später eine die TCriticalSection gegen etwas anderes austauschen willst, ist das nur eine Sache- Ich hätte Sir Rufos Ansatz noch um eine Typdefinition erweitert:

Delphi-Quellcode:
TFoo = class
protected type
   TSyncObj = TCriticalSection;
private
   FCS : TSyncObj;
   FValue : string;
   function GetValue : string;
   procedure SetValue(const Value : string) : string;
public
   constructor Create;
   destructor Destroy; override;

   property Value : string read GetValue write SetValue;
end;
Dann kannst du später alles in einer Zeile austauschen.

Zacherl 17. Mär 2015 15:33

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

Zitat von Sir Rufo (Beitrag 1293786)
Ein
Delphi-Quellcode:
TInterlocked
geht eben nur für einen Wert und eben nur für bestimmte Typen
Delphi-Referenz durchsuchenSystem.SyncObjs.TInterlocked

Ja das ist klar. Sind im Prinzip alles triviale Typen, die ich syncen will (1, 2, 4 und 8 Byte). Habe mir über eine Helper Class bereits noch ein paar Funktionen für UInt32 und UInt64 hinzugefügt, da es die unsigned Varianten leider nicht standardmäßig gibt (dank des var Parameters kann man auch nicht einfach casten).

Bin momentan am sichten, auf welche Felder in welcher Form von wo aus zugegriffen wird.

Momentan habe ich vier verschiedene Modi:
  1. Read im internen Thread UND externen Threads, Write nur im internen Thread
    • Benötigte eine gesyncte Read Funktion, eine ungesyncte Read Funktion (für den internen Thread aus Performancegründen) und eine gesyncte Write Funktion
  2. Read im internen Thread UND externen Threads, Write im internen UND externen Threads
    • Benötigte eine gesyncte Read Funktion und eine gesyncte Write Funktion
  3. Read im internen Thread UND externen Threads, Write einmal im Konstruktor bevor irgendein Zugriff von irgendwo möglich ist
    • Muss nicht synchronisiert werden
  4. Read nur in externen Threads, Write einmal im Konstruktor bevor irgendein Zugriff von irgendwo möglich ist
    • Muss nicht synchronisiert werden

Hoffe ich habe da grade keine Logikfehler eingebaut.

Zitat:

Zitat von Der schöne Günther (Beitrag 1293791)
Und die Synchronisationsobjekte (unter System.SyncObjs) leiten sich doch alle von einer gemeinsamen Oberklasse ab. Wenn du später eine die TCriticalSection gegen etwas anderes austauschen willst, ist das nur eine Sache- Ich hätte Sir Rufos Ansatz noch um eine Typdefinition erweitert

Die Interlocked Funktionen sind allerdings nicht in der selben Form in einem SyncObject gekapselt. Austauschen werde ich die Synchronisierungsobjekte allerdings wohl eh niemals.

Sir Rufo 17. Mär 2015 18:08

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
Dann brauchst du das, was hier beschrieben ist
Working with TMultiReadExclusiveWriteSynchronizer

Zacherl 20. Mär 2015 19:02

AW: TInterlocked.Exchange bei Zugriff eines nur lesenden Threads?
 
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:44 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz