| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как приостановить поток?

Страницы:   < 1 2 3 4 5 6 7 >

volser ©   (2005-08-23 12:23:00) 

вот часть кода

В ПОТОКЕ:
 while not Terminated do
 begin
   if not Paused then
   begin
     try
       ExecTick := False;
       ...
     finally
       ExecTick := True;
     end;
   end;
   Sleep(10);
 end;

В ГЛАВНОМ ПОТОКЕ:
 Thread.Paused := True;
 while not Thread.ExecTick do
 begin
   Windows.Beep(500,50);
 end;
 ...
 Thread.Paused := False;

Иногда цикл залипает. В чем проблема?

---

Fay   (2005-08-25 04:38:00) [41]

К [99]
В с мысле "Для глюка необходимо..."

---

Fay   (2005-08-25 04:37:00) [42]

К [98]
Не "хватит", а "необходимо".

---

Fay   (2005-08-25 04:33:00) [43]

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...

---

Defunct   (2005-08-25 03:36:00) [44]

Fay ©   (25.08.05 03:30) [95]

а вы хотели чтобы тут кто-то сходу выдал решение через "задницу" с одним только suspend, надежное как RTLCS? ;>

надеюсь [96] будет последней модификацией ;>

---

Defunct   (2005-08-25 03:32:00) [45]

> // Потоку ничто не мешает переключиться именно здесь

Ваша правда.. и это приводит к deadlock'у.
в таком случае меняем suspend так:

procedure TThreadEx.Suspend;
begin
  FTrySuspend := True;
  while not Suspended do
        Sleep(0);
end;

---

Fay   (2005-08-25 03:30:00) [46]

Кошки-мышки-крыски-жучки какие-то 8)

---

Fay   (2005-08-25 03:12:00) [47]

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.



---

Defunct   (2005-08-25 02:45:00) [48]

> Fay ©   (25.08.05 02:38) [92]

Просто замените весь класс TThreadEx на [89].
Там поменялось:
- suspend
- execute
- выброшено поле fResumed
- выброшена модификация метода Resume

---

Fay   (2005-08-25 02:38:00) [49]

2 Defunct ©   (25.08.05 2:34) [91]
Я тут весь пью пиво, зоркость ума сбилась.
Приведите, plz, просто код процедур для замены. Если не сложно...

---

Defunct   (2005-08-25 02:34:00) [50]

Fay ©   (25.08.05 02:22) [90]

Да, там deadlock...
Попробуйте [89]

---

Fay   (2005-08-25 02:22:00) [51]

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:11:00) [52]

Собсно там и делать ничего не пришлось, просто исправать указанную вами строчку:

> 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;

---

Defunct   (2005-08-25 02:01:00) [53]

> Fay
пока не пришло. жду ;>

> Fay ©   (25.08.05 01:43) [87]

хаха, и действительно.
Поделиться травой? ;>
Да, уж я тоже не углядел.

Сейчас сделаю нормальный вариант

---

Fay   (2005-08-25 01:43:00) [54]

2 Defunct ©   (24.08.05 22:11) [82]

FTrySuspend := True;
while not fTrySuspend do
 Sleep(0);

Это вАщЕ шедевр 8)

---

Fay   (2005-08-25 01:41:00) [55]

2 Defunct ©   (25.08.05 1:29) [84]
Выслал на указанное в анкете мыло.
Собственно, хто угодно в состоянии добавить в [80] и [82] к [77]...

---

Fay   (2005-08-25 01:36:00) [56]

2 Defunct ©   (25.08.05 1:29) [84]

>> Наврятли
Фигушки. Улучшений не наблюдается.
Выслать?

>> тут уже все по канонам семафоров
Сомневаюсь 8).

---

Defunct   (2005-08-25 01:29:00) [57]

> Fay

Наврятли, тут уже все по канонам семафоров.

---

Fay   (2005-08-25 00:54:00) [58]

2 Defunct ©   (24.08.05 22:11) [82]
Щяз, думаю, испорчу впечатление.

---

Defunct   (2005-08-24 22:11:00) [59]

с учетом [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;

---

Defunct   (2005-08-24 21:58:00) [60]

> Fay

Вы намекаете на то, что поток останавливается не сразу после inherited suspend? если оно так.. тогда конечно, ни пример АП, ни мой, не годятся.

---

Страницы:   < 1 2 3 4 5 6 7 >

Наверх