freepascal.ru • Просмотр темы - Использование WinApi для создания пула потоков
 

Использование WinApi для создания пула потоков

Форум для изучающих FPC и их учителей.

Модератор: Модераторы

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 03.04.2018 06:44:10

runewalsh писал(а):>64 хэндла. А если больше надо будет
Больше не нужно. Тебе не нужно вообще. Завершившиеся потоки не могут внезапно воскреснуть, так что WaitForMultipleObjects(bAll=TRUE) лишняя

С WaitForMultipleObjects я сражаюсь (нехотя) в рамках задания №1. Хотя тоже считаю, что она
runewalsh писал(а):лишняя и полностью эквивалентна for i := ... do WaitForSingleObject(Threads[i], ...).

Но преподавателя, в переписке циклит на WaitForMultipleObjects. Видимо ему понравился его пример с выделением памяти. И можно увидеть рецензию
"Ну надо было бы все таки использовать WaitForMultipleObjects.." С пометкой незачтено. И что такое это "было бы" - руководство к действию? И почему вообще незачет - пойди разберись. Такой вот он... Я дистанционник. И его рецензий можно ждать по месяцу. А семестр как у всех - полгода. А насчет надо ли больше HANDLE чем 64, то по условиям задания юзер вводит кол-во потоков в начале программы. Само условие задания достаточно громоздкое, я и так большой ломоть попросил Вас прочитать.
runewalsh писал(а):SleepEx сама вызывает один из коллбэков, которые поток попросили выполнить через QueueUserAPC, или, если их нет, ждёт следующий N мс (здесь — бесконечно).

То ли ты неправильно сформулировал, то ли я не проникся. Если следовать таким рассуждениям получается подобие такой хрени
Код: Выделить всё
for i:=0 to n-1 do //это кусок из предыдущего кода, переделанный под вдохновением объяснения
   Threads[i] := CreateThread(nil, 0, @PrintInteger, nil, 0, ThreadIDs[i].ID);//ф-ции с бесконечным SleepEx больше нет и вызывается сразу "рабочая" ф-ция.
   Sem := CreateSemaphore(nil, 1, 1, nil);//ну понятно, что сразу ломится выполнять, как то можно и приостановить
   repeat
      for i:=0 to n-1 do
      QueueUserAPC(@PrintInteger,Threads[i],ThreadIDs[i].ID);
      count:=n-1;
      repeat
         writeln('Вызов ',count);
         SleepEx(INFINITE, TRUE); //И тут попытки вызвать поток из массива, потому что SleepEx [b]сама[/b] вызывает
         dec (count);
      until count=-1;
   until Zadacha=Zadanie;

while true — это for(;;).

Я в первый раз вижу for(;;), даже гугл не знает. Вот while true знает. Но для меня это как то дико, все равно что while NIL. Что true (истина) то? Параметр, переданный в ф-цию если только. В общем первый раз увидел - удивился, больше не буду :wink:

Дописал я пример. Прошу только отследить ход моих рассуждений, и если где то грубая ошибка - откомментить с поправкой
1. Дикое зацикливание SleepEx не нужно совсем. Поток направленный в SleepEx может только
- An I/O completion callback function is called.
- An asynchronous procedure call (APC) is queued to the thread.
- The time-out interval elapses.
Нам интересен 2-й вариант.
2. После вызова свободного (спящего) потока из SleepEx ф-цией QueueUserAPC поток выполняет ф-цию указанную в параметрах QueueUserAPC, при этом для
выполнения этой нужной нам ф-ции, можно передать ей параметры, указанные опять же в параметрах QueueUserAPC.
3. После завершения работы потока в ф-ции на которую его натравили, поток опять засыпает и становится доступным для вызова QueueUserAPC.
4. Если в SleepEx все потоки заняты, то при обращении к этой ф-ции с помощью QueueUserAPC ничего не происходит.==> :idea: :?: Или все таки
ожидается любой первый освободившийся поток?

5. Завершение работы прихлапыванием потоков, равно как и костыли вроде
Поток с ней завершается только потому, что по выходу из тела программы FPC вызывает ExitProcess, которая неявно обрывает все потоки в духе TerminateThread.

