Skip to content

Instantly share code, notes, and snippets.

@bashkirtsevich
Last active November 12, 2017 19:57
Show Gist options
  • Save bashkirtsevich/67d9847562ba9d98a12de4a898c61e76 to your computer and use it in GitHub Desktop.
Save bashkirtsevich/67d9847562ba9d98a12de4a898c61e76 to your computer and use it in GitHub Desktop.
Thread pulse demo
(*
3 потока, один ждет сигнал, при срабатывании сигнала вытягивает из очереди значения, остальные потоки через критическую
секцию ставят в очередь значения (один положительную прогрессию, второй — отрицательную)
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FQueuePulse: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
if TMonitor.Wait(FQueuePulse, FQueueLock, INFINITE) then
TThread.Synchronize(nil, procedure
begin
mmo1.Text := mmo1.Text + ' ' + FQueue.Dequeue.ToString;
end);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 1;
while True do
begin
TMonitor.Enter(FQueueLock);
try
Sleep(100);
FQueue.Enqueue(i);
finally
TMonitor.Exit(FQueueLock);
end;
TMonitor.Pulse(FQueuePulse);
inc(i);
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 1;
while True do
begin
TMonitor.Enter(FQueueLock);
try
Sleep(100);
FQueue.Enqueue(i * -1);
finally
TMonitor.Exit(FQueueLock);
end;
TMonitor.Pulse(FQueuePulse);
inc(i);
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FQueuePulse := TObject.Create;
end;
end.
(*
2 потока, работают по цепочке, отработал первый, ждет второго и наоборот.
TMonitor.Wait(FQueuePulse, FQueueLock, 1000) будет завешивать поток на секунду, даже если сигнал придет раньше.
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FQueuePulse: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FQueueLock);
try
if TMonitor.Wait(FQueuePulse, FQueueLock, INFINITE) then
begin
FQueue.Enqueue(i);
TMonitor.Pulse(FQueuePulse);
inc(i);
end;
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FQueueLock);
try
while (FQueue.Count = 0) and not TMonitor.Wait(FQueuePulse, FQueueLock, 1000) do
TMonitor.Pulse(FQueuePulse);
TThread.Synchronize(nil, procedure
begin
mmo1.Text := mmo1.Text + ' ' + FQueue.Dequeue.ToString;
end);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FQueuePulse := TObject.Create;
end;
end.
(*
2 потока, раотают по цепочке, один кладет данные в очередь, другой выгребает.
работает только при наличии sleep(1);
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FPulse1, FPulse2,
FLock1, FLock2: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FLock1);
try
if not TMonitor.Wait(FPulse1, FLock1, INFINITE) then
Continue;
finally
TMonitor.Exit(FLock1);
end;
TMonitor.Enter(FQueueLock);
try
FQueue.Enqueue(i);
inc(i);
finally
TMonitor.Exit(FQueueLock);
end;
sleep(1);
TMonitor.Pulse(FPulse2);
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
b: Boolean;
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
b := FQueue.Count = 0;
finally
TMonitor.Exit(FQueueLock);
end;
if b then
begin
TMonitor.Pulse(FPulse1);
TMonitor.Enter(FLock2);
try
if not TMonitor.Wait(FPulse2, FLock2, INFINITE) then
Continue;
finally
TMonitor.Exit(FLock2);
end;
end;
TMonitor.Enter(FQueueLock);
try
TThread.Synchronize(nil, procedure
begin
mmo1.Text := FQueue.Dequeue.ToString;
end);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FPulse1 := TObject.Create;
FPulse2 := TObject.Create;
FLock1 := TObject.Create;
FLock2 := TObject.Create;
end;
end.
(*
2 потока, работают по цепочке, отработал первый, ждет второго и наоборот.
второй поток не хочет обрабатывать ответный сигнал.
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FQueuePulse: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
var
i: Integer;
b: Boolean;
begin
i := 0;
while True do
begin
TMonitor.Enter(FQueueLock);
try
b := TMonitor.Wait(FQueuePulse, FQueueLock, INFINITE);
if b then
begin
FQueue.Enqueue(i);
inc(i);
end;
finally
TMonitor.Exit(FQueueLock);
end;
if b then
TMonitor.Pulse(FQueuePulse);
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
b: Boolean;
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
b := FQueue.Count = 0;
finally
TMonitor.Exit(FQueueLock);
end;
if b then
TMonitor.Pulse(FQueuePulse);
TMonitor.Enter(FQueueLock);
try
if not b or TMonitor.Wait(FQueuePulse, FQueueLock, INFINITE) then
TThread.Synchronize(nil, procedure
begin
mmo1.Text := mmo1.Text + ' ' + FQueue.Dequeue.ToString;
end);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FQueuePulse := TObject.Create;
end;
end.
(*
два потока, один ждет сигнала, второй посылает сигнал и дожидается выполнения первого потока
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FPulse1, FPulse2,
FLock1, FLock2: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FLock1);
try
if not TMonitor.Wait(FPulse1, FLock1, INFINITE) then
Continue;
TMonitor.Enter(FQueueLock);
try
FQueue.Enqueue(i);
inc(i);
finally
TMonitor.Exit(FQueueLock);
end;
TMonitor.Pulse(FPulse2);
finally
TMonitor.Exit(FLock1);
end;
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
b: Boolean;
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
b := FQueue.Count = 0;
finally
TMonitor.Exit(FQueueLock);
end;
if b then
begin
TMonitor.Enter(FLock2);
try
if not TMonitor.Wait(FPulse2, FLock2, 1) then
begin
TMonitor.Pulse(FPulse1);
Continue;
end;
finally
TMonitor.Exit(FLock2);
end;
end;
TMonitor.Enter(FQueueLock);
try
Assert(FQueue.Count > 0);
Writeln(FQueue.Dequeue);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FPulse1 := TObject.Create;
FPulse2 := TObject.Create;
FLock1 := TObject.Create;
FLock2 := TObject.Create;
end;
end.
(*
два потока, один ждет сигнала, второй посылает сигнал и дожидается выполнения первого потока, используя один объект блокировки и один сигнал
*)
unit main_u;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, System.Generics.Collections,
FMX.ScrollBox, FMX.Memo;
type
TfrmMain = class(TForm)
btn1: TButton;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FPulse1, {FPulse2,}
FLock1{, FLock2}: TObject;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TfrmMain.btn1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FLock1);
try
if not TMonitor.Wait(FPulse1, FLock1, INFINITE) then
Continue;
TMonitor.Enter(FQueueLock);
try
FQueue.Enqueue(i);
inc(i);
finally
TMonitor.Exit(FQueueLock);
end;
TMonitor.Pulse(FPulse1);
finally
TMonitor.Exit(FLock1);
end;
end;
end).Start;
TThread.CreateAnonymousThread(procedure
var
b: Boolean;
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
b := FQueue.Count = 0;
finally
TMonitor.Exit(FQueueLock);
end;
if b then
begin
TMonitor.Enter(FLock1);
try
if not TMonitor.Wait(FPulse1, FLock1, 1) then
begin
TMonitor.Pulse(FPulse1);
Continue;
end;
finally
TMonitor.Exit(FLock1);
end;
end;
TMonitor.Enter(FQueueLock);
try
Assert(FQueue.Count > 0);
Writeln(FQueue.Dequeue);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FPulse1 := TObject.Create;
//FPulse2 := TObject.Create;
FLock1 := TObject.Create;
//FLock2 := TObject.Create;
end;
end.
(*
финальный вариант
*)
var
FQueue: TQueue<Integer>;
FQueueLock: TObject;
FPulse1: TObject;
begin
FQueue := TQueue<Integer>.Create;
FQueueLock := TObject.Create;
FPulse1 := TObject.Create;
TThread.CreateAnonymousThread(procedure
var
i: Integer;
begin
i := 0;
while True do
begin
TMonitor.Enter(FQueueLock);
try
if not TMonitor.Wait(FPulse1, FQueueLock, INFINITE) then
Continue;
FQueue.Enqueue(i);
inc(i);
TMonitor.Pulse(FPulse1);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
TThread.CreateAnonymousThread(procedure
begin
while True do
begin
TMonitor.Enter(FQueueLock);
try
if FQueue.Count < 100 then
begin
if not TMonitor.Wait(FPulse1, FQueueLock, 1) then
begin
TMonitor.Pulse(FPulse1);
Continue;
end;
end;
Assert(FQueue.Count > 0);
Writeln(FQueue.Dequeue);
finally
TMonitor.Exit(FQueueLock);
end;
end;
end).Start;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment