| Новости | Поиск | 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-24 21:17:00) [61]

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;

---

Fay   (2005-08-24 21:14:00) [62]

2 Defunct ©   (24.08.05 21:03) [78]
until n >= 999

---

Defunct   (2005-08-24 21:03:00) [63]

Fay ©   (24.08.05 19:57) [77]

По меньшей мере вы делаете преднамерено небезопастный код, игнорируете синхронизацию - обращаетесь к незащищенной переменной в until, т.к. обращения к P^ безопастны только между Suspend<->Resume.

Знаете, можно и с крит. секцией сделать такую ошибку.

procedure TThreadEx.Execute;
...
  CS.Acquire;
  try
     DoIt;
  finally
     CS.Release
  end;
...
end;

ThreadEx := TThreadEx.Create(@p);
repeat
  ThreadEx.Suspend;
  CS.Acquire;
  try            <--- ЗДЕСЬ ОБРАЩЕНИЕ К P^ БЕЗОПАСТНО
    Inc(p^);
    Caption := IntToStr(p^);
  finally
    CS.Release;
  end;
  Application.ProcessMessages;
  ThreadEx.Resume;
until p^ >= 999;  <--- ЗДЕСЬ ТОЖЕ ТРЕБУЕТСЯ ЗАЩИТА
                  <--- ЛИБО БУДЬТЕ ДОБРЫ СКОПИРУЙТЕ ЗНАЧЕНИЕ,
                  <--- НА ТОМ УЧАСТКЕ КОДА, ГДЕ ОБРАЩЕНИЕ
                  <--- К P^ БЫЛО ЗАЩИЩЕНО.
ThreadEx := nil;

---

Fay   (2005-08-24 19:57:00) [64]

2 Defunct ©   (24.08.05 19:37) [76]

Я тут немного пофантазировал. Попробуйте 8).

unit Unit1;

interface

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

type
 PPInteger = ^PInteger;
 TForm1 = class(TForm)
   Button1 : TButton;
   Label1 : TLabel;
   Button2 : TButton;
   Button3 : TButton;
   procedure Button1Click(Sender : TObject);
   procedure Button2Click(Sender : TObject);
   procedure Button3Click(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 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 not fTrySuspend do
   Sleep(0);
end;

procedure TForm1.Button1Click(Sender : TObject);
var
 n : Integer;
 p : PInteger;
begin
 n := 0;
 p := @n;
 ThreadEx := TThreadEx.Create(@p);
 repeat
   ThreadEx.Suspend;
   Inc(p^);
   Caption := IntToStr(p^);
   Application.ProcessMessages;
   ThreadEx.Resume;
 until p^ >= 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-24 19:37:00) [65]

> Fay
> Проверки if Assigned( ThreadEx ) не надёжны, т.к. FreeOnTerminate := True;

Я знаю, они там ни на что не влияют, более того в этом куске кода не предусмотрено завершения потока. Т.к. оно и не надо для демострации синхронизации.

---

Defunct   (2005-08-24 19:27:00) [66]

Fay ©   (24.08.05 19:06) [73]
> Защиту чего от чего?

Пофантазируйте. Поставьте

ThreadEx.Suspend;
< меняем поля ThreadEx >
ThreadEx.Resume;

---

Fay   (2005-08-24 19:09:00) [67]

Fay ©   (24.08.05 19:06) [73]
Так же не вижу (я, конечно, ещё посмотрю внимательно), где ThreadEx := nil. Без этого if Assigned(ThreadEx)не имеет смысла.

---

Fay   (2005-08-24 19:06:00) [68]

2 Defunct ©   (24.08.05 18:58) [72]
Первое впечатление : совершенно не понятно, что демонстрирует пример. Защиту чего от чего?
Можно полный код?

P.S.
Проверки if Assigned( ThreadEx )не надёжны, т.к. FreeOnTerminate := True;

---

Defunct   (2005-08-24 18:58:00) [69]

> Fay

А такой вариант не глючит, и процессорное время не хавает.

 type
   TThreadEx = class(TThread)
   private
      fMemo       : TMemo;
      fTrySuspend : boolean;

      procedure Execute;override;
   public
      procedure Suspend;
      constructor Create(AMemo : TMemo);
   end;

constructor TThreadEx.Create;
begin
 if not Assigned( AMemo ) then
    raise Exception.Create('не насилуй');
 fMemo := AMemo;
 inherited Create( True );
 FreeOnTerminate := True;
 fTrySuspend := false;
 resume;
end;

procedure TThreadEx.Suspend;
begin
 fTrySuspend := True;
 while not fTrySuspend do
 begin
   sleep(0);
   //Application.ProcessMessages;
 end;
end;

procedure TThreadEx.Execute;
begin
 while not Terminated do
 begin
    fMemo.Lines.Text := 'работает доп поток';

    if fTrySuspend then
    begin
       fTrySuspend := False;
       fMemo.Lines.Text := 'доп поток остановлен по требованию';
       inherited Suspend;
    end;
 end;
end;



var
 ThreadEx : TThreadEx = nil;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ThreadEx := TThreadEx.Create( Memo1 );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if Assigned( ThreadEx ) then
 begin
    ThreadEx.Suspend;
    Memo1.Lines.Text := 'Поток остановлен';
 end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if Assigned( ThreadEx ) then
 begin
    ThreadEx.Resume;
 end;
end;

---

Fay   (2005-08-24 18:45:00) [70]

Alexander Panov ©   (24.08.05 18:25) [69]
... да и нет там никакого Memo ...

---

Fay   (2005-08-24 18:34:00) [71]