кажутся мне дурным тоном. По хорошему надо по завершения задания (Zadanie в моем примере) натравить все эти потоки на CloseThread. С 4 моим пунктом
только определиться
6. Sleep(1) в коде нужна, видимо, для того чтобы поток, вызванный QueueUserAPC успел что то сделать, раз уж мы отталкиваемся от количества
выполненных заданий... Тоже костыль по сути. Надо подумать.

Код: Выделить всё
USES windows;
TYPE
DBThreads=         record
ID               :LongWord;
Time            :LongWord;
bAlertable         :bool;
end;
var
i,n,count         :word;
Threads            :TWOHandleArray;
ThreadIDs         :array of DBThreads;
Sem               :HANDLE;
Step,Zadanie      :LongWord;

function QueueUserAPC(pfnAPC:Pointer;hThread:HANDLE;dwData:ULONG_PTR):DWORD;
stdcall; external 'Kernel32.dll';

FUNCTION PrintInteger(Param: integer):ptrint; stdcall;
begin
   WaitForSingleObject(Sem, INFINITE);
   inc (Step);
   Writeln('Задача: ',Step,' выполнена потоком c ID ',Param);      
   ReleaseSemaphore(Sem, 1, nil);
   sleep (1000);
   writeln(GetCurrentThreadId,' проснулся');
   PrintInteger:=0;
end;

begin
   write('Сколько потоков будет в пуле? ');
   readln(n);
   write('Сколько задач нужно выполнить? ');
   readln(Zadanie);
   SetLength(ThreadIDs,n);   
   for i:=0 to n-1 do
   begin
      ThreadIDs[i].Time:=INFINITE;
      ThreadIDs[i].bAlertable:=true;
      Threads[i] := CreateThread(nil, 0, @SleepEx, @ThreadIDs[i], 0, ThreadIDs[i].ID);
   end;
   Sem := CreateSemaphore(nil, 1, 1, nil);
   repeat
      if Zadanie-Step>=n then count:=0 else count:=n-(Zadanie-Step);
         for i:=count to n-1 do
      begin
         QueueUserAPC(@PrintInteger,Threads[i],ThreadIDs[i].ID);
         sleep(1);
      end;
   until Step=Zadanie;
      for i:=0 to n-1 do TerminateThread(Threads[i],0);
   writeln ('Задание ',Zadanie,' достигнуто за ',Step,' шагов');   
   writeln ('Все потоки уничтожены');
   readln
end.
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение runewalsh » 03.04.2018 08:15:36

>CreateThread(nil, 0, @SleepEx, @ThreadIDs[i], 0, ThreadIDs[i].ID);
Какой кошмар.
Третьим параметром CreateThread должна быть stdcall-функция с параметром типа pointer и возвращающая dword. Этот код компилируется только потому, что в модуле Windows там по недосмотру вместо типизированного указателя на функцию простой pointer (я уже предлагал использовать BeginThread? FPC настолько поощряет тебя использовать кроссплатформенные обёртки, что она даже объявлена правильно).
QueueUserAPC ожидает процедуру (не функцию) с параметром типа pointer.
Твоя SleepEx вообще не вызывается, в чём ты можешь убедиться, подставив вместо неё что угодно, хоть ExitWindowsEx.

В следующий раз делай так:
Код: Выделить всё
type
    APCFunc = procedure(param: pointer); stdcall;
function QueueUserAPC(pfnAPC: APCFunc; hThread: HANDLE; dwData: ULONG_PTR): DWORD; stdcall; external 'Kernel32.dll';

Блин, тебе же уже приводили (относительно) правильный код со SleepEx, зачем с ума-то сходить? Я в жизни такой жути не видел.
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 405
Зарегистрирован: 27.04.2010 00:15:25

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 03.04.2018 09:21:37

runewalsh писал(а):Какой кошмар.

runewalsh писал(а):Я в жизни такой жути не видел.

