PHP DM Gate v0.9 » Странный deadlock <span class="vd">[D7, WinXP]</span>

mt2 (14.01.08 15:37) [0]

Hi,

unit Unit1;
// Delphi-7
// Странный deadlock, см. строки:
// Почему эта программа зависает без sleep(0) ?
// Если n=200, то эта программа работает без sleep(0). Почему?

// Испытано под MS Windows XP SP2, CPU Intel Pentium-4 3.0 GHz
// и на другом CPU Intel Pentium-4 3.2 GHz

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type

TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TTestThread = class(TThread)
constructor Create (CreateSuspended : Boolean; eventHnd : THandle; i : integer);
private
{ Private declarations }
ind : integer;
syncEvent : THandle;
protected
procedure Execute; override;
end;

var
Form1: TForm1;
events : array [0..7] of THandle;
thr : array [0..7] of TTestThread;
stop : Boolean;
n : integer;
calc : array [1..8] of integer;

implementation

{$R *.dfm}

constructor TTestThread.Create (CreateSuspended : Boolean; eventHnd : THandle; i : integer);
begin
inherited Create (CreateSuspended);
syncEvent := eventHnd;
ind := i;
end;

procedure TTestThread.Execute;
begin
{ Place thread code here }
repeat
inc(calc [ind],n);
SetEvent (syncEvent);
suspend;
until stop;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;

begin
for i:=1 to 8 do
calc [i] := i;

stop := false;

for i:=0 to 7 do
events [i] := CreateEvent (nil, true, false, PChar('testEvent'+intToStr(i)));

for i:=0 to 7 do
thr[i] := TTestThread.Create(true, events [i],i+1);

n := 0;
repeat
inc (n);

thr[0].Resume;
thr[1].Resume;
thr[2].Resume;
thr[3].Resume;
thr[4].Resume;
thr[5].Resume;
thr[6].Resume;
thr[7].Resume;

waitForMultipleObjects (8, @events, true, INFINITE);
ResetEvent (events [0]);
ResetEvent (events [1]);
ResetEvent (events [2]);
ResetEvent (events [3]);
ResetEvent (events [4]);
ResetEvent (events [5]);
ResetEvent (events [6]);
ResetEvent (events [7]);

sleep(0); // Почему эта программа зависает без sleep(0) ?

until n=1000; // Если n=200, то эта программа работает без sleep(0). Почему?

Memo1.Lines.Add('n= '+ intToStr(n));
for i:=1 to 8 do
Memo1.Lines.Add(intToStr(calc[i]));
end;

end.

<Цитата>
Сергей М. © (14.01.08 15:44) [1]

Поздравляем тебя с имеющими тебя странностями.

<Цитата>
mt2 (14.01.08 15:48) [2]

:) может они (странности) не только мои? но и ОС? - тогда и тебя поздравляю ;))))))))))

<Цитата>
Сергей М. © (14.01.08 16:13) [3]

Что это вообще за хня ?

Изложи ТЗ.

<Цитата>
mt2 (14.01.08 16:36) [4]

ТЗ будет слишком долго, прога сложная, отловил bug и минимизировал. Лишние детали будут не по теме. Попробуй для начала запустить у себя и сообщи, что получается, и почему.

<Цитата>
icWasya © (14.01.08 17:09) [5]

после waitForMultipleObjects (8, @events, true, INFINITE);
ResetEvent не нужно

<Цитата>
Сергей М. © (14.01.08 17:11) [6]

> отловил bug и минимизировал

И ?

> Лишние детали будут не по теме

Продолжай париться.

> Попробуй для начала запустить

Да нахрен оно мне надо

> что получается, и почему.

Получится хня.

Почему ?

потому что абракадабра в коде.

<Цитата>
ага (14.01.08 19:40) [7]

> Если n=200, то эта программа работает без sleep(0)

Эт тока кажется. А виснет вот почему.

Такой момент, когда все потоки одного успели вызвать SetEvent и уйти в Suspend. В какой-то момент последний поток успевает вызвать SetEvent и в этот момент планировщик у него отбирает процессор и отдает гланому - главный-то поток интерфейсный, у его окна фокус, потому у него приоритет повыше.