2 Alexander Panov ©   (24.08.05 18:25) [69]
Ничего не нужно таскать. Просто надо взять [67]

---

Alexander Panov   (2005-08-24 18:25:00) [72]

Fay ©   (24.08.05 16:47) [66]
Если во время работы программы перетащить форму - будет галюн.

А кто сказал, что пример на это расчитан?

Замени TMemo на TStringList - ошибка исчезнет.

---

Fay   (2005-08-24 17:59:00) [73]

2 Alexander Panov
Ау! Вы где? Ваш, IMO, пример кривой!

---

Fay   (2005-08-24 17:04:00) [74]

Можно несколько упростить.

procedure TTest.UpdateMemo;
var
 p : PInteger;
begin
 p := FP^;
 FP^ := nil;
 Application.ProcessMessages;
 FP^ := p;
end;

procedure TForm1.Button1Click(Sender : TObject);
var
 n : Integer;
 p : PInteger;
begin
 n := 0;
 p := @n;  
 Test := TTest.Create(@p);
 isTerminate := False;
 while not isTerminate do
   begin
     Test.Suspend;
     while not Test.Suspended do
       begin
         Label1.Caption := 'Основной поток: жду освобождения ресурса';
         Application.ProcessMessages;
          // Тут выяснилось, что кнопку Button2 нажали
         // if isTerminate then
         if n > 10 then
         Break;
       end;
     Label1.Caption := 'Основной поток: Работаю';
     Application.ProcessMessages;
     Inc(p^);
     Test.Resume;
   end;
 Label1.Caption := 'Поток закончил работу';
 Test.Terminate;
end;

---

Fay   (2005-08-24 16:47:00) [75]

2 Alexander Panov ©   (24.08.05 14:07) [65]

Ошибку можно ждать долго.
Я несколько модифицировал приведённый код.
Если модификация не кажется правомерной - скажите.

Если во время работы программы перетащить форму - будет галюн.

unit Unit1;

interface

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

type
 PPInteger = ^PInteger;
 TForm1 = class(TForm)
   Button1 : TButton;
   Label1 : TLabel;
   Button2 : TButton;
   procedure Button1Click(Sender : TObject);
   procedure Button2Click(Sender : TObject);
   procedure FormClose(Sender : TObject; var Action : TCloseAction);
 end;

 TTest = class(Tthread)
 private
   FTrySuspend : Boolean;
   FP : PPInteger;
   procedure UpdateMemo;
 protected
   procedure Execute; override;
 public
   constructor Create(p : PPInteger); reintroduce;
   procedure Suspend;
 end;

var
 Form1 : TForm1;
 Test : Ttest;
 isTerminate : Boolean;

implementation

{$R *.dfm}

{ TTest }

constructor TTest.Create(p : PPInteger);
begin
 inherited Create(True);
 FreeOnTerminate := True;
 FP := p;
 FTrySuspend := False;
 Resume;
end;

procedure TTest.Execute;
begin
 while not Terminated do
   begin
     UpdateMemo;
     if FTrySuspend then
       begin
         FTrySuspend := False;
         // Sleep(100);
         Suspended := True;
       end;
   end;
end;

procedure TTest.Suspend;
begin
 FTrySuspend := True;
end;

procedure TTest.UpdateMemo;
var
 p : PInteger;
begin
 p := FP^;
 FP^ := nil;
 Sleep(555);
 FP^ := p;
end;

procedure TForm1.Button1Click(Sender : TObject);
var
 n : Integer;
 p : PInteger;
begin
 n := 0;
 p := @n;  
 Test := TTest.Create(@p);
 isTerminate := False;
 while not isTerminate do
   begin
     Test.Suspend;
     while not Test.Suspended do
       begin
         Label1.Caption := 'Основной поток: жду освобождения ресурса';
         Application.ProcessMessages;
          // Тут выяснилось, что кнопку Button2 нажали
         // if isTerminate then
         Break;
       end;
     Label1.Caption := 'Основной поток: Работаю';
     Application.ProcessMessages;
     Inc(p^);
     Sleep(777);
     Inc(p^);
     Test.Resume;
   end;
 Label1.Caption := 'Поток закончил работу';
 Test.Terminate;
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
 IsTerminate := True;
end;

procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);
begin
 IsTerminate := True;
end;

end.


---

Alexander Panov   (2005-08-24 14:07:00) [76]

Fay ©   (24.08.05 14:06) [64]
Во-первых...
Посмотрите загрузку процессора.

А что, были разговоры про загрузку процессора?

---

Fay   (2005-08-24 14:06:00) [77]

2 Alexander Panov ©   (24.08.05 1:27) [59]
Во-первых...
Посмотрите загрузку процессора.

---

Alexander Panov   (2005-08-24 10:01:00) [78]

Игорь Шевченко ©   (24.08.05 9:47) [62]

"Голь на выдумки хитра" ;)

---

Игорь Шевченко   (2005-08-24 09:47:00) [79]

Иван Кулибин в гробу от зависти переворачивается.

---

Внук   (2005-08-24 08:48:00) [80]

>>Alexander Panov ©   (23.08.05 16:45) [45]
>>Alexander Panov ©   (24.08.05 01:25) [58]
 Угу, это гарантирует безопасный доступ к данным, но во время  работы второго потока первый может еще не перейти в состояние приостановки, то есть ему все еще будет выделяться процессорное время. Да и приостанавливать его, как уже отмечали, в этом случае необязательно. Таким образом, мы говорим об одном и том же, только я не считаю возможным в этом случае использовать термин "синхронизация" :)

---

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

Наверх