:( :) :D :D :D
Зато быстро ответил. Это не жуть, а попытка оптимизации ;) Объяснили ДОХОДЧИВО почему кривая - знаний в башке прибавилось.
Работала, наверно, еще и потому, что то что я пытался ей послать - дефолтное состояние SleepEx.
Только я так ни фига и не понял, зачем этот нонстоп цикл при вызове SleepEx. Оставляем только одну строчку
Код: Выделить всё
function Sleepka(lpParameter: Pointer): Cardinal; stdcall;
begin
//   while True do
      SleepEx(INFINITE, True);
//    Exit(0);
end;

и работает также.
Про
stesl писал(а):4. Если в SleepEx все потоки заняты, то при обращении к этой ф-ции с помощью QueueUserAPC ничего не происходит.==> :idea: :?: Или все таки
ожидается любой первый освободившийся поток?

Вроде еще выше сказанное
SleepEx сама вызывает один из коллбэков, которые поток попросили выполнить через QueueUserAPC, или, если их нет, ждёт следующий N мс (здесь — бесконечно).

и звучит так, что ф-ция из QueueUserAPC, зайдя в SleepEx будет ждать первого освободившегося потока. Как бы этот момент контролировать? Не подскажешь? Я же без конца шлю туда запросы... Надо бы как то поскромнее
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение runewalsh » 03.04.2018 09:27:05

Я бы объяснил ещё раз, что вообще делают QueueUserAPC и SleepEx, но физически не могу сделать шрифт ещё краснее :)
Сделай между вызовами QueueUserAPC паузу не 1 мс, а побольше, чем в таске (секунды 2) и увидишь, что без цикла не работает.

>Работала, наверно, еще и потому
Нет, потому, что поток стартует не мгновенно, а когда всё же стартовал, перед входом в тело функции выполняет все APC, которые успели кем-то запоститься (ну вот фича у Windows такая). Твои QueueUserAPC выполнялись мгновенно и именно успевали запоститься все, поэтому я предложил увеличить паузу.

>и звучит так, что ф-ция из QueueUserAPC, зайдя в SleepEx будет ждать первого освободившегося потока
Что означает второй параметр QueueUserAPC?
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 405
Зарегистрирован: 27.04.2010 00:15:25

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 03.04.2018 10:46:31

runewalsh писал(а):но физически не могу сделать шрифт ещё краснее :)

Попробуй простым, но не в двух словах и с узбеками и постами,а без сленга и на пальцах. Это если конечно время и желание найдется ;)
Код: Выделить всё
type
    APCFunc = procedure(param: pointer); stdcall;
function QueueUserAPC(pfnAPC: APCFunc; hThread: HANDLE; dwData: ULONG_PTR): DWORD; stdcall; external 'Kernel32.dll';

Я настолько деревянный, что теперь не понимаю, как вызвать
Код: Выделить всё
QueueUserAPC(@PrintInteger,Threads[i],ThreadIDs[i].ID);

естественно не проходит
А мне нужно как раз ф-цию вызвать. Параметр у которой один - указатель. В общем ту же, что и уже написана для 1-2 задания
Код: Выделить всё
FUNCTION Find (p:pointer):ptrint;                  //Ф-ция, используемая потоками
var a      :integer;
Man,Man2   :Stud;
UD         :FuncFindDB;
begin
   UD:=link(p)^;
   Man:=Struct[UD.first];
   a:=UD.first;
      repeat                                 //цикл от first до last
         Man2:=Struct[a];
            if Man2.gr>Man.gr then               //если перешли на другую группу
         begin                              //берем для сравнения первого ее члена
            Man:=Struct[a]; continue;
         end;
         Compare (Man,Man2);
            if List[Man.gr].gr<>0 then            //возможно какой то поток уже сделал запись
         begin                              //по исследуемой группе
            Man2:=List[Man.gr]; Compare (Man,Man2); //значит сравниваем то что есть, с тем
         end;                              //что нашел другой поток
         WaitForSingleObject(Sem, INFINITE);
         List[Man.gr]:=Man;                     //делаем запись, ограждая критической секцией      
         ReleaseSemaphore(Sem, 1, nil);
         inc (a);
         sleep (PT);                           //задержка, предложенная в задании
      until (a>UD.last);
   Find:=0;
end;

runewalsh писал(а):Что означает второй параметр QueueUserAPC?

