Нужна критика кода-)

← →
jack128 © (2004-11-12 00:28) [40]

GuAV © (12.11.04 0:21) [37]
Application.Processmessages
хм, да. Но это все таки тоже исключение. С этом методом надо очень осторожно оброщаться.

← →
GuAV © (2004-11-12 00:28) [41]

jack128 © (12.11.04 0:26) [38]
Да с Release локальная переменная никогда не станет инвалидной

И при Application.Processmessages ?

jack128 © (12.11.04 0:26) [38]
Вообще - имеет ли объект право уничтожать себя сам?
Некоторые объекты имеют => в общем случае IMHO да.

← →
Игорь Шевченко © (2004-11-12 00:36) [42]

GuAV © (12.11.04 00:26) [39]

А ведь точно, спутал с наследниками. Которые устанавливают у себя FreeOnTerminate. Спасибо :)

GuAV © (12.11.04 00:21) [37]

До кучи вспомним еще TFrom.Close с Action равной caFree.

Но у меня все-таки вопрос к автору - в контекте какого потока выполняется его метод Kill ? Если в контексте созданного потока, то код абсолютно неработоспособный. Если в контексте создавающего потока, то код потенциально опасный из-за Free внутри метода.

← →
Verg © (2004-11-12 01:02) [43]

> Но у меня все-таки вопрос к автору - в контекте какого потока
> выполняется его метод Kill

Глаавно, что это противоречие неустранимо.
Т.е Kill должен быть гарантированно вызван не в контексте потока, которым управляет этот объект. Иначе - либо потеря самого объекта (мемлик), либо потеря объекта ядра из-за незакрытия Handle этого потока.

Второе "либо" относится к такому "эндшпилю":

procedure TThreadClass.Kill(ExitCode: Cardinal);
var H : THandle;
begin
H := FHandle;
Free;
// При учете, что CloseHande(FHandle) перенесли из деструктора в ThreadProcedure перед ExitThread;
TerminateThread( H, ExitCode );
// Напрашивающийся тут мат в один ход уже никому не нужен :))
CloseHandle(H); // - Unreachable Code, хотя кто-то должен же закрыть этот хендель
end;

Да, и кому может понадобиться вызов Terminate в оригинальном коде Kill ? :)))

← →
GuAV © (2004-11-12 01:20) [44]

Verg © (12.11.04 1:02) [43]

Целый поток был грубо прибит, что настолько плохо что не думаю что один незакрытый хэндл сделает большую разницу :)

← →
Игорь Шевченко © (2004-11-12 01:24) [45]

GuAV © (12.11.04 01:20) [44]

Считается ли прибитым поток, если у него остался незакрытый Handle ? :)

← →
GuAV © (2004-11-12 01:40) [46]

Игорь Шевченко © (12.11.04 1:24) [45]
Нет, он не убитый, это подранок :)

Короче, таки надо так:
if GetCurrentThreadId = FThreadId the ExitThread(...) else TerminateThread(...) ...

← →
GuAV © (2004-11-12 01:47) [47]

2 Verg ©
Кстати, а как же тогда реализован TThread.FreeOnTerminate

← →
panov © (2004-11-12 02:00) [48]

Хочу все-же пояснить про Kill.

Объект создает поток.
В этом объекте есть метод Kill.
Метод Kill:
1. Убивает поток (TerminateThread), но не объект!
2. Устанавливает флаг завершения для того, чтобы любой наследник(не он сам) мог видеть, что поточная функция завершена(в процессе завершения) и нет смысла в этом смысле передавать/принимать от объекта какие-либо данные.
3. Независимо от значения FreeOnTerminate вызывает деструктор Destroy, который закрывает 2 созданных дескриптора в объекте.

Т.е. метод Kill позволяет корректно уничтожить сам объект и освободить все ресурсы, за исключением созданных в поточной функции.

Метод сделан для простого уничтожения зависшего потока с минимальными потерями ресурсов.

