Текущий архив: 2005.09.18;
Скачать: CL | DM;
Вниз
Как приостановить поток? Найти похожие ветки
← →
Fay © (2005-08-24 21:17) [80]Defunct © (24.08.05 21:03) [78]
Со всеми бывает. У меня ещё других дел хватает, проглядел.
Пусть будет так 8)var
n, i : Integer;
p : PInteger;
begin
n := 0;
p := @n;
ThreadEx := TThreadEx.Create(@p);
repeat
ThreadEx.Suspend;
Inc(p^);
Caption := IntToStr(p^);
Application.ProcessMessages;
i := n;
ThreadEx.Resume;
until i >= 999;
ThreadEx := nil;
← →
Defunct © (2005-08-24 21:58) [81]> Fay
Вы намекаете на то, что поток останавливается не сразу после inherited suspend? если оно так.. тогда конечно, ни пример АП, ни мой, не годятся.
← →
Defunct © (2005-08-24 22:11) [82]с учетом [81] такой вариант синхронизации проходит ваш тест, однако я соглашусь с тем что крит. секция была бы более рациональным решением..
TThreadEx = class(TThread)
private
FTrySuspend : Boolean;
FP : PPInteger;
fResumed : boolean;
protected
procedure Execute; override;
public
constructor Create(p : PPInteger); reintroduce;
procedure Suspend;
procedure Resume;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
var
ThreadEx : TThreadEx = nil;
constructor TThreadEx.Create(p : PPInteger);
begin
inherited Create(True);
if not Assigned(p^) then
raise Exception.Create("не насилуй");
FP := p;
FreeOnTerminate := True;
fTrySuspend := false;
Resume;
end;
procedure TThreadEx.Execute;
procedure DoIt;
var
p : PInteger;
begin
p := FP^;
FP^ := nil;
Sleep(0); // Потоку ничто не мешает переключиться именно здесь
FP^ := p;
end;
begin
while not Terminated do
begin
DoIt;
if fTrySuspend then
begin
fTrySuspend := False;
inherited Suspend;
while not fResumed do sleep(0);
end;
end;
end;
procedure TThreadEx.Suspend;
begin
fResumed := false;
FTrySuspend := True;
while not fTrySuspend do
Sleep(0);
end;
procedure TThreadEx.Resume;
begin
inherited Resume;
fResumed := True;
end;
← →
Fay © (2005-08-25 00:54) [83]2 Defunct © (24.08.05 22:11) [82]
Щяз, думаю, испорчу впечатление.
← →
Defunct © (2005-08-25 01:29) [84]> Fay
Наврятли, тут уже все по канонам семафоров.
← →
Fay © (2005-08-25 01:36) [85]2 Defunct © (25.08.05 1:29) [84]
>> Наврятли
Фигушки. Улучшений не наблюдается.
Выслать?
>> тут уже все по канонам семафоров
Сомневаюсь 8).
← →
Fay © (2005-08-25 01:41) [86]2 Defunct © (25.08.05 1:29) [84]
Выслал на указанное в анкете мыло.
Собственно, хто угодно в состоянии добавить в [80] и [82] к [77]...
← →
Fay © (2005-08-25 01:43) [87]2 Defunct © (24.08.05 22:11) [82]
FTrySuspend := True;
while not fTrySuspend do
Sleep(0);
Это вАщЕ шедевр 8)
← →
Defunct © (2005-08-25 02:01) [88]> Fay
пока не пришло. жду ;>
> Fay © (25.08.05 01:43) [87]
хаха, и действительно.
Поделиться травой? ;>
Да, уж я тоже не углядел.
Сейчас сделаю нормальный вариант
← →
Defunct © (2005-08-25 02:11) [89]Собсно там и делать ничего не пришлось, просто исправать указанную вами строчку:
> while fTrySuspend do
просто в моем изначальном примере поле называлось fFrozen, и было while not fFrozen do sleep.. при переделке поменял название и логику переменной, а про not забыл и капцы ;>TThreadEx = class(TThread)
private
FTrySuspend : Boolean;
FP : PPInteger;
protected
procedure Execute; override;
public
constructor Create(p : PPInteger); reintroduce;
procedure Suspend;
end;
constructor TThreadEx.Create(p : PPInteger);
begin
inherited Create(True);
if not Assigned(p^) then
raise Exception.Create("не насилуй");
FP := p;
FreeOnTerminate := True;
fTrySuspend := false;
Resume;
end;
procedure TThreadEx.Execute;
procedure DoIt;
var
p : PInteger;
begin
p := FP^;
FP^ := nil;
Sleep(0); // Потоку ничто не мешает переключиться именно здесь
FP^ := p;
end;
begin
while not Terminated do
begin
DoIt;
if fTrySuspend then
begin
fTrySuspend := False;
inherited Suspend;
end;
end;
end;
procedure TThreadEx.Suspend;
begin
FTrySuspend := True;
while fTrySuspend do
Sleep(0);
end;
← →
Fay © (2005-08-25 02:22) [90]2 Defunct © (25.08.05 2:11) [89]
Мне не удалось выйти из второй итерацииunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PPInteger = ^PInteger;
TForm1 = class(TForm)
Button1 : TButton;
Button2 : TButton;
procedure Button1Click(Sender : TObject);
procedure Button2Click(Sender : TObject);
procedure Button3Click(Sender : TObject);
end;
TThreadEx = class(TThread)
private
FTrySuspend : Boolean;
FP : PPInteger;
FResumed : Boolean;
protected
procedure Execute; override;
public
constructor Create(p : PPInteger); reintroduce;
procedure Suspend;
procedure Resume;
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
var
ThreadEx : TThreadEx = nil;
constructor TThreadEx.Create(p : PPInteger);
begin
inherited Create(True);
if not Assigned(p^) then
raise Exception.Create("не насилуй");
FP := p;
FreeOnTerminate := True;
FTrySuspend := false;
Resume;
end;
procedure TThreadEx.Execute;
procedure DoIt;
var
p : PInteger;
begin
p := FP^;
FP^ := nil;
Sleep(0); // Потоку ничто не мешает переключиться именно здесь
FP^ := p;
end;
begin
while not Terminated do
begin
DoIt;
if fTrySuspend then
begin
FTrySuspend := False;
inherited Suspend;
while not fResumed do
sleep(0);
end;
end;
end;
procedure TThreadEx.Suspend;
begin
FResumed := false;
FTrySuspend := True;
while FTrySuspend do
Sleep(0);
end;
procedure TThreadEx.Resume;
begin
inherited Resume;
FResumed := True;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
n, i : Integer;
p : PInteger;
begin
n := 0;
p := @n;
ThreadEx := TThreadEx.Create(@p);
repeat
ThreadEx.Suspend;
Inc(p^);
Caption := IntToStr(p^);
Application.ProcessMessages;
i := n;
ThreadEx.Resume;
until i >= 999;
ThreadEx := nil;
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
if Assigned(ThreadEx) then
ThreadEx.Resume;
end;
procedure TForm1.Button3Click(Sender : TObject);
begin
if Assigned(ThreadEx) then
ThreadEx.Suspend;
end;
end.
← →
Defunct © (2005-08-25 02:34) [91]Fay © (25.08.05 02:22) [90]
Да, там deadlock...
Попробуйте [89]
← →
Fay © (2005-08-25 02:38) [92]2 Defunct © (25.08.05 2:34) [91]
Я тут весь пью пиво, зоркость ума сбилась.
Приведите, plz, просто код процедур для замены. Если не сложно...
← →
Defunct © (2005-08-25 02:45) [93]> Fay © (25.08.05 02:38) [92]
Просто замените весь класс TThreadEx на [89].
Там поменялось:
- suspend
- execute
- выброшено поле fResumed
- выброшена модификация метода Resume
← →
Fay © (2005-08-25 03:12) [94]2 Defunct © (25.08.05 2:45) [93]
DoIt вывел наружу (просто так).
ДобавилSleep(0)в Execute;unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PPInteger = ^PInteger;
TForm1 = class(TForm)
Button1 : TButton;
Button2 : TButton;
procedure Button1Click(Sender : TObject);
procedure Button2Click(Sender : TObject);
end;
TThreadEx = class(TThread)
private
FTrySuspend : Boolean;
FP : PPInteger;
protected
procedure Execute; override;
public
constructor Create(p : PPInteger); reintroduce;
procedure Suspend;
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
var
ThreadEx : TThreadEx = nil;
constructor TThreadEx.Create(p : PPInteger);
begin
inherited Create(True);
if not Assigned(p^) then
raise Exception.Create("не насилуй");
FP := p;
FreeOnTerminate := True;
FTrySuspend := False;
Resume;
end;
procedure DoIt(var p : PInteger);
var
tmp : PInteger;
begin
tmp := p;
p := nil;
p := tmp;
end;
procedure TThreadEx.Execute;
begin
while not Terminated do
begin
DoIt(FP^);
if FTrySuspend then
begin
FTrySuspend := False;
Sleep(0); // Потоку ничто не мешает переключиться именно здесь
inherited Suspend;
end;
end;
end;
procedure TThreadEx.Suspend;
begin
FTrySuspend := True;
while FTrySuspend do
Sleep(0);
end;
procedure TForm1.Button1Click(Sender : TObject);
var
n, i : Integer;
p : PInteger;
begin
n := 0;
p := @n;
ThreadEx := TThreadEx.Create(@p);
repeat
ThreadEx.Suspend; // (1) Выполняется в основном потоке
Inc(p^);
Caption := IntToStr(p^);
Application.ProcessMessages;
i := n;
ThreadEx.Resume;
until i >= 999;
ThreadEx.Terminate;
ThreadEx := nil;
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
if Assigned(ThreadEx) then
ThreadEx.Resume;
end;
end.
← →
Fay © (2005-08-25 03:30) [95]Кошки-мышки-крыски-жучки какие-то 8)
← →
Defunct © (2005-08-25 03:32) [96]> // Потоку ничто не мешает переключиться именно здесь
Ваша правда.. и это приводит к deadlock"у.
в таком случае меняем suspend так:procedure TThreadEx.Suspend;
begin
FTrySuspend := True;
while not Suspended do
Sleep(0);
end;
← →
Defunct © (2005-08-25 03:36) [97]Fay © (25.08.05 03:30) [95]
а вы хотели чтобы тут кто-то сходу выдал решение через "задницу" с одним только suspend, надежное как RTLCS? ;>
надеюсь [96] будет последней модификацией ;>
← →
Fay © (2005-08-25 04:33) [98]2 Defunct © (25.08.05 3:36) [97]
Это код из генофонда.
Для глюка хватит переключения потока в выделенном месте.procedure TThread.Suspend;
var
OldSuspend: Boolean;
begin
OldSuspend := FSuspended;
try
FSuspended := True;
// Выделенное место
{$IFDEF MSWINDOWS}
CheckThreadError(Integer(SuspendThread(FHandle)) >= 0);
{$ENDIF}
{$IFDEF LINUX}
CheckThreadError(pthread_kill(FThreadID, SIGSTOP));
{$ENDIF}
except
FSuspended := OldSuspend;
raise;
end;
end;
Может уже хватит моделировать ошибки? 8)
Просто я не верю, что Вы - убеждённый борец за защиту данных с пом. Suspend...
← →
Fay © (2005-08-25 04:37) [99]К [98]
Не "хватит", а "необходимо".
← →
Fay © (2005-08-25 04:38) [100]К [99]
В с мысле "Для глюка необходимо..."
← →
Slym © (2005-08-25 04:57) [101]Гомики так и получаются, от использования ануса не по назначению.
← →
Fay © (2005-08-25 05:02) [102]2 Defunct © (25.08.05 3:36) [97]
[98] - [100] бред.
Я чуть не сдвинулся модель рисовать 8)
Способ действительно работает. Но только именно с парой потоков. Т.е. с тремя (два ведут себя как основной в примере) не прокатит. Производительность никакая, но мы ведь не это обсуждаем 8)).
← →
Fay © (2005-08-25 05:02) [103]Но я ещё подумаю 8))
← →
Defunct © (2005-08-25 07:01) [104]> Fay
> Просто я не верю, что Вы - убеждённый борец за защиту данных с пом. Suspend...
И правильно делаете. Интересно было только показать, что и такой способ синхронизации имеет место, и вполне работоспособен.
← →
volser (2005-08-25 16:40) [105]Я попробовал сделать совй пример с помощью крит секций, но у меня иногда все подвисает. Возможен ли с крит. секц. дедлок?
← →
Leonid Troyanovsky © (2005-08-25 16:58) [106]
> volser (25.08.05 16:40) [105]
> Я попробовал сделать совй пример с помощью крит секций,
> но у меня иногда все подвисает. Возможен ли с крит. секц.
> дедлок?
Конечно.
При неправильном ея употреблении.
--
Regards, LVT.
← →
Fay © (2005-08-25 17:17) [107]2 Defunct © (25.08.05 7:01) [104]
Работоспособен не метод, а применение его в нек. ситуациях, на которые есть существенные ограничения:
1) один из потоков должен знать про второй
2) потоков должно быть ровно два
К тому же, очевидно, подобную защиту нельзя встроить в сам защищаемый объект. Короче - полные дрова.
← →
Alexander Panov © (2005-08-25 17:56) [108]Fay © (25.08.05 17:17) [107]
1) один из потоков должен знать про второй
2) потоков должно быть ровно два
Совершенно необязательные условия.
← →
Fay © (2005-08-25 17:59) [109]2 Alexander Panov © (25.08.05 17:56) [108]
Многоуважаемый не потрудится объяснить, как вызвать метод объекта, не зная о его существовании?
← →
Alexander Panov © (2005-08-25 18:02) [110]Alexander Panov © (25.08.05 17:56) [108]
Это про что?
При чем здесь неизвестные методы?
← →
Fay © (2005-08-25 18:08) [111]2 Alexander Panov © (25.08.05 18:02) [110]
Suspend и Resume - это ведь методы?
← →
Alexander Panov © (2005-08-25 18:12) [112]Fay © (25.08.05 18:08) [111]
Suspend и Resume - это ведь методы?
Конечно. И они есть у каждого наследника TThread.
← →
Fay © (2005-08-25 18:18) [113]2 Alexander Panov © (25.08.05 18:12) [112]
Ну и как же их вызвать, не зная о сужествовании экземпляря?
← →
Alexander Panov © (2005-08-25 18:31) [114]Fay © (25.08.05 18:18) [113]
Ну и как же их вызвать, не зная о сужествовании экземпляря?
Это смотря как написать - уже снова повторяю тезис.
← →
Игорь Шевченко © (2005-08-25 18:32) [115]И все-таки, зачем ?
← →
Alexander Panov © (2005-08-25 18:33) [116]Игорь Шевченко © (25.08.05 18:32) [115]
И все-таки, зачем ?
Чтобы проявить смекалку;)
← →
Alexander Panov © (2005-08-25 18:34) [117]Игорь Шевченко © (25.08.05 18:32) [115]
Мало ли для чего иногда возникает надобность в извратах.
← →
Игорь Шевченко © (2005-08-25 18:39) [118]Alexander Panov © (25.08.05 18:33) [116]
Судя по длине ветки и количеству глюков, это не совсем смекалка.
← →
Fay © (2005-08-25 18:40) [119]2 Alexander Panov © (25.08.05 18:31) [114]
Пока я не видел примера без вызова метода экземпляра. Думаю, не увижу.
← →
Alexander Panov © (2005-08-25 18:44) [120]Fay © (25.08.05 18:40) [119]
Думаю, не увижу.
Думаю, что да. Не вижу смысла в том.
Все дело только лишь в желании сделать, а не в методах.
Страницы: 1 2 3 4 вся ветка
Текущий архив: 2005.09.18;
Скачать: CL | DM;
Память: 0.71 MB
Время: 0.05 c