hThread [in]
Ручка для потока. Ручка должна иметь право доступа THREAD_SET_CONTEXT . Дополнительные сведения см. В разделе Безопасность и права доступа к объектам синхронизации . :cry: :cry: :cry:
Хотя бы как HANDLE правильно переводится? Дескриптор? На языке деревянных - описатель?
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение vitaly_l » 03.04.2018 11:01:33

runewalsh писал(а):Раз была просигналена thereAreTasks, задания были.

RTLEventWaitFor(thereAreTasks); // <== Вот эта хрень, своим Wait не вешает ли В ИСКЛЮЧИТЕЛЬНЫХ СЛУЧАЯХ последний поток навечно или она делает exit вместо Wait?
Что значит её Wait? В коде thread.inc, там currenttm.rtleventWaitFor(state); А если копать дальше, то упирается вот в такую хрень TRTLEventHandler = procedure(AEvent:PRTLEvent); и тут я уже не могу понять как устроено Wait в RTLEventWaitFor? Тоесть там как раз вот эта thereAreTasks ? Соответственно, В ИСКЛЮЧИТЕЛЬНЫХ СЛУЧАЯХ, она(thereAreTasks) вешает последний поток навечно, т.к. thereAreTasks был при последнем ответе в CriticalSection, но потом задачу перехватил другой воркер, но в этом потоке пока ещё был thereAreTasks.

В итоге можно обойтись и без RTLEventWaitFor:
runewalsh писал(а):Если не перепроверить, со временем вылетит range check (без $rangechecks — AV) на tasks[0]:

Художники (закрыв глаза на thread.inc методы) реализовали бы как-то так. И кстати AV на tasks[0] не будет:
Код: Выделить всё
......
iTasks := 100000 * GetCPUCount; 
......
    function Worker(param: pointer): PtrInt; // поток, выполняющий задания из очереди
    var
       task: TTask;
    begin
       while iTasks>=0 do begin
          EnterCriticalSection(tasksLock);
            dec(iTasks);
            if iTasks < 0 then break;
            task := tasks[iTasks];
          LeaveCriticalSection(tasksLock);
          task.proc(task.param); // само задание
       end;
    end; 
//RTLEventWaitFor(thereAreTasks); // ленивые художники решили убрать эту хрень, т.к. она лишняя там где нет while true
//RTLEventSetEvent(thereAreTasks);// ленивые художники решили убрать эту хрень, т.к. она лишняя там где нет while true

{
и вот этот код художники тоже решили убрать т.к. непонятно, зачем всё это там перекладывается из А в Б? Единственная цель перекладок сделать SetLength-1 и поэтому решили удалить, т.к. SetLength можно сделать один раз в конце программы, а не делать его 100000 * GetCPUCount раз.
........
            task := tasks[0];
            for i := 0 to High(tasks) - 1 do
               tasks[i] := tasks[i + 1];
            SetLength(tasks, length(tasks) - 1);
........
}

Выше приведён не тот подход, который задуман в thread.inc, но всё же интересно узнать мнение программистов, что в такой схеме плохого?





Добавлено спустя 1 час 11 минут:
stesl писал(а):Попробуй простым, но не в двух словах и с узбеками и постами,а без сленга и на пальцах.


Вот эта строчка создаёт type APCFunc. runewalsh назвал её колбеком от английского: call+back=callback.
Код: Выделить всё
type
    APCFunc = procedure(param: pointer); stdcall;

Вот в этой строчке указывается созданный выше тип APCFunc в качестве первого обязательного параметра pfnAPC: APCFunc; для QueueUserAPC
Код: Выделить всё
function QueueUserAPC(pfnAPC: APCFunc; hThread: HANDLE; dwData: ULONG_PTR): DWORD; stdcall; external 'Kernel32.dll';

Потом, в программе, ты должен подставлять вместо первого параметра (не функцию), а именно процедуру(procedure) типа APCFunc у которой один параметр param: pointer. И тогда будет верно работать запрос к QueueUserAPC.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 03.04.2018 16:40:41

vitaly_l писал(а):именно процедуру(procedure) типа APCFu

А мне нужна ф-ция. Она написана и работает для 2 заданий. Писать для 3-го задания отдельно процедуру, с идентичным текстом - незачтено.
Переделывать ф-цию в процедуру - но мне она нужна для вызова BeginThread.

Добавлено спустя 10 минут 42 секунды:
И почему то ф-ция у меня работает. Хотя трудно утверждать, что корректно. Внешне все нормально
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение runewalsh » 03.04.2018 17:36:38

Передавать функцию с неверной сигнатурой — Undefined Behavior (а одно из проявлений UB — «всё вроде работает»). Сигнатура состоит из списка параметров, возвращаемого типа (или его отсутствия) и соглашения о вызове (stdcall). Параметр-указатель в коллбэках делают для того, чтобы вызывающий мог передать по нему что угодно:
Код: Выделить всё
type
   PParam = ^TParam;
   TParam = record
      a, b, c, d_result: string;
   end;

function ThreadProc(param: pointer): PtrInt;
begin
   writeln(PParam(param)^.a);
   writeln(PParam(param)^.b);
   writeln(PParam(param)^.c);
   PParam(param)^.d_result := 'D';
end;

var
   param: TParam;
   th: TThreadID;

begin
   param.a := 'A';
   param.b := 'B';
   param.c := 'C';
   th := BeginThread(@ThreadProc, @param);
   WaitForThreadTerminate(th, 0);
   CloseThread(th);

   writeln(param.d_result);
   readln;
end.

Функцию можно завернуть в процедуру, если всё равно не используешь result:
Код: Выделить всё
function TheFunction(param: pointer): PtrInt;
begin
  ...
end;

procedure TheProcedure(param: pointer);
begin
  TheFunction(param);
end;
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 405
Зарегистрирован: 27.04.2010 00:15:25

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 03.04.2018 18:15:03

runewalsh писал(а):Функцию можно завернуть в процедуру, если всё равно не используешь result:

Понял. Спасибо. Накачал каких то книг по API, и прицепом песню о Паскале. Блин, не заметил как до сотой стр долетел. Ибо читается! Хотя казалось бы зачем читаю. Про API читать надо. А неохото :(
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 05.04.2018 09:27:13

Купил в Гугле за 270 ска р "Системное программирование в Windows" Побегайло. Книга безусловно полезная, но как я отстал от нынешних трендов... Теперь оказывается купленную книгу нельзя скачать и смотреть чем угодно и как угодно. А только в епа..м Гугл Книги, спасибо что хоть и офлайн можно. :?: Не в курсе как с этим на ЛитРес?

Много чего поменял в коде. Долго размышляя, решил - с моим багажом знаний все таки верным будет прихлопнуть АСИНХРОННЫЕ потоки, чем колдовать с получением их статуса и последующим Close.

Сэнсэй runewalsh (раз уж мы в разделе "Обучение..." :wink: ) - посмотри, пожалуйста, :?: не достигаю ли я UB при таких манпуляциях?
В частности, формализируя ( :?: таким термином называется описание типа?) процедуру, ожидаемую QueueUserAPC принимаемым параметром ставлю указатель, а не DWORD.
Если достигаю, то как завернуть указатель в DWORD?
Код: Выделить всё
USES windows;
TYPE
DBThreads=   record
ID         :LongWord;
{Здесь могут еще быть какие то параметры!!!}
end;
link=      ^DBThreads;
APCProc = procedure(PParam: pointer);stdcall;
FunForCThread = function(lpParametrs:pointer):LongWord;stdcall;
var
i,n,count,j   :word;
Threads      :TWOHandleArray;
ThreadIDs   :array of DBThreads;
Sem       :HANDLE;
Step,Zadanie:byte;

function CreateThread(lpThreadAttribute:pointer;dwStackSize:LongWord;lpStartAdress:FunForCThread;lpParameter:pointer;
dwCreatioFlags:LongWord;lpThreadId:pointer):HANDLE;stdcall; external 'Kernel32.dll';

function QueueUserAPC(pfnAPC:APCproc;hThread:HANDLE;PData:pointer):DWORD;
stdcall; external 'Kernel32.dll';

function ForAllert(lpParameter: Pointer): LongWord; stdcall;
begin
   while True do SleepEx(INFINITE, True);
   Exit(0);
end;

FUNCTION Job(Param:pointer):PtrInt; stdcall;
var UD:DBThreads;
begin
   WaitForSingleObject(Sem, INFINITE);
   if Step<>Zadanie then inc (Step);
   Writeln('Задача ',Step,' выполнена потоком c ID ',link(Param)^.ID);
   ReleaseSemaphore(Sem, 1, nil);
   sleep (500);
   writeln(GetCurrentThreadId,' проснулся');
   Job:=0;
end;

procedure WrapJob (Param:pointer); stdcall;
begin
   Job(Param);
end;

begin
   write('Сколько потоков будет в пуле? ');
   readln(n);
   write('Сколько задач нужно выполнить? ');
   readln(Zadanie);
   SetLength(ThreadIDs,n);
   for i:=0 to n-1 do
      Threads[i] := CreateThread(nil, 0, @ForAllert, nil, 0, @ThreadIDs[i].ID);
   Sem := CreateSemaphore(nil, 1, 1, nil);
   for j:=1 to Zadanie do
   begin
      if Zadanie-j>=n then count:=0 else count:=n-(Zadanie-j);
         for i:=count to n-1 do
      begin
         QueueUserAPC(@WrapJob,Threads[i],@ThreadIDs[i]);
      end;
   end;
   repeat until Zadanie=Step;
   writeln ('Задание ',Zadanie,' достигнуто за ',Step,' шагов');
      for i:=0 to n-1 do TerminateThread(Threads[i],0);
   writeln ('Все потоки уничтожены');
   readln
end.
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение runewalsh » 05.04.2018 14:24:08

Ожидания ивентов нужны именно затем, чтобы не делать repeat until условие. Такой цикл потенциально будет греть ядро в течение всего кванта времени (20 мс), прежде чем что-то заметит.

Семафором должна быть защищена ВСЯ работа с общими переменными, т. е. та проверка Zadanie и Step в главном потоке — тоже. Не защитил в одном месте = этому незащищённому месту никто не помешает исполниться одновременно с одним из защищённых.

Я не понимаю, зачем тебе этот странный цикл вместо for j := 1 to Zadanie do QueueUserAPC(..., Threads[j mod n], ...). Он же потенциально все 800 заданий запостит вместо 100. Думаю, если бы ты в заданиях что-то интересное делал, например, создавал файлы с уникальными именами в изначально пустой папке, ты бы заметил расхождения между количеством файлов и заданий.
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 405
Зарегистрирован: 27.04.2010 00:15:25

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 05.04.2018 16:15:35

>Я не понимаю, зачем тебе этот странный цикл
Если присмотришься, то это тоже самое что и
for j := 1 to Zadanie do QueueUserAPC(..., Threads[j mod n], ...).
небольшая арифметическая ошибка там (в моем цикле) все же есть. Вот так - рубанул топором вместо одной строчки :wink:
Исправил это недоразумение

Освоил твой пример с ивент, буду курить как это на API реализовать.

Добавлено спустя 6 минут 43 секунды:
А к этому - думаю никаких претензий уже нет. Нафиг я 270р потратил... Если почти все дали в примерах :cry:
Код: Выделить всё
USES windows;
TYPE
DBThreads=   record
ID         :LongWord;
end;
link=      ^DBThreads;
APCProc = procedure(PParam: pointer);stdcall;
FunForCThread = function(lpParametrs:pointer):LongWord;stdcall;
var
Threads      :TWOHandleArray;
ThreadIDs   :array of DBThreads;
JobSem,Event,IncSem,DecSem:HANDLE;
Step      :word;
RunningAPC   :integer;
allTasksCompleted: PRTLEvent;

procedure PrepareEventQueuing;
begin
   WaitForSingleObject(IncSem,INFINITE);
   inc(RunningAPC);
   ReleaseSemaphore(IncSem, 1, nil);
   if RunningAPC=1 then ResetEvent(Event);
end;

procedure NoteEventCompleted;
begin
   WaitForSingleObject(DecSem,INFINITE);
   dec(RunningAPC);
   ReleaseSemaphore(DecSem, 1, nil);
   if RunningAPC=0 then SetEvent(Event);
end;
   
function CreateThread(lpThreadAttribute:pointer;dwStackSize:LongWord;lpStartAdress:FunForCThread;lpParameter:pointer;
dwCreatioFlags:LongWord;lpThreadId:pointer):HANDLE;stdcall; external 'Kernel32.dll';

function QueueUserAPC(pfnAPC:APCproc;hThread:HANDLE;PData:pointer):DWORD;
stdcall; external 'Kernel32.dll';

FUNCTION ForAllert(lpParameter: Pointer): LongWord; stdcall;
begin
   while True do SleepEx(INFINITE, True);
   Exit(0);
end;

FUNCTION Job(Param:pointer):PtrInt; stdcall;
begin
   WaitForSingleObject(JobSem, INFINITE);
   inc(Step);
   Writeln('Задача ',Step,' выполнена потоком c ID ',link(Param)^.ID);
   ReleaseSemaphore(JobSem, 1, nil);
   sleep (500);
   writeln(GetCurrentThreadId,' проснулся');
   NoteEventCompleted;
   Job:=0;
end;

procedure WrapJob (Param:pointer); stdcall;
begin
   Job(Param);
end;

var start:LongWord;
i,j,n,count,Zadanie   :word;
begin
   Step:=0; RunningAPC:=0;
   write('Сколько потоков будет в пуле? ');
   readln(n);
   write('Сколько задач нужно выполнить? ');
   readln(Zadanie);
   SetLength(ThreadIDs,n);
   Event:=CreateEvent(nil,TRUE,FALSE,nil);
   JobSem := CreateSemaphore(nil, 1, 1, nil);
   IncSem := CreateSemaphore(nil, 1, 1, nil);
   DecSem := CreateSemaphore(nil, 1, 1, nil);
   for i:=0 to n-1 do
      Threads[i] := CreateThread(nil, 0, @ForAllert, nil, 0, @ThreadIDs[i].ID);
   for j:=1 to Zadanie do
   begin
      PrepareEventQueuing;
      QueueUserAPC(@WrapJob,Threads[j mod n],@ThreadIDs[j mod n]);
   end;
   writeln ('Задание ',Zadanie,' достигнуто за ',Step,' шагов');
   WaitForSingleObject(Event,INFINITE);
   CloseHandle(Event);
   for i:=0 to n-1 do CloseThread(Threads[i]);
   writeln ('Все потоки закрыты');
   readln
end.


:?: >Не уверен только, что использование 3-х семафоров оправдано. Может и одного хватит?< :?:
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Re: Использование WinApi для создания пула потоков

Сообщение runewalsh » 05.04.2018 17:59:45

Критическая секция нужна для того, чтобы защитить объект от одновременного доступа к нему двух потоков. Допустим, первый поток совершает последовательность операций: (A1) читает переменную в регистр, (A2) прибавляет к регистру 5, (A3) записывает назад. Второй: (B1) читает, (B2) отнимает 20, (B3) записывает. Если эти операции выполнятся в порядке A1 B1 A2 A3 B2 B3, то работа потока A потеряется, и после всего переменная окажется уменьшенной на 20 (а должна на 15 — возможными подразумеваются только A1 A2 A3 B1 B2 B3 или B1 B2 B3 A1 A2 A3). Твой вариант, применительно к inc/dec(RunningAPC), этому не помешает.

А ещё ты опять читаешь защищаемые переменные вне защиты (inc(RunningAPC)... ReleaseSemaphore... if RunningAPC... — ты не понял, что значит «ВСЯ работы с общей переменной»?).
Аватара пользователя
runewalsh
постоялец
 
Сообщения: 405
Зарегистрирован: 27.04.2010 00:15:25

Re: Использование WinApi для создания пула потоков

Сообщение olegy123 » 05.04.2018 20:28:43

Вставлю свои три копейки..
https://www.youtube.com/watch?v=yVZPJ4dCF9Q
olegy123
энтузиаст
 
Сообщения: 951
Зарегистрирован: 25.02.2016 12:10:20

Re: Использование WinApi для создания пула потоков

Сообщение stesl » 07.04.2018 14:25:30

Всем спасибо!
Считаю, что получил все ответы и бесценный опыт.
Основной трудностью, при достижении выполнения поставленной задачи, было то, что QueueUserAPC не компилился. Ответ вроде на первой странице.
Преподаватель, на слова, а почему в методичке не упоминается QueueUserWorkItem и системный пул - воскликнул - А ведь действительно :)
Конечный вариант моего примера с QueueUserAPC
Код: Выделить всё
USES windows;
TYPE
DBThreads=   record
ID         :LongWord;
end;
link=      ^DBThreads;
APCProc = procedure(PParam: pointer);stdcall;
FunForCThread = function(lpParametrs:pointer):LongWord;stdcall;
var
Threads      :TWOHandleArray;
ThreadIDs   :array of DBThreads;
JobSem,Event,Mutex:HANDLE;
Step      :word;
RunningAPC   :integer;

procedure PrepareEventQueuing;
begin
   WaitForSingleObject(Mutex,INFINITE);
   inc(RunningAPC);
   if RunningAPC=1 then ResetEvent(Event);
   ReleaseMutex(Mutex);
end;

procedure NoteEventCompleted;
begin
   WaitForSingleObject(Mutex,INFINITE);
   dec(RunningAPC);
   if RunningAPC=0 then SetEvent(Event);
   ReleaseMutex(Mutex);
end;
   
function CreateThread(lpThreadAttribute:pointer;dwStackSize:LongWord;lpStartAdress:FunForCThread;lpParameter:pointer;
dwCreatioFlags:LongWord;lpThreadId:pointer):HANDLE;stdcall; external 'Kernel32.dll';

function QueueUserAPC(pfnAPC:APCproc;hThread:HANDLE;PData:pointer):DWORD;
stdcall; external 'Kernel32.dll';

FUNCTION ForAllert(lpParameter: Pointer): LongWord; stdcall;
begin
   while True do SleepEx(INFINITE, True);
   Exit(0);
end;

FUNCTION Job(Param:pointer):PtrInt; stdcall;
begin
   WaitForSingleObject(JobSem, INFINITE);
   inc(Step);
   Writeln('Задача ',Step,' выполнена потоком c ID ',link(Param)^.ID);
   ReleaseSemaphore(JobSem, 1, nil);
   sleep (100);
   writeln(GetCurrentThreadId,' проснулся');
   NoteEventCompleted;
   Job:=0;
end;

procedure WrapJob (Param:pointer); stdcall;
begin
   Job(Param);
end;

var start:LongWord;
i,n,Zadanie   :word;
begin
   Step:=0; RunningAPC:=0;
   write('Сколько потоков будет в пуле? ');
   readln(n);
   write('Сколько задач нужно выполнить? ');
   readln(Zadanie);
   SetLength(ThreadIDs,n);
   Event:=CreateEvent(nil,TRUE,FALSE,nil);
   JobSem := CreateSemaphore(nil, 1, 1, nil);
   Mutex:=CreateMutex(nil,FALSE,nil);
   for i:=0 to n-1 do
   Threads[i] := CreateThread(nil, 0, @ForAllert, nil, 0, @ThreadIDs[i].ID);
   for i:=1 to Zadanie do
   begin
      PrepareEventQueuing;
      QueueUserAPC(@WrapJob,Threads[i mod n],@ThreadIDs[i mod n]);
   end;
   WaitForSingleObject(Event,INFINITE);
   CloseHandle(Event);
   CloseHandle(Mutex);
   CloseHandle(JobSem);
   for i:=0 to n-1 do CloseThread(Threads[i]);
   writeln ('Задание ',Zadanie,' достигнуто за ',Step,' шагов');
   writeln ('Все потоки закрыты');
   readln
end.


Для меня тема закрыта. Но с удовольствием прочитаю любые вновь возникшие замечания. Хотя бы для повышения опыта.
stesl
новенький
 
Сообщения: 31
Зарегистрирован: 30.03.2018 05:40:02

Пред.

Вернуться в Обучение Free Pascal

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5

Рейтинг@Mail.ru