← →
Игорь Шевченко © (2004-11-12 10:18) [49]

panov © (12.11.04 02:00) [48]

[43] читал ?

В контексте какого потока будет выполняться метод Kill ?

← →
Владислав © (2004-11-12 10:21) [50]

Таки на вопрос Игоря не ответили :)

← →
Cobalt © (2004-11-12 10:41) [51]

2 Игорь Шевченко © (12.11.04 10:18) [49]
Т.к. Александр позиционирует этот метод, как
для простого уничтожения зависшего потока
,то не из самого потока :)

← →
Игорь Шевченко © (2004-11-12 10:46) [52]

Cobalt © (12.11.04 10:41) [51]

Тогда все мои возражения остаются в силе. Код абсолютно нерабочий.

← →
Digitman © (2004-11-12 11:05) [53]

> panov © (11.11.04 21:28) [11]
> Этот класс хочу использовать в пуле потоков. Он должен быть
> максимально простым и управляемым

Если уж на то пошло (пул здесь фигурирует), то лучше бы ты сосредоточил мозговые усилия на реализации трэд-класса, "заточенного" к использованию именно какими-то пул-менеджерами.. возьми за ориентир, скажем, все тот же TServerClientThread .. просто разработай свои TCustomThreadPoolMgr, TCustomThreadPool, TCustomPooledThread и сделай грамотную и надежную "связку" между
ними - это, пожалуй, будет гораздо полезней, нежели "курочить" TThread на свой манер

а по поводу простоты и управляемости - не вижу сколь-либо ощутимого повода для нареканий в отношении этого в станд.реализации TThread

imho

← →
panov © (2004-11-12 12:45) [54]

>Игорь Шевченко © (12.11.04 10:46) [52]

Повторю: Kill сделан не для вызова из поточной функции.
Т.е. из любого другого потока, кроме созданного CreateThread в конструкторе.

Тогда все мои возражения остаются в силе. Код абсолютно нерабочий.

Можно пояснить, какой именно момент нерабочий и чем это вызвано?

← →
Игорь Шевченко © (2004-11-12 12:56) [55]

panov © (12.11.04 12:45) [54]

Можно написать комментарии все-таки ?

← →
PVOzerski © (2004-11-12 13:00) [56]

2[54]:
Тогда нужно проверять потоковую принадлежность кода, вызывающего Kill и "в случае чего" генерить исключение. IMHO, конечно. Но проверить-то можно. Exception выглядит убедительнее, чем рекомендации копаться в документации :^) Что-нибудь вроде

procedure TThreadClass.Kill(ExitCode: Cardinal);
begin
if GetCurrentThreadId<>FThreadId then
raise что нибудь;

← →
panov © (2004-11-12 13:06) [57]

>Игорь Шевченко © (12.11.04 12:56) [55]

Сейчас исправлю с учетом замечаний и снова выложу.

← →
REA (2004-11-12 13:09) [58]

>Этот класс хочу использовать в пуле потоков

А используется Thread Pooling? (QueueUserWorkItem, BindIoCompletionCallback там всякие)

← →
panov © (2004-11-12 13:10) [59]

>REA (12.11.04 13:09) [58]

А в W95-WinNT?

← →
panov © (2004-11-12 14:16) [60]