Главный поток сбрасывает все эвенты и резюмит все потоки. Все кроме последнего - он-то еще не успел уснуть и Resume ему по барабану. Далее главный поток уходит в WaitFor... и процессор достаетс последнему из потоков. Тот просыпается и вызывает свой Suspend.

Все, аллес. Спит главный поток, потому что у нег WaitAll = true, спит наш несчастный последний поток в своем Suspend. Отработают свои циклы и уснут все остальные потоки. Все спят, и разбудить их некому. Кроме TerminateProcess.

Б-р-р-р...

<Цитата>
ага (14.01.08 19:45) [8]

А, ну да, еще ж про Sleep. Sleep усыпляет на квант планировщика главный поток, в результате наш несчастный "последний" поток получает возможность вызвать свой Suspend раньше, чем главный поток вызовет ему Resume.

> Сергей М. © (14.01.08 17:11) [6]

Ну че абракадабра-то? Нормально сделал, выдернул проблему, лишнего не постил.

<Цитата>
ага (14.01.08 19:46) [9]

> Такой момент, когда все потоки одного успели вызвать

Такой момент, когда все потоки кроме одного успели вызвать

<Цитата>
ага (14.01.08 19:49) [10]

На многопроцессорной тачке это могло долго не проявиться. А могло и сразу. В общем, все единл фтопку.

<Цитата>
mt2 (14.01.08 21:41) [11]

> ага (14.01.08 19:40) [7]
>
> > Если n=200, то эта программа работает без sleep(0)
>
> Эт тока кажется. А виснет вот почему.
>
> Такой момент, когда все потоки одного успели вызвать SetEvent
> и уйти в Suspend. В какой-то момент последний поток успевает
> вызвать SetEvent и в этот момент планировщик у него отбирает
> процессор и отдает гланому - главный-то поток интерфейсный,
> у его окна фокус, потому у него приоритет повыше.
>
> Главный поток сбрасывает все эвенты и резюмит все потоки.
> Все кроме последнего - он-то еще не успел уснуть и Resume
> ему по барабану. Далее главный поток уходит в WaitFor...
> и процессор достаетс последнему из потоков. Тот просыпается
> и вызывает свой Suspend.
>
> Все, аллес. Спит главный поток, потому что у нег WaitAll
> = true, спит наш несчастный последний поток в своем Suspend.
> Отработают свои циклы и уснут все остальные потоки. Все
> спят, и разбудить их некому. Кроме TerminateProcess.
>
> Б-р-р-р...

Огромное спасибо за объяснение! - Ребус Вами разгадан. А можете посоветовать, как грамотно исправить этот модельный пример, чтобы всегда работал? Пожалуйста, не сочтите за труд - было бы очень интересно увидеть Ваш вариант кода.

<Цитата>
ага (14.01.08 22:17) [12]

А я бы Suspend не использовал. Дал бы потокам еще по эвенту и пусть они их ждут вместо Suspend. А в главном вместо Resume взводил бы эти эвенты. Или там сообщения использовал бы, или порт завершения, да мало ли. Это так, на вскидку, особо не задумываясь - задачи-то я не знаю, а без этого искать решение - дело бесперспективное.

<Цитата>
mt2 (14.01.08 23:02) [13]

> ага (14.01.08 22:17) [12]
> А я бы Suspend не использовал. Дал бы потокам еще по эвенту
> и пусть они их ждут вместо Suspend. А в главном вместо Resume
> взводил бы эти эвенты. Или там сообщения использовал бы,
> или порт завершения, да мало ли. Это так, на вскидку, особо
> не задумываясь - задачи-то я не знаю, а без этого искать
> решение - дело бесперспективное.

Ну, насчет знания задачи - свои задачи каждый решает сам ;) А здесь задача представлена модельным кодом и только им: как надежнее и эффективнее исправить данный код? То что он никакой особо полезной работы не делает, абсолютно ничего не значит. Главное - методика, когда она найдена, можно и полезной работой догрузить. Существенное видно из кода: каждый поток работает очень небольшое время, а потоков 8. Понятно, что эффективнее, когда большее время - но это другой вопрос, о котором много сказано, и он очевиден.

<Цитата>
Leonid Troyanovsky © (14.01.08 23:26) [14]

> mt2 (14.01.08 23:02) [13]

