Discussion :

[Andnotor]

Salut à tous !

Je découvre aujourd'hui une autre façon de synchroniser des threads sans utiliser d'event. Vous la connaissez peut-être déjà, moi je la découvre (même si elle est apparue sous Windows 8 !) et voyant que le sujet n'a jamais été abordé, je vous la propose

Le concept est basé sur la surveillance d'une adresse mémoire et la modification de son contenu. La fonction d'attente WaitOnAddress est signalée lorsque que le contenu de cette adresse est différent d'un autre adresse qui sert de référence et qu'un ordre de contrôle est invoqué, soit par WakeByAddressSingle qui ne va débloquer qu'un seul thread même si plusieurs sont en attente, soit par WakeByAddressAll pour les réveiller tous.

Voici un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
var
  Active    :boolean = FALSE;
  Reference :boolean = FALSE;
 
// Attente
WaitOnAddress(@Active, @Reference, SizeOf(boolean), INFINITE);
 
// Réveil
Active := TRUE;
WakeByAddressAll(@Active);

Ici j'utilise des booléens mais le système est suffisamment ouvert pour contrôler un contenu jusqu'à 8 octets.

Et voici une petite implémentation pour facilité la vie et qui dans bien des cas peut remplacer un TEvent :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
type
  TWakeEvent = record
  private
    Active :boolean;
  public
    procedure SetEvent(aManualReset :boolean = FALSE);
    procedure ResetEvent;
    function  Wait(aTimeout :cardinal = INFINITE) :boolean;
  end;
 
procedure TWakeEvent.ResetEvent;
begin
  Active := FALSE;
end;
 
procedure TWakeEvent.SetEvent(aManualReset: boolean);
begin
  Active := TRUE;
  WakeByAddressAll(@Active);
 
  if not aManualReset then
    ResetEvent;
end;
 
function TWakeEvent.Wait(aTimeout :cardinal): boolean;
begin
  const Inactive = FALSE;
  Result := WaitOnAddress(@Active, @Inactive, SizeOf(boolean), aTimeout);
end;

Bien sûr ça ne remplace pas complétement un TEvent puisque ce système ne fonctionne que dans le processus courant mais c'est sympa !

Voilà, amusez-vous bien

[Papy214]

C'est pas mal ce truc. Bien suffisant si c'est dans le même processus.
Par contre, je vois bien l'utilité d'utiliser un boolean mais pas vraiment ce qu'il serait intéressant comme autre type.
Tu penses à quoi par exemple ?

[Andnotor]

A toi de laisser libre cours à ton imagination

Ca pourrait être le résultat d'une fonction, différent de ERROR_SUCCESS (un entier), un pointeur réassigné WaitOnAddress(@Obj, @RefObj, SizeOf(pointer), INFINITE), une énumération pour véritablement piloter une tâche de travail :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
type
  TCommand = (CmdWait, CmdExit, Cmd1, Cmd2, Cmd3);
 
var
  Command :TCommand;
 
procedure ExecCommand(aCommand: TCommand);
begin
  Command := aCommand;
  WakeByAddressSingle(@Command);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  TThread.CreateAnonymousThread(procedure
                                begin
                                  const RefCmd = CmdWait;
 
                                  while True do
                                  begin
                                    WaitOnAddress(@Command, @RefCmd, SizeOf(TCommand), INFINITE);
 
                                    const Cmd = Command;
                                    Command  := RefCmd;
 
                                    case Cmd of
                                      CmdExit : Exit;
                                      Cmd1    : ...;
                                      Cmd2    : ...;
                                      Cmd3    : ...;
                                    end;
                                  end;
                                end).Start;
end;

Je l'ai utilisé dernièrement pour lancer des procédures en asynchrone :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
unit QueueProcThreads;
 
interface
 
uses
  Winapi.Windows, System.SysUtils, System.Classes, System.SyncObjs;
 
type
  TQueueProc = reference to procedure(aData :pointer);
 
  TQueueInfo = record
    Proc :TQueueProc;
    Data :pointer;
  end;
 
  TQueueProcThread = class(TThread)
  private
    Count       :integer;
    Lock        :TCriticalSection;
    Queue       :array of TQueueInfo;
  protected
    procedure   Execute; override;
    procedure   TerminatedSet; override;
  public
    procedure   Add(aProc :TQueueProc; aData :pointer = nil);
    constructor Create;
    destructor  Destroy; override;
  end;
 
implementation
 
{ TQueueProcThread }
 
procedure TQueueProcThread.Add(aProc :TQueueProc; aData :pointer = nil);
var
  Info :TQueueInfo;
begin
  Info.Proc := aProc;
  Info.Data := aData;
 
  Lock.Acquire;
 
  try
    Queue := Queue +[Info];
    Count := Length(Queue);
 
  finally
    Lock.Release;
  end;
 
  WakeByAddressSingle(@Count);
end;
 
constructor TQueueProcThread.Create;
begin
  inherited;
  Lock := TCriticalSection.Create;
end;
 
destructor TQueueProcThread.Destroy;
begin
  Lock.Free;
  inherited;
end;
 
procedure TQueueProcThread.Execute;
var
  Info :TQueueInfo;
begin
  const RefCount = 0;
 
  while not Terminated do
  begin
    WaitOnAddress(@Count, @RefCount, SizeOf(integer), INFINITE);
 
    if Count > 0 then
    begin
      Lock.Acquire;
 
      try
        Info := Queue[0];
        Delete(Queue, 0, 1);
        Dec(Count);
 
      finally
        Lock.Release;
      end;
 
      Info.Proc(Info.Data);
    end;
  end;
end;
 
procedure TQueueProcThread.TerminatedSet;
begin
  inherited;
  Count := -1;
  WakeByAddressSingle(@Count);
end;
 
end.

Bref, tout est ouvert