Форум: "Основная";
Текущий архив: 2005.09.18;
Скачать: [xml.tar.bz2];
Вниз
Как приостановить поток? Найти похожие ветки
← →
volser (2005-08-23 12:23) [0]вот часть кода
В ПОТОКЕ:
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-23 12:32) [1]2 volser (23.08.05 12:23)
>> Иногда цикл залипает
Который? Их тут два, вАщЕ-то.
← →
volser (2005-08-23 12:35) [2]2 Fay
тот, который с бипом.
← →
Alexander Panov © (2005-08-23 12:40) [3]Для приостановки потока у него есть метод Suspend.
Ты лучше опиши, чего ты хочешь добиться, тогда можно будет предложить метод решения.
← →
volser (2005-08-23 12:49) [4]
> Ты лучше опиши, чего ты хочешь добиться, тогда можно будет
> предложить метод решения.
Я в потоке работаю со списком (прохожу по циклу от 0 до каунт - 1), но в главном потоке мне нужно этот список очистить. Если не останавливать поток, то естественно иногда выводит, что индекс вышел за пределы допустимых значений. Вот я и хочу приостановить поток таки способом, что бы он дошел свой виток цикла и остановился.
Пробовал Suspend не подходит. Такое ощущение что он останавливается посреди витка цикла, а потом дальше продолжает, но он продолает работать с теми итемами которых нет (так как пределы цыкла вычислются только раз). Вот такая вот трабла.
← →
Fay © (2005-08-23 12:56) [5]volser (23.08.05 12:49) [4]
Критические секции тебе в руки
← →
Reindeer Moss Eater © (2005-08-23 12:57) [6]Все верно, поток мог вычислить очередной индекс списка, после чего ты ему делаешь suspend.
Затем список чистится.
Затем resume.
И продолжение выполнение потока.
Причем он понятия не имеет о том, что индекс уже вне границ.
← →
volser (2005-08-23 12:58) [7]
> Критические секции тебе в руки
А по подробней
← →
volser (2005-08-23 12:59) [8]
> Reindeer Moss Eater © (23.08.05 12:57) [6]
Вот я и говорю что suspend не подходит.
← →
Fay © (2005-08-23 13:00) [9]Щаз кто-нибудь напишет. Я не умею кратко излагать.
← →
Reindeer Moss Eater © (2005-08-23 13:01) [10]Критические секции здесь сами по себе тоже могут не спасти.
Весь цикл должен быть внутри крит. секции.
И если поток туда успел войти, а главный поток усыпил вторичный, то освободить секцию некому.
Тот, кто её занял спит.
← →
Reindeer Moss Eater © (2005-08-23 13:02) [11]>Вот я и говорю что suspend не подходит.
Не подходит ТВОЙ способ применения suspend, а не сам suspend.
← →
Fay © (2005-08-23 13:04) [12]2 Reindeer Moss Eater © (23.08.05 13:02) [11]
Suspend ВАЩЕ не подходит!
Это для крит. секций (и т.п.)
← →
Reindeer Moss Eater © (2005-08-23 13:05) [13]>Fay
Не подойтет вообще ничего, если не уметь организовать взаимодействие потоков.
← →
Fay © (2005-08-23 13:09) [14]2 Reindeer Moss Eater © (23.08.05 13:05) [13]
А Вы можете продемострировать надёжную защиту данных с помощью Suspend? Интересно взглянуть, т.к. я плохо себе это представляю.
← →
volser (2005-08-23 13:20) [15]А почему тот метод, который я описал в первом посте не катит?
На правильное применения Suspend с интересом посмотрю.
← →
Alexander Panov © (2005-08-23 13:34) [16]volser (23.08.05 13:20) [15]
Погоди минутку, сейчас пример дорисую.
← →
Alexander Panov © (2005-08-23 13:42) [17]Fay © (23.08.05 13:09) [14]
А Вы можете продемострировать надёжную защиту данных с помощью Suspend?
Без проблем. Но речь не об этом.
volser (23.08.05 12:59) [8]
Пример потока для твоего случая:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,SyncObjs, StdCtrls;
type
TThr=class(TThread)
private
FCS: TCriticalSection;
FList: TStringList;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Lock;
procedure Unlock;
procedure Terminate;
procedure Start;
procedure ClearList;
end;
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Thr: TThr;
List: TStringList;
implementation
{$R *.dfm}
{ TThr }
procedure TThr.ClearList;
begin
Lock;
try
FList.Clear;
finally
Unlock;
end;
end;
constructor TThr.Create;
begin
inherited CReate(True);
FList := TStringList.Create;
FreeOnTerminate := True;
FCS := TCriticalSection.Create;
Resume;
end;
destructor TThr.Destroy;
begin
FCS.Free;
inherited;
end;
procedure TThr.Execute;
var
i: Integer;
begin
while not Terminated do
begin
if Terminated then Exit;
Lock;
try
{Здесь работаем со списком FList, например:}
for i := 0 to 500 do
begin
FList.Add(IntToStr(FList.Count));
Sleep(10);
end;
finally
Unlock;
end;
Suspend;
end;
end;
procedure TThr.Lock;
begin
FCS.Enter;
end;
procedure TThr.Start;
begin
Resume;
end;
procedure TThr.Terminate;
begin
Resume;
inherited;
end;
procedure TThr.Unlock;
begin
FCS.Leave;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Thr := TThr.Create;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if not Assigned(Thr) then Exit;
Memo1.Lines.Add("Пытаюсь очистить список...");
Thr.ClearList;
Memo1.Lines[Memo1.Lines.Count-1] := Memo1.Lines[Memo1.Lines.Count-1] + "Ok";
Thr.Start;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Thr.Terminate;
Thr := nil;
end;
end.
← →
Alexander Panov © (2005-08-23 13:46) [18]Забыл в описание класса потока добавить поле для доступа к списку:
TThr=class(TThread)
private
FCS: TCriticalSection;
FList: TStringList;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Lock;
procedure Unlock;
procedure Terminate;
procedure Start;
procedure ClearList;
property List: TStringList read FList;
end;
Работать со списком можно так:Thr.Lock;
try
if Thr.List.Count>0 then Memo1.Lines.Add(Thr.List[0]);
finally
Trh.Unlock;
end;
← →
Fay © (2005-08-23 13:57) [19]2 Alexander Panov © (23.08.05 13:42) [17]
>> Без проблем. Но речь не об этом.
Не хотелось бы показаться занудой, но мне кажется, что были некоторые причины, по которым Вы применили именно кр. секции, а не прекрасный во всех отношениях Suspend...
← →
Reindeer Moss Eater © (2005-08-23 14:05) [20]А Вы можете продемострировать надёжную защиту данных с помощью Suspend? Интересно взглянуть, т.к. я плохо себе это представляю.
Главный поток вызывает suspend.
Убеждается в том, что вторичный поток спит.
Изменяет список.
Выставляет нужное свойство у вторичного потока.
Вторичный поток в своем коде прежде чем использовать элемент списка по индексу проверяет значение свойства-флага.
Хотя я бы конечно так не стал делать.
← →
Fay © (2005-08-23 14:11) [21]2 Reindeer Moss Eater © (23.08.05 14:05) [20]
Потоки имею "привычку" засыпать в самых разных местах, поэтому часть
>> Вторичный поток в своем коде прежде чем использовать элемент списка по индексу
>> проверяет значение свойства-флага.
вызывает некоторые сомнения.
← →
Alexander Panov © (2005-08-23 14:13) [22]Fay © (23.08.05 13:57) [19]
Не хотелось бы показаться занудой, но мне кажется, что были некоторые причины, по которым Вы применили именно кр. секции, а не прекрасный во всех отношениях Suspend...
Конечно причины были-)
И главная - это показать, как можно делать правильно.
А про Suspend - Reindeer Moss Eater © (23.08.05 14:05) [20] уже показл, как делается без проблем защита кода только лишь при помощи Suspend.
Можно даже и без "усыпляния" потока обойтись. Для этого достаточно достаточно использовать спин-блокировку:
Flag1,Flag2 - Boolean;
Flag2 - флаг занятости текущим потоком, Flag1 - "Чужим потоком"while not Flag2 do
begin
while not Flag1 do ;
Flag2 := True;
Flag2 := not Flag1;
end;
← →
Reindeer Moss Eater © (2005-08-23 14:15) [23]Какие именно сомнения?
Вторичным потоком рулит первичный.
Он ему делает суспенд.
Список изменяется только когда вторичный поток уснул.
Фактически фторичному потоку даже знать не надо, что его усыпляют иногда.
Все что ему надо - проверить свойство-флаг перед использованием элемента списка.
А когда именнно поток уснул по часам - по барабану.
← →
Alexander Panov © (2005-08-23 14:15) [24]Fay © (23.08.05 14:11) [21]
вызывает некоторые сомнения.
В какой части вызывает сомнения?
← →
Alexander Panov © (2005-08-23 14:19) [25]Испроавляю код из [22]:
while not Flag2 do
begin
while Flag1 do ;
Flag2 := True;
Flag2 := not Flag1;
end;
← →
Fay © (2005-08-23 14:44) [26]2 Reindeer Moss Eater © (23.08.05 14:15) [23]
2 Alexander Panov © (23.08.05 14:15) [24]
Вы издеваетесь?!Проверка какого-то там флага;
здесь мы уснули ...
а в это время со списком творят что-то;
... и проснулись
Используем элемент списка;
$опа
Да и не очень понятно, флаг проверять во сне, что-ли?
← →
Reindeer Moss Eater © (2005-08-23 14:54) [27]Да и не очень понятно, флаг проверять во сне, что-ли?
Все что ему надо - проверить свойство-флаг перед использованием элемента списка.
← →
Fay © (2005-08-23 14:56) [28]Reindeer Moss Eater © (23.08.05 14:54) [27]
А за что отвечает этот флаг (кстати)? И откуда уверенность, что флаг не изменится между его (флага) проверкой и обращением к списку?
← →
Reindeer Moss Eater © (2005-08-23 15:03) [29]MyList[Min(i,Flag)]
← →
Fay © (2005-08-23 15:11) [30]2 Reindeer Moss Eater © (23.08.05 15:03) [29]
Могу только пожелать Вам удачи. Она очень пригодится.
← →
Alexander Panov © (2005-08-23 15:18) [31]Fay © (23.08.05 15:11) [30]
Могу только пожелать Вам удачи. Она очень пригодится.
Не в удаче дело. Все, как в аптеке.
-----------------------------------
А весь этот разговор шел к тому, что путей решения может быть много. И не всегда то, что мы считаем неверным, неверно на самом деле. Надо только голову приложить.
← →
Alexander Panov © (2005-08-23 15:20) [32]Fay © (23.08.05 14:44) [26]
Используем элемент списка;
$опа
Что опа?
В данном случае используется блокировка на уровне элемента списка.
Если будет наложено условие, что элемент списка может быть удален извне, то будет использоваться блокировка на уровне всего списка.
← →
Fay © (2005-08-23 15:22) [33]2 Alexander Panov © (23.08.05 15:18) [31]
Этих голов уже нехилый курган сложено.
Хотя мне, честно говоря, по барабану - пишите, как хотите.
← →
Fay © (2005-08-23 15:26) [34]2 Alexander Panov © (23.08.05 15:20) [32]
Что ещё не понятно? Повторяю, Вы не знаете, где именно уснёт поток, и пока это так, проверки ничего не значат. Этих "свойств-флагов" самих впору защищать.
← →
Leonid Troyanovsky © (2005-08-23 15:34) [35]
> volser (23.08.05 12:49) [4]
>
> > Ты лучше опиши, чего ты хочешь добиться, тогда можно будет
>
> > предложить метод решения.
>
> Я в потоке работаю со списком (прохожу по циклу от 0 до
> каунт - 1), но в главном потоке мне нужно этот список очистить.
> Если не останавливать поток, то естественно иногда выводит,
> что индекс вышел за пределы допустимых значений. Вот я и
> хочу
RTFM: TThreadList, например.
Защищает свои данные критической секцией.
--
Regards, LVT.
← →
Alexander Panov © (2005-08-23 15:35) [36]Fay © (23.08.05 15:26) [34]
Что ещё не понятно? Повторяю, Вы не знаете, где именно уснёт поток, и пока это так, проверки ничего не значат.
Да неужели?
И кто же его усыплять будет? Дядя Вася?
А не мой ли поток будет его усыплять?
Может быть это Вы пишете программы так, что их невозможно контролировать, а у меня код в одном потоке знает, как работать с другими потоками, и что они делают в этот момент.
Может быть для написания двух строчек кода вместо одной надо излишне напрячься? Ну тогда увы. Так как это достаточно сложно, тогда дискусии неуместны. Я ретируюсь.
← →
Leonid Troyanovsky © (2005-08-23 15:39) [37]
> Reindeer Moss Eater © (23.08.05 14:15) [23]
> А когда именнно поток уснул по часам - по барабану.
А если он заснет посредине, скажем, Move?
Для синхронизации есть дофига API.
Кстати, даже четырехбайтовых значений положено InterLocked*
--
Regards, LVT.
← →
Reindeer Moss Eater © (2005-08-23 15:43) [38]А если он заснет посредине, скажем, Move?
А он сможет уснуть посреди Move?
← →
Alexander Panov © (2005-08-23 15:43) [39]Leonid Troyanovsky © (23.08.05 15:39) [37]
Для синхронизации есть дофига API.
Естественно, и намного эффективнее и правильнее использовать именно эти средства.
Leonid Troyanovsky © (23.08.05 15:39) [37]
А если он заснет посредине, скажем, Move?
Он сам заснет, что-ли?
Leonid Troyanovsky © (23.08.05 15:39) [37]
Кстати, даже четырехбайтовых значений положено InterLocked*
Это если используется блокировка Interlocked-функциями.
← →
Fay © (2005-08-23 15:43) [40]Reindeer Moss Eater © (23.08.05 15:43) [38]
он может уснуть ГДЕ УГОДНО
← →
Reindeer Moss Eater © (2005-08-23 15:45) [41]Fay, что ты мне хочешь доказать?
Что это не лучший способ?
Так я еще с десяток постов назад сказал, что не стал бы так делать.
← →
Fay © (2005-08-23 15:47) [42]2 Reindeer Moss Eater © (23.08.05 15:45) [41]
Я и не утверждаю, что ты стал бы так делать. Просто говорю - так низя.
← →
Leonid Troyanovsky © (2005-08-23 16:03) [43]
Alexander Panov © (23.08.05 15:43) [39]
>> А если он заснет посредине, скажем, Move?
> Он сам заснет, что-ли?
Это не моя терминология.
> Reindeer Moss Eater © (23.08.05 14:15) [23]
> Вторичным потоком рулит первичный.
> Он ему делает суспенд.
> Список изменяется только когда вторичный поток уснул.
А остановить его могут на любой атомарной операции.
> Кстати, даже четырехбайтовых значений положено InterLocked*
> Это если используется блокировка Interlocked-функциями.
Дык, и надо ее пользовать. Даже для однобайтовых.
--
Regards, LVT.
← →
Внук © (2005-08-23 16:20) [44]>>Alexander Panov © (23.08.05 15:43) [39]
Не смoжешь ты контролировать, когда именно уснет поток. И дело не в том, кто как пишет программы :) Но через Suspend надежной синхронизации не получится.
← →
Alexander Panov © (2005-08-23 16:45) [45]Внук © (23.08.05 16:20) [44]
Не смoжешь ты контролировать, когда именно уснет поток. И дело не в том, кто как пишет программы :) Но через Suspend надежной синхронизации не получится.
А мне и не нужно знать, когда он уснет после моей команды ему. Мне достаточно перед усыплением дождаться, пока поток закончит обработку защищаемых данных, взвести флаг о том, что данные используются в другом потоке, после этого усыпить его. И все. Надежней некуда.
← →
Leonid Troyanovsky © (2005-08-23 16:50) [46]
> Alexander Panov © (23.08.05 16:45) [45]
> Внук © (23.08.05 16:20) [44]
> Не смoжешь ты контролировать, когда именно уснет поток.
> А мне и не нужно знать, когда он уснет после моей команды
> ему. Мне достаточно перед усыплением дождаться, пока поток
> закончит обработку защищаемых данных,
А тогда и не требуется его усыплять (приостанавливать).
Закончил обработку (write) - данные консистентны.
--
Regards, LVT.
← →
Alexander Panov © (2005-08-23 17:13) [47]Leonid Troyanovsky © (23.08.05 16:50) [46]
тогда и не требуется его усыплять (приостанавливать).
Не требуется, если это не нужно.
А если нужно, то никто не мешает это сделать, причем совершенно потокобезопасно относительно совместной работы с данными этого и других потоков.
← →
Leonid Troyanovsky © (2005-08-23 17:25) [48]
> Alexander Panov © (23.08.05 17:13) [47]
>> тогда и не требуется его усыплять (приостанавливать).
> Не требуется, если это не нужно.
> А если нужно, то никто не мешает это сделать, причем совершенно
> потокобезопасно относительно совместной работы с данными
> этого и других потоков.
Дык, зачем тогда потокобезопасно приостанавливать?
Т.е., зачем оно может требоваться для синхронизации,
если оная уже произошла.
--
Regards, LVT.
← →
Alexander Panov © (2005-08-23 17:41) [49]Leonid Troyanovsky © (23.08.05 17:25) [48]
Т.е., зачем оно может требоваться для синхронизации,
если оная уже произошла.
Например, остановить поток для того, чтобы
1. Безопасно работать с другими данными, либо не дать потоку захватить другие данные.
2. Не разрешать потоку холостых циклов.
← →
Leonid Troyanovsky © (2005-08-23 17:48) [50]> Alexander Panov © (23.08.05 17:41) [49]
> Leonid Troyanovsky © (23.08.05 17:25) [48]
> Т.е., зачем оно может требоваться для синхронизации,
> если оная уже произошла.
> Например, остановить поток для того, чтобы
> 1. Безопасно работать с другими данными, либо не дать потоку
> захватить другие данные.
> 2. Не разрешать потоку холостых циклов.
Дык,
1. Эта другая задача синхронизации.
2. Откуда взяться холостым циклам, если поток должен ждать
синхронизирующих событий, т.е., должен спать (уже в терминологии Рихтера).
--
Regards, LVT.
← →
Alexander Panov © (2005-08-23 18:02) [51]Leonid Troyanovsky © (23.08.05 17:48) [50]
2. Откуда взяться холостым циклам, если поток должен ждать
синхронизирующих событий, т.е., должен спать (уже в терминологии Рихтера).
Так весь сыр-бор в ветке из-за того, можно или нет обойтись без объектов синхронизации.
← →
han_malign © (2005-08-23 18:27) [52]>Так весь сыр-бор в ветке из-за того, можно или нет обойтись без объектов синхронизации.
- дык Suspend никаким боком к синхронизации и не относится...
This function is primarily designed for use by debuggers. It is not intended to be used for thread synchronization. Calling SuspendThread on a thread that owns a synchronization object, such as a mutex or critical section, can lead to a deadlock if the calling thread tries to obtain a synchronization object owned by a suspended thread. To avoid this situation, a thread within an application that is not a debugger should signal the other thread to suspend itself. The target thread must be designed to watch for this signal and respond appropriately.
← →
Alexander Panov © (2005-08-23 19:09) [53]han_malign © (23.08.05 18:27) [52]
Хочешь пример, где можно синхронизацию осуществить методами Suspend/Resume?
← →
Fay © (2005-08-23 22:33) [54]2 Alexander Panov © (23.08.05 19:09) [53]
Я, конечно, не han_malign, но давно жду такой пример.
Будьте так добры...
← →
Alexander Panov © (2005-08-24 00:44) [55]Вот совершенно простой пример:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
TTest=class(Tthread)
private
FMemo: TMemo;
procedure UpdateMemo;
protected
procedure Execute; override;
public
constructor Create(Memo: TMemo);
end;
var
Form1: TForm1;
Test: Ttest;
isTerminate: Boolean;
implementation
{$R *.dfm}
{ TTest }
constructor TTest.Create(Memo: TMemo);
begin
inherited Create(True);
FreeOnTerminate := True;
FMemo := Memo;
Resume;
end;
procedure TTest.Execute;
begin
while not Terminated do
begin
UpdateMemo;
Sleep(2000);
Suspend;
end;
end;
procedure TTest.UpdateMemo;
begin
FMemo.Lines.Add("Доп. поток: состояние расчетов");
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Test := TTest.Create(Memo1);
isTerminate := False;
with Test do
begin
while not isTerminate do
begin
if Suspended then
begin
Memo1.Lines.Add("Основной поток: работаю с Memo1");
Label1.Caption := "Основной поток: Работаю";
Application.ProcessMessages;
Sleep(1000);
Resume;
end;
while not Suspended do
begin
Label1.Caption := "Основной поток: жду освобождения ресурса";
Application.ProcessMessages;
end;
end;
Label1.Caption := "Поток закончил работу";
Terminate;
end;
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 00:47) [56]Взять пример можно здесь:
ftp://ftp.almar.net.ru/pub/simplethread/simplethread.zip
← →
Defunct © (2005-08-24 01:07) [57]> Alexander Panov
Пример бесспорно рабочий, но не решает сабжевый вопрос. Всмысле конанду доп потоку на приостановку должен отдавать основной поток. Если можете, подправьте код, (там собсно нечего подправлять, флажек один добавить) было бы интересно и познавательно для всех.
← →
Alexander Panov © (2005-08-24 01:25) [58]Defunct © (24.08.05 1:07) [57]
Напрямую использовать Suspend потоку все равно не получится.
А вот так можно сделать:unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
TTest=class(Tthread)
private
FTrySuspend: Boolean;
FMemo: TMemo;
procedure UpdateMemo;
protected
procedure Execute; override;
public
constructor Create(Memo: TMemo);
procedure Suspend;
end;
var
Form1: TForm1;
Test: Ttest;
isTerminate: Boolean;
implementation
{$R *.dfm}
{ TTest }
constructor TTest.Create(Memo: TMemo);
begin
inherited Create(True);
FreeOnTerminate := True;
FMemo := Memo;
FTrySuspend := False;
Resume;
end;
procedure TTest.Execute;
begin
while not Terminated do
begin
UpdateMemo;
Sleep(2000);
if FTrySuspend then
begin
FTrySuspend := False;
Suspended := True;
end;
end;
end;
procedure TTest.Suspend;
begin
FTrySuspend := True;
end;
procedure TTest.UpdateMemo;
begin
FMemo.Lines.Add("Доп. поток: состояние расчетов");
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Test := TTest.Create(Memo1);
isTerminate := False;
while not isTerminate do
begin
Test.Suspend;
while not Test.Suspended do
begin
Label1.Caption := "Основной поток: жду освобождения ресурса";
Application.ProcessMessages;
if isTerminate then Break;
end;
Memo1.Lines.Add("Основной поток: работаю с Memo1");
Label1.Caption := "Основной поток: Работаю";
Application.ProcessMessages;
Sleep(1000);
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 01:27) [59]ftp://ftp.almar.net.ru/pub/simplethread/simplethread1.zip
← →
Defunct © (2005-08-24 01:38) [60]> Alexander Panov
Вполне приличное решение. Даже вероятно в некоторых случаях лучше чем крит. секция.
Только, я бы добавил еще следующее изменение, чтобы после вызова suspend управляющий поток гарантировано мог работать с данными остановленного потока без лишних проверок:procedure TTest.Suspend;
begin
fTrySuspend := True;
while fTrySuspend do
begin
sleep(10);
Application.ProcessMessages
end
end;
← →
Внук © (2005-08-24 08:48) [61]>>Alexander Panov © (23.08.05 16:45) [45]
>>Alexander Panov © (24.08.05 01:25) [58]
Угу, это гарантирует безопасный доступ к данным, но во время работы второго потока первый может еще не перейти в состояние приостановки, то есть ему все еще будет выделяться процессорное время. Да и приостанавливать его, как уже отмечали, в этом случае необязательно. Таким образом, мы говорим об одном и том же, только я не считаю возможным в этом случае использовать термин "синхронизация" :)
← →
Игорь Шевченко © (2005-08-24 09:47) [62]Иван Кулибин в гробу от зависти переворачивается.
← →
Alexander Panov © (2005-08-24 10:01) [63]Игорь Шевченко © (24.08.05 9:47) [62]
"Голь на выдумки хитра" ;)
← →
Fay © (2005-08-24 14:06) [64]2 Alexander Panov © (24.08.05 1:27) [59]
Во-первых...
Посмотрите загрузку процессора.
← →
Alexander Panov © (2005-08-24 14:07) [65]Fay © (24.08.05 14:06) [64]
Во-первых...
Посмотрите загрузку процессора.
А что, были разговоры про загрузку процессора?
← →
Fay © (2005-08-24 16:47) [66]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.
← →
Fay © (2005-08-24 17:04) [67]Можно несколько упростить.
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 17:59) [68]2 Alexander Panov
Ау! Вы где? Ваш, IMO, пример кривой!
← →
Alexander Panov © (2005-08-24 18:25) [69]Fay © (24.08.05 16:47) [66]
Если во время работы программы перетащить форму - будет галюн.
А кто сказал, что пример на это расчитан?
Замени TMemo на TStringList - ошибка исчезнет.
← →
Fay © (2005-08-24 18:34) [70]2 Alexander Panov © (24.08.05 18:25) [69]
Ничего не нужно таскать. Просто надо взять [67]
← →
Fay © (2005-08-24 18:45) [71]Alexander Panov © (24.08.05 18:25) [69]
... да и нет там никакого Memo ...
← →
Defunct © (2005-08-24 18:58) [72]> 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 19:06) [73]2 Defunct © (24.08.05 18:58) [72]
Первое впечатление : совершенно не понятно, что демонстрирует пример. Защиту чего от чего?
Можно полный код?
P.S.
Проверкиif Assigned( ThreadEx )не надёжны, т.к. FreeOnTerminate := True;
← →
Fay © (2005-08-24 19:09) [74]Fay © (24.08.05 19:06) [73]
Так же не вижу (я, конечно, ещё посмотрю внимательно), гдеThreadEx := nil. Без этогоif Assigned(ThreadEx)не имеет смысла.
← →
Defunct © (2005-08-24 19:27) [75]Fay © (24.08.05 19:06) [73]
> Защиту чего от чего?
Пофантазируйте. Поставьте
ThreadEx.Suspend;
< меняем поля ThreadEx >
ThreadEx.Resume;
← →
Defunct © (2005-08-24 19:37) [76]> Fay
> Проверки if Assigned( ThreadEx ) не надёжны, т.к. FreeOnTerminate := True;
Я знаю, они там ни на что не влияют, более того в этом куске кода не предусмотрено завершения потока. Т.к. оно и не надо для демострации синхронизации.
← →
Fay © (2005-08-24 19:57) [77]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 21:03) [78]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 21:14) [79]2 Defunct © (24.08.05 21:03) [78]
until n >= 999
← →
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]
Думаю, не увижу.
Думаю, что да. Не вижу смысла в том.
Все дело только лишь в желании сделать, а не в методах.
← →
Alexander Panov © (2005-08-25 18:51) [121]Кстати, не приходила в голову простая мысль, что защищаются не данные, а код, и что в этот код всегда можно передать все, что угодно, в том числе и экземпляр потока?
← →
Alexander Panov © (2005-08-25 18:53) [122]Смысла в продолжении дискуссии нет, так как для всех поставленных условий не вижу существенных проблем в реализации...
← →
Fay © (2005-08-25 19:04) [123]2 Alexander Panov © (25.08.05 18:51) [121]
>> не приходила в голову простая мысль, что защищаются не данные, а код,
Нет. ТАКАЯ мысль мне в голову не приходила.
Что Вы курите?
← →
Defunct © (2005-08-25 20:54) [124]> Fay © (25.08.05 19:04) [123]
Прочитайте сабж ;>
ведь речь не шла о том как правильно сделать синхронизацию, речь шла о приостановке потока ;>
> Игорь Шевченко © (25.08.05 18:39) [118]
Хаха, мазохизмъ
← →
volser (2005-08-25 21:27) [125]Я нашел попроще решение, просто поставил try в тело цикла вспомагательного потока :-)
Главное что работает.
← →
Defunct © (2005-08-25 21:35) [126]volser (25.08.05 21:27) [125]
Галиматья какая-то, причем тут Try?
← →
Fay © (2005-08-25 21:55) [127]2 volser (25.08.05 21:27) [125]
Приведённый [0] код корявый, можете его больше не приводить.
Вам будет лучше объяснить решаемую по-русски.
← →
volser (2005-08-25 22:20) [128]
> Галиматья какая-то, причем тут Try?
При том, что если лист очищается то вылетает exception после чего продолжается следующий виток цикла с обновленными данными.
← →
Defunct © (2005-08-25 22:51) [129]volser (25.08.05 22:20) [128]
При проектировании канализации можно, конечно, закладывать гнилую деревянную трубу, а места где течет - затыкать паклей, только все равно дерьмо просочится через время в другом месте.
← →
Alexander Panov © (2005-08-25 23:19) [130]volser (25.08.05 22:20) [128]
Вобчем, держи пример.
Возможны опечатки, так как код писал прямо здесь.TListProcess=class(TThread)
private
FList: TStringList;
FCS: TCriticalSection;
procedure Lock;
procedure Unlock;
protected
procedure Execute; override;
public
constructor Create(List: TStringList);
destructor Destroy; override;
procedure Clear;
procedure Start;
procedure Stop;
end;
implementation
constructor TListProcess.Create(List: TStringList);
begin
inherited Create(True);
FreeOnTerminate := True;
FCS := TCriticalSection.Create;
FList := List;
end;
destructor TListProcess.Destroy;
begin
FCS.Free;
inherited;
end;
procedure TListProcess.Clear;
begin
Lock;
try
FList.Clear;
finally
Unlock;
end;
end;
procedure TListProcess.Lock;
begin
FCS.Enter;
end;
procedure TListProcess.Unlock;
begin
FCS.Leave;
end;
procedure TListProcess.Start;
begin
Resume;
end;
procedure TListProcess.Stop;
begin
Lock;
try
Suspend;
finally
Unlock;
end;
end;
procedure Execute;
var
i: Integer;
begin
while not Terminated do
begin
for i := 0 to FList.Count-1 do
begin
Lock;
try
//Работаем со строкой из списка.
finally
Unlock;
end;
if FList.Count=0 then Break;
end;
Suspend;
end;
end;
← →
Fay © (2005-08-26 04:19) [131]2 Alexander Panov © (25.08.05 23:19) [130]
Пример довольно приличный.
"Опечатка" только одна : procedureTListProcess.Execute;
Но есть и злобные баги, которые, видимо, происходят от позднего времени и конца трудовой недели 8).for i := 0 to FList.Count-1 do
begin
Lock;
try
Lock после for - не кошерно. Совершенно не очевидно, что количество не изменится. Тут и модный Clear не спасёт.if FList.Count=0 then Break;
Обращение вне кр. секции - ахтунг.
← →
Игорь Шевченко © (2005-08-26 10:02) [132]И эти люди запрещают мне ковырять в носу (с) известный анекдот
← →
Alexander Panov © (2005-08-26 10:16) [133]Справедливо. Придется весь список блокировать.
procedure Execute;
var
i: Integer;
begin
while not Terminated do
begin
Lock;
try
for i := 0 to FList.Count-1 do
begin
if Terminated then Exit;
//Работаем со строкой из списка.
end;
finally
Unlock;
end;
Suspend;
end;
end;
← →
Slym © (2005-08-26 10:56) [134]Не проще Event создать?
в потоке Event.WaitFor
в основном потоке Event.Pulse
← →
Slym © (2005-08-26 11:00) [135]Удалено модератором
← →
Alexander Panov © (2005-08-26 11:30) [136]Slym © (26.08.05 10:56) [134]
Не проще Event создать?
На кой?
← →
Alexander Panov © (2005-08-26 11:31) [137]Особенно умиляет Event.Pulse
← →
Fay © (2005-08-26 13:26) [138]2 Alexander Panov © (26.08.05 11:30) [136]
>> На кой?
Для тех случаев, когда про доп. потоки мы знаем только то, что они, возможно, есть. Правда весь код тогда будет сильно отличаться, но ведь можно "пофантазировать" (© Defunct), что Slym имел ввиду и это...
2 Alexander Panov © (26.08.05 11:31) [137]
Но ведь TCriticalSection не умиляет?
8)
← →
Alexander Panov © (2005-08-26 13:51) [139]Fay © (26.08.05 13:26) [138]
Но ведь TCriticalSection не умиляет?
А вот Pulse - умиляет.
← →
Fay © (2005-08-26 14:42) [140]2 Alexander Panov © (26.08.05 13:51) [139]
Видимо, имеется некий гипотетический (или даже написанный Slym) класс, являющийся обёрткой для Event, метод Pulse которого вызывает PulseEvent.
Не сказал бы, что испытываю по этому поводу какие-либо эмоции, но рад за Вас 8).
Страницы: 1 2 3 4 вся ветка
Форум: "Основная";
Текущий архив: 2005.09.18;
Скачать: [xml.tar.bz2];
Память: 0.89 MB
Время: 0.02 c