> ;) А здесь задача представлена модельным кодом и только
> им: как надежнее и эффективнее исправить данный код? То
> что он никакой особо полезной работы не делает, абсолютно
> ничего не значит.

Смело выкидывай его в корзину, бо, он ничего не значит и ничего
особо полезного не делает, и плотно приступайся к разработке ТЗ.

--
Regards, LVT.

<Цитата>
ага (15.01.08 05:42) [15]

> mt2 (14.01.08 23:02) [13]

Тут вишь ли дело какое - при программировании многопоточности именно тонкости реализации выходят на передний план, так как набор средств для решения вполне себе детерминирован и не особо поддается расширению. И эффективность решения именно этими деталями, их комбинациями и определяется. А это уже прямо и даже непосредственно определяется конкретикой стоящей задачи. Вот и выходит, что попытки создания решения для абстрактных задач в этой области абрактные же решения и дают, которые тока для умственной гимнастики и годятся, а практического толку с них ноль.

>каждый поток работает очень небольшое время

Вот это уже чуть конкретнее. Тогда пожалуй Completion Port.

>а потоков 8

А вот это уже не постановка задачи, а черт знает что. Кто сказал, что их 8? Почему 8? Почему не 7 или 9? Ваш папа любит цифру 8?
Хошь обижайся, хошь нет, но лично у меня такая конкретика вызывает подозрение в наличии системной ошибки. Очень редко, если вообще когда-либо, возникают задачи, требующие точно заданного числа потоков.

<Цитата>
ketmar © (15.01.08 07:44) [16]

>[15] ага (15.01.08 05:42)
>Очень редко, если вообще когда-либо, возникают задачи, требующие точно
>заданного числа потоков.
отчего же? очень часто такие задачи возникают. где точно задано число потоков: 1.

<Цитата>
mt2 (15.01.08 12:38) [17]

> ага (15.01.08 05:42) [15]
>
> > mt2 (14.01.08 23:02) [13]
>
> Тут вишь ли дело какое - при программировании многопоточности
> именно тонкости реализации выходят на передний план, так
> как набор средств для решения вполне себе детерминирован
> и не особо поддается расширению. И эффективность решения
> именно этими деталями, их комбинациями и определяется. А
> это уже прямо и даже непосредственно определяется конкретикой
> стоящей задачи. Вот и выходит, что попытки создания решения
> для абстрактных задач в этой области абрактные же решения
> и дают, которые тока для умственной гимнастики и годятся,
> а практического толку с них ноль.

Всевозможные библиотеки для многопоточности - ни что иное, как обобщенные решения ;)

>
> >каждый поток работает очень небольшое время
>
> Вот это уже чуть конкретнее. Тогда пожалуй Completion Port.

Ok. А можно подробнее для данного случая? Обычно Completion Port применяется для I/O...

>
>
> >а потоков 8
>
> А вот это уже не постановка задачи, а черт знает что. Кто
> сказал, что их 8? Почему 8? Почему не 7 или 9? Ваш папа
> любит цифру 8?
> Хошь обижайся, хошь нет, но лично у меня такая конкретика
> вызывает подозрение в наличии системной ошибки. Очень редко,
> если вообще когда-либо, возникают задачи, требующие точно
> заданного числа потоков.
> <Цитата>

В задачах графики/псевдо-графики у каждого пиксела 8 соседей.

<Цитата>
ага (15.01.08 15:09) [18]

> ketmar © (15.01.08 07:44) [16]

> отчего же? очень часто такие задачи возникают. где точно
> задано число потоков: 1.

Эт точно:)))

> В задачах графики/псевдо-графики у каждого пиксела 8 соседей
+
Ну теперь я точно уверен, что 8 потоков тут нафиг не нужны:))-
Соседей могет быть сколь угодно. Но количество процессоров на машине от этого не зависит. Почитай вот здесь
http://delphikingdom.com/asp/answer.asp?IDAnswer=58287
пост от [09-01-2008 11:21]. В той ветке и пример имеется. А можно и для твоей модели

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CompletionPort;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FPort: TCompletionPort;
public
{ Public declarations }
end;

TTestThread = class(TThread)
constructor Create (CreateSuspended : Boolean; CPort: TCompletionPort);
private
{ Private declarations }
FPort: TCompletionPort;
protected
procedure Execute; override;
end;

var
Form1: TForm1;
events : array [0..7] of THandle;
thr : array [0..7] of TTestThread;
stop : Boolean;
n : integer;
calc : array [1..8] of integer;

implementation

{$R *.dfm}

constructor TTestThread.Create (CreateSuspended : Boolean; CPort: TCompletionPort);
begin
inherited Create (CreateSuspended);
FPort:= CPort;
end;

procedure TTestThread.Execute;
var
Ind, Key: Cardinal;
pOvp: POverlappedEx;
begin
{ Place thread code here }
while FPort.WaitCompletion(Ind, Key, pOvp) do
begin
if Key = 0 then Break;
inc(calc [Ind + 1],n);
SetEvent (Events[Ind]);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;

begin
for i:=1 to 8 do calc [i] := i;

n := 0;
repeat
inc (n);
for i:= 0 to 7 do FPort.SetCompletion(i, 1, TOverlappedEx(nil^));
waitForMultipleObjects (8, @events, true, INFINITE);
ResetEvent (events [0]);
ResetEvent (events [1]);
ResetEvent (events [2]);
ResetEvent (events [3]);
ResetEvent (events [4]);
ResetEvent (events [5]);
ResetEvent (events [6]);
ResetEvent (events [7]); { }
// Label1.Caption:= IntToStr(n);
// Label1.Refresh;

until n=1000; // Åñëè n=200, òî ýòà ïðîãðàììà ðàáîòàåò áåç sleep(0). Ïî÷åìó?

Memo1.Lines.Add('n= '+ intToStr(n));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
FPort:= TCompletionPort.Create(8); // Но лучше ноль передать
for i:=0 to 7 do
thr[i]:= TTestThread.Create(false, FPort);
for i:=0 to 7 do
events [i] := CreateEvent (nil, true, false, nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
i: integer;
begin
for i:= 0 to 7 do FPort.SetCompletion(0, 0, TOverlappedEx(nil^));
for i:= 0 to 7 do thr[i].Free;
FPort.Free;
end;

end.

Код CompletionPort вот здесь есть
http://delphikingdom.com/asp/answer.asp?IDAnswer=56098

<Цитата>
mt2 (16.01.08 00:47) [19]

> > В задачах графики/псевдо-графики у каждого пиксела 8 соседей
> +
> Ну теперь я точно уверен, что 8 потоков тут нафиг не нужны:
> ))-
> Соседей могет быть сколь угодно. Но количество процессоров
> на машине от этого не зависит.

Один мой знакомый очень не любит спрашивать незнакомых людей. Оказавшись в незнакомом ему городе, он может часами искать нужную улицу и дом, но никогда не спросит прохожего «Как пройти…», а оказавшись без часов (и без мобильника), он лучше опоздает, но не спросит «Который час?» А все потому, что давным-давно, впервые оказавшись в инете, он имел неосторожность спросить о том, как выбирать коврик для мыши. Его расспросили о конфигурации «писи», и он выслушал множество комментариев о том, какой он козел, что купил такое, его расспросили о софте, который он использует и тоже откомментировали, его расспросили о круге чтения и о знакомых, о родственниках и о родословной, выспросили, страдал ли кто из них хроническим алкоголизмом и не было ли припадочных и т.д. Про коврик ему ничего не ответили… Иногда я искренне удивляюсь, насколько человек, куда-то спешивший и остановленный вопросом «Который час?», вдруг готов бросить все дела и заниматься только твоими проблемами. Ему бесконечно мало сказать «7:45», нет, он хочет знать о тебе все, он искренне хочет помочь, он интересуется, зачем тебе знать время, не спешишь ли ты на встречу или на свидание, если да, то с кем, если девушка, то нужна ли она тебе и не совершаешь ли ты роковую ошибку, а вдруг девушка тебе нафиг не нужна, но ты, не зная это, обманешься и увлечешься красивой внешностью и в результате вся твоя жизнь будет разбита, как в мексиканском мыльнике и т.д. Ранее Вы писали мне:

> Хошь обижайся, хошь нет

Так вот, обижаться я на тебя не буду (и не надейся ;), т.к. сильно мне помог с анализом задачи. Но и ты на меня не обижайся, пожалуйста! Ну, попробуй представить, что могут быть особые условия. Что софт, например, делается для конкретной конфигурации. Или, например, представь себе препода, который хочет показать своим студентам как не надо. Он придет к тебе за советом о реализации рекурсивного вычисления факториала, а ты начнешь его убеждать, что во многих учебниках написано, что рекурсивная реализация не лучший метод для вычисления факториала… В конце концов, может я хочу написать в отчете, что был испробован ряд очевидных возможностей распараллеливания, в том числе и на 8 потоков по соседям и, как и следовало ожидать, этот подход себя не оправдал;)

За решение спасибо, но так не получается; причины:

1) отсутствует файл {$I CompVersionDef.inc}

2) EAccessViolation в методе TCompletionPort.SetCompletion

Видимо, тут нужен контроль и на старте и на финише, чтобы "спринтеры" не разбредались и возвращались на старт организованно ;) Т.е. каждый спринтер получат от основного потока 2 команды: "старт!" - это значит нужно бежать дистанцию от старта до финиша и "на старт" - вернуться с финиша на старт. WaitForSingleObject (startEvent,INFINITE) в TTestThread.Execute гарантирует от фальш-старта, WaitForSingleObject (finishEvent,INFINITE) разрешает возвращение от финиша к старту для очередного забега. Основной поток, подав команду "старт!", должен дождаться, когда все финишируют, подать команду "на старт" и дождаться, когда все будут готовы к старту.

Хотелось бы услышать мнения об этом решении (пока что единственное стабильно работающее), привожу исходный код ("полезные" вычисления сделал еще проще, чтобы легче контролировать результат, весь тест теперь можно повторять без перезапуска).

unit Unit1;
// Delphi-7, MS Windows XP SP2, CPU Intel Pentium-4 3.0 GHz

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;

TTestThread = class(TThread)
constructor Create (CreateSuspended : Boolean; eventHnd : THandle; i : integer);
private
ind : integer;
syncEvent : THandle;
protected
procedure Execute; override;
end;

var
Form1: TForm1;
events : array [0..7] of THandle;
startEvent, finishEvent : THandle;
thr : array [0..7] of TTestThread;
stop : Boolean;
n : integer;
calc : array [1..8] of integer;

implementation

{$R *.dfm}

constructor TTestThread.Create (CreateSuspended : Boolean; eventHnd : THandle; i : integer);
begin
inherited Create (CreateSuspended);
syncEvent := eventHnd;
ind := i;
FreeOnTerminate := true;
end;

procedure TTestThread.Execute;
begin
repeat
WaitForSingleObject (startEvent,INFINITE); // -> старт?

inc(calc [ind]); // "забег"

// Можно так:
// SetEvent (syncEvent); // финиш ->
// WaitForSingleObject (finishEvent,INFINITE); // -> вернуться на старт?

// А можно и так:
SignalObjectAndWait(syncEvent,finishEvent,INFINITE,False);

SetEvent (syncEvent); // к старту готов ->
until stop;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;

begin
for i:=1 to 8 do
calc [i] := 0;

stop := false;
n := 0;
repeat
inc (n);

SetEvent (startEvent); // старт! ->
waitForMultipleObjects (8, @events, true, INFINITE); // -> все финишировали?
ResetEvent (startEvent);
for i:=0 to 7 do
ResetEvent (events [i]);

SetEvent (finishEvent); // вернуться на старт ->
waitForMultipleObjects (8, @events, true, INFINITE);// -> к старту готов?
ResetEvent (finishEvent);
for i:=0 to 7 do
ResetEvent (events [i]);

until n=1000;

Memo1.Lines.Add('n= '+ intToStr(n));
for i:=1 to 8 do
Memo1.Lines.Add(intToStr(calc[i]));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
for i:=0 to 7 do
events [i] := CreateEvent (nil, true, false, PChar('testEvent'+intToStr(i)));

startEvent := CreateEvent (nil, true, false, 'startEvent');
finishEvent := CreateEvent (nil, true, false, 'finishEvent');

for i:=0 to 7 do
thr[i] := TTestThread.Create(true, events [i],i+1);

for i:=0 to 7 do
thr[i].Resume;
end;

end.

<Цитата>