unit uThreadClass; interface uses classes,windows; type TSimpleThreadObj=class private FHandle,FThreadId: THandle; //Handle & ThreadId создаваемого потока FEvent: THandle; //Event для ожидания завершения инициализации FFreeOnTerminate: Boolean; //Флаг автоматического разрушения объекта // после окончания выполнения поточной функции FTerminated: Boolean; //Флаг состояния завершения потока FSuspended: Boolean; //Флаг состояния Thread Suspended FReturnCode: Integer; //Код возврата поточной функции procedure OnStartThread; //Установка состояния "Поток создан" protected procedure Execute;virtual;abstract; public constructor Create(const CreateSuspended: Boolean); destructor Destroy;override; procedure AfterConstruction; override; //Перекрытие AfterConstruction procedure OnEndThread;virtual;abstract; //Событие, возникнет перед окончанием // поточной функции procedure Suspend; //Приостановить поток procedure Resume; //Разбудить поток procedure WaitFor(Timeout: Cardinal=INFINITE); //Ждать завершения поточной // функции procedure Terminate; //Установить флаг состояния завершения потока procedure Kill(ExitCode: Cardinal); //Завершить выполнение поточной функции property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate; property Terminated: Boolean read FTerminated; property Handle: THandle read FHandle; property ThreadId: THandle read FThreadId; property ReturnCode: Integer read FReturnCode write FReturnCode; end; implementation //function ThreadProcedure(const Sender: TObject): Cardinal; stdcall; // // Поточная функция // Параметр Sender - ссылка на объект класса TSimpleThreadObj, // в котором создан поток // function ThreadProcedure(const Sender: TObject): Cardinal; stdcall; begin Result := 0; //Устанавливаем код возврата в 0 try TSimpleThreadObj(Sender).OnStartThread; //Поточная функция начала работать, TSimpleThreadObj(Sender).Execute; //Собственно выполнение пользовательского кода TSimpleThreadObj(Sender).OnEndThread; //Поточная функция законлила выполнение кода except Result := INVALID_HANDLE_VALUE; end; // Если установлен флаг автоматического уничтожения объекта - вызыыаем Free if TSimpleThreadObj(Sender).FreeOnTerminate then TSimpleThreadObj(Sender).Free; end; { TSimpleThreadObj } //procedure TSimpleThreadObj.AfterConstruction; // // метод вызывается сразу после завершения конструктора // назначение: при необходимости дождаться, пока начнет работу поточная функция. // procedure TSimpleThreadObj.AfterConstruction; begin inherited; //если поток создается не в приостановленном состоянии, ждем, // пока будет установлен FEvent if not FSuspended then begin Resume; WaitForSingleObject(FEvent,INFINITE); end; end; //constructor TSimpleThreadObj.Create(const CreateSuspended: Boolean); // // Конструктор // Параметры; // CreateSuspended: Boolean - True - поток создается в приостановленном состоянии // constructor TSimpleThreadObj.Create(const CreateSuspended: Boolean); begin inherited Create; FreeOnTerminate := True; //по умолчанию объект // уничтожается автоматически FSuspended := CreateSuspended; FEvent := CreateEvent(nil,True,False,nil); FHandle := CreateThread(nil,0,@ThreadProcedure,Self,CREATE_SUSPENDED,FThreadId); end; //destructor TSimpleThreadObj.Destroy; // // Деструктор // destructor TSimpleThreadObj.Destroy; begin CloseHandle(FHandle); CloseHandle(FEvent); inherited; end; //procedure TSimpleThreadObj.OnStartThread; // // метод вызывается после старта поточной функции // procedure TSimpleThreadObj.OnStartThread; begin // Устанавливаем Event в Sinaled - поточная функция начала выполняться if not FSuspended then SetEvent(FEvent); end; //procedure TSimpleThreadObj.Kill(ExitCode: Cardinal); // // метод вызывается для "жесткого" уничтожения потока // TerminateThread(например, для уничтожения "зависшего" потока) // procedure TSimpleThreadObj.Kill(ExitCode: Cardinal); begin if GetCurrentThreadId=FThreadId then Exit; Terminate; //Устанавливаем состояние завершения TerminateThread(FHandle,ExitCode); //Уничтожаем поток if FreeOnTerminate then Free; end; //procedure TSimpleThreadObj.Resume; // // "Пробуждение" потока // procedure TSimpleThreadObj.Resume; begin ResumeThread(FHandle); FSuspended := False; end; //procedure TSimpleThreadObj.Suspend; // // "Усыпление" потока // procedure TSimpleThreadObj.Suspend; begin SuspendThread(FHandle); FSuspended := True; end; //procedure TSimpleThreadObj.Terminate; // // устанавливаем флаг состояния завершения // procedure TSimpleThreadObj.Terminate; begin FTerminated := True; end; //procedure TSimpleThreadObj.WaitFor(Timeout: Cardinal=INFINITE); // // Ожидание завершения потока // procedure TSimpleThreadObj.WaitFor(Timeout: Cardinal=INFINITE); begin WaitForSingleObject(FHandle,TimeOut); end; end.

← →
panov © (2004-11-12 14:17) [61]

>Digitman © (12.11.04 11:05) [53]

На основе этого класса я и хочу написать менеджер пула потоков, и реализовать сам пул.

← →
Игорь Шевченко © (2004-11-12 14:23) [62]

> procedure OnEndThread;virtual;abstract; //Событие, возникнет
> перед окончанием
> // поточной функции

Его надо ОБЯЗАТЕЛЬНО реализовать в потомках ?

← →
GuAV © (2004-11-12 14:30) [63]

panov © (12.11.04 14:16) [60]
procedure OnEndThread;virtual;abstract; //Событие, возникнет перед окончанием
// поточной функции
По имени и по коментарию событие, а по коду virtual;abstract; - абстрактный метод. Не хорошо. Вносит путаницу.

← →
panov © (2004-11-12 14:50) [64]

>Игорь Шевченко © (12.11.04 14:23) [62]
Нет, не обязательно-)
заменил на
procedure OnEndThread;virtual;

← →
Игорь Шевченко © (2004-11-12 14:52) [65]

panov © (12.11.04 14:50) [64]

Пост [63]. Лично у меня объявление чего-либо, начинающегося с On виртуальным вызывает подозрительность.

Call me paranoid but finding "/*" inside this comment makes me suspicious
(с)

← →
panov © (2004-11-12 14:55) [66]

>Игорь Шевченко © (12.11.04 14:52) [65]
Пост [63]. Лично у меня объявление чего-либо, начинающегося с On виртуальным вызывает подозрительность.

Почему?-)
Так как тогда лучше назвать?-)

← →
Игорь Шевченко © (2004-11-12 15:01) [67]

> Так как тогда лучше назвать?-)

Без On (кстати, к OnStartThread это тоже относится)

← →
panov © (2004-11-12 15:11) [68]

>Игорь Шевченко © (12.11.04 15:01) [67]

Переобозвал.

procedure StartThread;
procedure EndThread;

panov © (12.11.04 13:06) [57]
Сейчас исправлю с учетом замечаний и снова выложу.
panov © (11.11.04 23:24) [27]
IsMultiThread упустил из вида

>GuAV © (12.11.04 21:13) [69]
IsMultiThread упустил из вида

Да, я уже заметил, спасибо.

Теперь уже реализую класс-менджер потоков и собственно класс потока, который должен выполняться в пуле.

Наконец-то плюнул на собственную реализацию поточного класса(хотя и зря, может быть), реализовал первую рабочую версию пула потоков.
Конечно, не претендую на совершенство и маскимально оптимизированное решение, но эта версия хотя бы работает-)
(Версия нумбер 3).

Реализовано 4 класса:
TThreadPool - менеджер потоков.
TThreadsThr - собственно поток из пула.
TPushPop - потокобезопасная работа с очередью заданий на выполнение(двусвязный список).
TSafeArray - потокобезопасная работа с массивом указателей(динамический массив потоков).

Версия рабочая, но некоторые примочки еще можно добавлять.

Если кого-то интересует, то исходники могу выложить.
Вот только не знаю, сюда или нет. Код в 3-х модулях, 500 строк.

Основной модуль.
unit uThreadPool; interface uses Classes, Windows, SysUtils, SyncObjs, uSafeArray, uPushPop; type TProcThr=procedure(parm: Pointer); //клиентская процедура для выполнения в пуле потоков // Служебная структура для передачи параметров PJob=^TJob; TJob=record Proc: TProcThr; //клиентская процедура Parm: Pointer; //параметры процедуры end; TThreadsPool=class; // TThreadsThr=class(TThread) // Поток для выполнения в пуле TThreadsThr=class(TThread) private FThreadsPool: TThreadsPool; //Ссылка на менеджер потоков FEvent: TSimpleEvent; //Event для ожидания окончания инициализации FEventExec: TSimpleEvent; //Event для управления циклом в Execute FProc: TProcThr; //Клиентская процедура FParm: Pointer; //Параметры клиентской процедуры FIsFree: Boolean; //Флаг "свободности" потока constructor Create; //Конструктор(не вызывается напрямую) protected procedure Execute; override; public destructor Destroy;override; class function CreateThr(Pool: TThreadsPool):TThreadsThr; //Функция для создания потока procedure SetJob(Proc: TProcThr;Parm: Pointer); //Установка параметров потока property isFree: Boolean read FIsFree write FIsFree; //Флаг "свободности" потока end; // TThreadsThr=class(TThread) // Пул потоков TThreadsPool=class(TThread) private FJobs: TPushPop; //Очередь заданий на выполнение в пуле FPool: TSafeArray; //Пул потоков FMaxThreads: Integer; //Макс. количество потоков в пуле FEvent: TSimpleEvent; //Event для ожидания окончания инициализации пула FEventAddJob: TSimpleEvent; //Event для Управления циклом в Execute constructor Create(const MaxThreads: Integer); //Конструктор(не вызывается напрямую) function GetFreeThr: Integer; //Поиск свободного потока в пуле procedure EndJob(Sender: TThreadsThr); //обработка завершения выполнения задания procedure EndThread(Sender: TThreadsThr); //Обработка завершения потока в пуле function GetCountJobs: Integer; //Количество заданий в очереди function GetCountThreads: Integer; //Количество потоков в пуле function GetCountFreeThr: Integer; //Количество свобожных потоков в пуле protected procedure Execute; override; public destructor Destroy;override; class function CreatePool(const MaxThreads: Integer):TThreadsPool; //Функция для создания пула procedure AddJob(Proc: TProcThr;Parm: Pointer); //Добавление задания в очередь property CountJobs: Integer read GetCountJobs; //Количество заданий в очереди property CountThreads: Integer read GetCountThreads; //Количество потоков в пуле property CountFreeThr: Integer read GetCountFreeThr; //Количество свобожных потоков в пуле end; implementation { TThreadsPool } constructor TThreadsPool.Create(const MaxThreads: Integer); begin inherited Create(True); FreeOnTerminate := True; FMaxThreads := MaxThreads; FEvent := TSimpleEvent.Create; FEventAddJob := TSimpleEvent.Create; FEvent.ResetEvent; FJobs := TPushPop.Create; //Очередь заданий FPool := TSafeArray.Create; //Массив(пул) потоков end; class function TThreadsPool.CreatePool(const MaxThreads: Integer):TThreadsPool; begin Result := TThreadsPool.Create(MaxThreads); Result.Resume; case Result.FEvent.WaitFor(INFINITE) of //ждем окончания инициализации wrSignaled: Exit; wrTimeOut, wrAbandoned, wrError: begin Result.Terminate; Result := nil; Exit; end; end; end; destructor TThreadsPool.Destroy; var i: Integer; begin if Assigned(FEvent) then FEvent.Free; if Assigned(FEventAddJob) then FEventAddJob.Free; //Очистка очереди заданий while FJobs.Count<>0 do Dispose(PJob(FJobs.Pop)); FJobs.Free; //Освобождение потоков в пуле for i := 0 to FPool.Count-1 do TThreadsThr(FPool[i]).Terminate; FPool.Free; inherited; end; procedure TThreadsPool.Execute; var RC: TWaitResult; Thr: TThreadsThr; NumThr: Integer; Job: PJob; begin //Странное какое-то состояние. - Terminate if FMaxThreads=0 then begin Terminate; Exit; end; FEvent.SetEvent; //Инициализация закончена, сообщаем. while not Terminated do begin //Ждем наступления события "Есть задание в очереди" RC := FEventAddJob.WaitFor(100); if Terminated then break; case RC of wrSignaled : //Появилось задание begin FEventAddJob.ResetEvent; //Сбрасываем Event NumThr := GetFreeThr; //Получить номер свободного потока //Проверяем наличие заданий в очереди, пока есть свободные потоки // и задания while (FJobs.Count<>0) and (NumThr<>-1) do begin if NumThr=-1 then Continue; //Нет свободных потоков Thr := FPool.Items[NumThr]; Thr.isFree := False; //Флаг "Поток занят" Job := FJobs.Pop; //Извелекаем задание из очереди Thr.SetJob(Job^.Proc,Job.Parm); //Устанавливаем параметры для выполнения Dispose(Job); //Освободить память Thr.FEventExec.SetEvent; //Известить поток о готовности к выполнению NumThr := GetFreeThr; //Получить номер свободного потока end; Continue; end; wrTimeout: begin FEventAddJob.SetEvent; //Проверить очередь заданий end; else begin Terminate; //Ошибка(??) завершаем работу end; end; end; end; procedure TThreadsPool.AddJob(Proc: TProcThr; Parm: Pointer); var Job: PJob; begin New(Job); Job^.Proc := @Proc; Job^.Parm := Parm; FJobs.Push(Job); //Поместить задание в очередь FEventAddJob.SetEvent; //Обработать очередь заданий(в Execute) end; function TThreadsPool.GetFreeThr: Integer; var i: Integer; begin Result := -1; for i := 0 to FPool.Count-1 do begin //Проверка флага "Поток свободен" if TThreadsThr(FPool[i]).isFree then begin Result := i; break; end; end; if Result=-1 then //Нет свободных потоков begin if FPool.Count<FMaxThreads then //Количество потоков меньше максимального значения? begin Result := FPool.Add(TThreadsThr.CreateThr(Self)); //Создаем новый поток в пуле end; end; end; procedure TThreadsPool.EndJob(Sender: TThreadsThr); begin Sender.IsFree := True; //Устанавливаем флаг "Поток свободен" FEventAddJob.SetEvent; //Обработать очередь заданий(в Execute) end; procedure TThreadsPool.EndThread(Sender: TThreadsThr); begin FPool.Delete(FPool.IndexOf(Sender)); //Удалить поток из пула end;

function TThreadsPool.GetCountJobs: Integer; begin Result := FJobs.Count; //Количество заданий в очереди end; function TThreadsPool.GetCountThreads: Integer; begin Result := FPool.Count; //Количество потоков в пуле end; function TThreadsPool.GetCountFreeThr: Integer; var i: Integer; begin //Количество свободных потоков в пуле Result := 0; for i := 0 to FPool.Count-1 do begin if TThreadsThr(FPool[i]).IsFree then Inc(Result); end; end; { TThreadsThr } constructor TThreadsThr.Create; begin inherited Create(True); FreeOnTerminate := True; FEvent := TSimpleEvent.Create; FEventExec := TSimpleEvent.Create; IsFree := False; FEvent.ResetEvent; end; class function TThreadsThr.CreateThr(Pool: TThreadsPool): TThreadsThr; begin Result := TThreadsThr.Create; Result.FThreadsPool := Pool; Result.Resume; case Result.FEvent.WaitFor(INFINITE) of wrSignaled: Exit; wrTimeOut, wrAbandoned, wrError: begin Result.Terminate; Result := nil; Exit; end; end; end; destructor TThreadsThr.Destroy; begin if Assigned(FEvent) then FEvent.Free; if Assigned(FEventExec) then FEventExec.Free; inherited; end; procedure TThreadsThr.SetJob(Proc: TProcThr;Parm: Pointer); begin FProc := Proc; FParm := Parm; end; procedure TThreadsThr.Execute; var RC: TWaitResult; begin FEvent.SetEvent; isFree := True; while not Terminated do begin RC := FEventExec.WaitFor(100); FEventExec.ResetEvent; case RC of wrSignaled: begin try isFree := False; FProc(FParm); //Выполняем клиентскую процедуру except end; FThreadsPool.EndJob(Self); //Извещаем менеджер потоков об окончании end; wrTimeout: begin end; else begin FThreadsPool.EndThread(Self); //Извещаем менеджер потоков о завершении потока Terminate; end; end; end; end; end.

{ Защищенный связный список для работы с очередью в многопоточном режиме(первый вошел-первый вышел) } unit uPushPop; interface uses windows; type PItemList=^TItemList; TItemList=record Prev,Next: PItemList; Data: Pointer; end; TPushPop=class private FCS: RTL_CRITICAL_SECTION; FRootItem: PItemList; FLastItem: PItemList; FItemsCount: Integer; procedure Lock; procedure Unlock; procedure DeleteItem0; function GetCount: Integer; public constructor Create; destructor Destroy;override; procedure Push(const aObject: Pointer); function Pop: Pointer; function Peek: Pointer; property Count: Integer read GetCount; end; implementation { TPushPop } constructor TPushPop.Create; begin New(FRootItem); New(FLastItem); FRootItem.Prev := nil; FRootItem.Next := FLastItem; FRootItem.Data := nil; FLastItem.Prev := FRootItem; FLastItem.Data := nil; FLastItem.Next := nil; FItemsCount := 0; InitializeCriticalSection(FCS); end; destructor TPushPop.Destroy; begin Lock; while FRootItem.Next<>FLastItem do DeleteItem0; Dispose(FRootItem); Dispose(FLastItem); Unlock; end; procedure TPushPop.Lock; begin EnterCriticalSection(FCS); end; procedure TPushPop.Unlock; begin LeaveCriticalSection(FCS); end; procedure TPushPop.DeleteItem0; var p: PItemList; begin if FItemsCount=0 then Exit; p := FRootItem.Next; p.Prev.Next := p.Next; p.Next.Prev := p.Prev; Dispose(p); Dec(FItemsCount); end; function TPushPop.Peek: Pointer; begin Lock; try Result := FRootItem.Next.Data; finally Unlock; end; end; function TPushPop.Pop: Pointer; begin Lock; try Result := FRootItem.Next.Data; DeleteItem0; finally Unlock; end; end; procedure TPushPop.Push(const aObject: Pointer); var p: PItemList; begin Lock; try New(p); p.Data := aObject; p.Prev := FLastItem.Prev; p.Next := FLastItem; FLastItem.Prev.Next := p; FLastItem.Prev := p; Inc(FItemsCount); finally Unlock; end; end; function TPushPop.GetCount: Integer; begin Lock; try Result := FItemsCount; finally Unlock; end; end; end.

{ TSafeArray=class Класс для работы с дин. массивом в многопоточном приложении } unit uSafeArray; interface uses windows; type TSafeArray=class private FCS: RTL_CRITICAL_SECTION; //Крит. секция для защиты массива FArray: array of Pointer; procedure Lock; //Вход в крит. секцию procedure Unlock; //Выход из крит. секции function GetItem(const Index: Integer): Pointer; procedure SetItem(const Index: Integer; const Value: Pointer); public constructor Create; destructor Destroy; override; function Add(const Item: Pointer): Integer; function IndexOf(const Item: Pointer): Integer; function Count: Integer; procedure Delete(const Index: Integer); procedure Clear; property Items[const Index: Integer]: Pointer read GetItem write SetItem;default; end; implementation { TSafeArray } function TSafeArray.Add(const Item: Pointer): Integer; begin Lock; Result := Length(FArray); SetLength(FArray,Result+1); FArray[Result] := Item; Unlock; end; procedure TSafeArray.Clear; begin Lock; SetLength(FArray,0); Unlock; end; function TSafeArray.Count: Integer; begin Result := Length(FArray); end; constructor TSafeArray.Create; begin InitializeCriticalSection(FCS); end; procedure TSafeArray.Delete(const Index: Integer); var i: Integer; Len: Integer; begin Len := Length(FArray); if Index<0 then Exit; if Index>Len-1 then Exit; Lock; for i := Index+1 to Len-1 do begin FArray[i-1] := FArray[i]; end; SetLength(FArray,Len-1); Unlock; end; destructor TSafeArray.Destroy; begin DeleteCriticalSection(FCS); SetLength(FArray,0); inherited; end; function TSafeArray.GetItem(const Index: Integer): Pointer; begin Lock; Result := FArray[Index]; Unlock; end; function TSafeArray.IndexOf(const Item: Pointer): Integer; var i: Integer; begin Result := -1; Lock; for i := 0 to Length(FArray)-1 do begin if Item=FArray[i] then begin Result := i; break; end; end; Unlock; end; procedure TSafeArray.Lock; begin EnterCriticalSection(FCS); end; procedure TSafeArray.SetItem(const Index: Integer; const Value: Pointer); begin if (Index<0) or (Index>Length(FArray)-1) then Exit; Lock; FArray[Index] := Value; Unlock; end; procedure TSafeArray.Unlock; begin LeaveCriticalSection(FCS); end; end.

Пример использования:
type PRec=^Rec; Rec=record n: Integer; Number: Integer; end; var Pool: TThreadsPool; procedure Exec(parm: Pointer); var R: PRec; begin R := parm; Sleep(R.n); //здесь нужна синхронизация fMain.lb.Items.Add(IntToStr(R.Number)+":"+IntToStr(R.n)); Dispose(R); end; //Создание пула procedure TfMain.Button1Click(Sender: TObject); begin Pool := TThreadsPool.CreatePool(100); end; //Создание заданий на выполнение procedure TfMain.Button2Click(Sender: TObject); var r: PRec; i: Integer; begin Randomize; for i := 0 to 1000 do begin New(r); r.Number := i; r.n := Random(1000)*10+100; Pool.AddJob(@Exec,r); end; end;

> panov

а стоило ли городить огород с собственной реализацией thread-safe-очереди (TPushPop) ?

есть же TThreadList, можно же было или унаследоваться от него или включить его как член класса TPushPop, дабы максимально использовать уже готовую реализованную в TThreadList функциональность .. там тебе и крит.секция готовая и список с произвольным доступом .. хошь используй его как очередь, хошь как стек ...

опять же и TSafeArray это касаемо ...
не вижу резона вводить thread-safe-дин.массив вместо стандартного TThreadList .. к тому же бесконечные реаллокации памяти при операциях с дин.массивом ощутимо повлияют на общую производительность алгоритма..

и вот еще что бросается в глаза - ты делаешь Lock, а нижеследующий Unlock у тебя небезусловен, что рано или поздно приведет к коллизиям из-за потенциально возможных исключениях между Lock и Unlock

> и вот еще что бросается в глаза - ты делаешь Lock, а
> нижеследующий Unlock у тебя небезусловен, что рано или
> поздно приведет к коллизиям из-за потенциально
> возможных исключениях между Lock и Unlock

Я не заметил, где такое. Если есть, то это ошибка.

Вроде бы как везде такой формат:

Lock; try finally Unlock; end;

есть же TThreadList, можно же было или унаследоваться от него или включить его как член класса TPushPop

Ну не нравится мне этот класс, к сожалению.
Не лежит душа к использованию его.

ну здрасть-приехали !

а это что

function TSafeArray.GetItem(const Index: Integer): Pointer;
begin
Lock;
Result := FArray[Index];
Unlock;
end;

?

Нужна критика кода-) Найти похожие ветки