diff --git a/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/1.pas b/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/1.pas index 3838db0bb..aba2751d6 100644 --- a/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/1.pas +++ b/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/1.pas @@ -16,12 +16,15 @@ begin // var A := NamedQ('A'); - var B := NamedQ('B'); - var C := NamedQ('C'); + var B := NamedQ('B').ThenWaitMarker; + var C := NamedQ('C').ThenWaitMarker; var D := NamedQ('D'); var E := NamedQ('E'); var F := NamedQ('F'); + // Можно попробовать расписать как "A + B*C + D*E*F", но это будет не то же самое: + // К примеру D будет ожидать окончание выполнения C перед тем как начать выполняться + // (когда все очереди выполняются за ровно одну секунду - это не заметно, но в реальной ситуации будет существенно) Context.Default.SyncInvoke( A + (B+D) * diff --git a/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/2.pas b/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/2.pas index b498002f8..08d39ad5d 100644 --- a/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/2.pas +++ b/InstallerSamples/OpenGL и OpenCL/OpenCLABC/Wait очереди/2.pas @@ -13,19 +13,27 @@ begin var A1 := NamedQ('A1'); var A2 := NamedQ('A2'); - var B1 := NamedQ('B1'); + var B1 := NamedQ('B1').ThenWaitMarker; + var Bw := WaitFor(B1); var C1 := NamedQ('C1'); var C2 := NamedQ('C2'); - var D2 := NamedQ('D2'); + var D2 := NamedQ('D2').ThenWaitMarker; + var Dw := WaitFor(D2); var E1 := NamedQ('E1'); var E2 := NamedQ('E2'); + // Дерево выполнения из данной программы может решать задачу такого типа: + // > Два парралельных процесса выполняются последовательно и иногда взаимодействуют + // Его можно расписать без Wait, к примеру как "A1*A2 + B1 + C1*C2 + D2 + E1*E2" + // И результат будет тот же, но такое дерево уже не похоже по форме на изначальную задачу + // Если между деревом и задачей сложно провести параллели - программу будет сложно улучшать + // (то есть будет сложно понять что делает что в очереди) Context.Default.SyncInvoke( - ( A1 + B1 + C1 + WaitFor(D2) + E1 ) * - ( A2 + WaitFor(B1) + C2 + D2 + E2 ) + ( A1 + B1 + C1 + Dw + E1 ) * + ( A2 + Bw + C2 + D2 + E2 ) ); end. \ No newline at end of file diff --git a/InstallerSamples/OpenGL и OpenCL/Справка OpenCLABC.html b/InstallerSamples/OpenGL и OpenCL/Справка OpenCLABC.html index 38ca71983..cfa49fa39 100644 --- a/InstallerSamples/OpenGL и OpenCL/Справка OpenCLABC.html +++ b/InstallerSamples/OpenGL и OpenCL/Справка OpenCLABC.html @@ -1766,67 +1766,127 @@ q.AddQueue(q); diff --git a/bin/Lib/OpenCLABC.pas b/bin/Lib/OpenCLABC.pas index 036a525b9..34ed0af56 100644 --- a/bin/Lib/OpenCLABC.pas +++ b/bin/Lib/OpenCLABC.pas @@ -29,15 +29,24 @@ unit OpenCLABC; //=================================== // Обязательно сделать до следующего пула: -//ToDo Написать в справке: -// - MarkerQueue -// - Вызов .Cast может оптимизировать так, что удалит очередь, для которой вызвали .Cast -// - Запрет ожидать ConstQueue и CastQueue -// - Запрет на .AddQueue(ConstQueue) +//ToDo .WhenDone после завершения выполнения странно себя вёл... //=================================== // Запланированное: +//ToDo Синхронные (с припиской Fast, а может Quick) варианты всего работающего по принципу HostQueue +// +//ToDo И асинхронные умнее запускать - помнить значение, указывающее можно ли выполнить их синхронно +// - Может даже можно синхронно выполнить "HPQ(...)+HPQ(...)", в некоторых случаях? +//ToDo Enqueueabl-ы вызывают .Invoke для первого параметра и .InvokeNewQ для остальных +// - А что если все параметры кроме последнего - константы? +// - Надо как то умнее это обрабатывать +//ToDo И сделать наконец нормальный класс-контейнер состояния очереди, параметрами всё не передашь + +//ToDo .Cast.ThenWaitMarker.Cast не оптимизируется - а можно было бы и оптимизировать +// - Для этого надо создавать ещё один псевдо-маркер, но давать ему тот же маркер +// - Но тогда маркер будет активироваться даже если первое преобразование неправильное... + //ToDo Проверять ".IsReadOnly" перед запасным копированием коллекций //ToDo В методах вроде .AddWriteArray1 приходится добавлять &<> @@ -104,15 +113,6 @@ unit OpenCLABC; //ToDo Когда будут очереди-обработчики - удалить ивенты CLTask-ов. Они, по сути, ограниченная версия. // - И использование их тут изнутри - в целом говнокод... -//ToDo Синхронные (с припиской Fast, а может Quick) варианты всего работающего по принципу HostQueue -// -//ToDo И асинхронные умнее запускать - помнить значение, указывающее можно ли выполнить их синхронно -// - Может даже можно синхронно выполнить "HPQ(...)+HPQ(...)", в некоторых случаях? -//ToDo Enqueueabl-ы вызывают .Invoke для первого параметра и .InvokeNewQ для остальных -// - А что если все параметры кроме последнего - константы? -// - Надо как то умнее это обрабатывать -//ToDo И сделать наконец нормальный класс-контейнер состояния очереди, параметрами всё не передашь - //ToDo .Cycle(integer) //ToDo .Cycle // бесконечность циклов //ToDo .CycleWhile(***->boolean) @@ -1771,70 +1771,6 @@ type ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU CommandQueueBase = abstract partial class - {$region Cast} - - ///Если данная очередь проходит по условию "... is CommandQueue" - возвращает себя же - ///Иначе возвращает очередь-обёртку, выполняющую "res := T(res)", где res - результат данной очереди - public function Cast: CommandQueue; - - {$endregion} - - {$region ThenConvert} - - private function ThenConvertBase(f: (object, Context)->TOtp): CommandQueue; abstract; - - ///Создаёт очередь, которая выполнит данную - ///А затем выполнит на CPU функцию f, используя результат данной очереди - public function ThenConvert(f: object->TOtp ) := ThenConvertBase((o,c)->f(o)); - ///Создаёт очередь, которая выполнит данную - ///А затем выполнит на CPU функцию f, используя результат данной очереди и контекст выполнения - public function ThenConvert(f: (object, Context)->TOtp) := ThenConvertBase(f); - - {$endregion ThenConvert} - - {$region +/*} - - private function AfterQueueSyncBase(q: CommandQueueBase): CommandQueueBase; abstract; - private function AfterQueueAsyncBase(q: CommandQueueBase): CommandQueueBase; abstract; - - public static function operator+(q1, q2: CommandQueueBase): CommandQueueBase := q2.AfterQueueSyncBase(q1); - public static function operator*(q1, q2: CommandQueueBase): CommandQueueBase := q2.AfterQueueAsyncBase(q1); - - public static procedure operator+=(var q1: CommandQueueBase; q2: CommandQueueBase) := q1 := q1+q2; - public static procedure operator*=(var q1: CommandQueueBase; q2: CommandQueueBase) := q1 := q1*q2; - - {$endregion +/*} - - {$region Multiusable} - - private function MultiusableBase: ()->CommandQueueBase; abstract; - - ///Создаёт функцию, вызывая которую можно создать любое кол-во очередей-удлинителей для данной очереди - ///Подробнее в справке: "Очередь>>Создание очередей>>Множественное использование очереди" - public function Multiusable := MultiusableBase; - - {$endregion Multiusable} - - {$region ThenWait} - - private function ThenWaitForAllBase(qs: sequence of CommandQueueBase): CommandQueueBase; abstract; - private function ThenWaitForAnyBase(qs: sequence of CommandQueueBase): CommandQueueBase; abstract; - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждой из заданых очередей - public function ThenWaitForAll(params qs: array of CommandQueueBase) := ThenWaitForAllBase(qs); - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждой из заданых очередей - public function ThenWaitForAll(qs: sequence of CommandQueueBase ) := ThenWaitForAllBase(qs); - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любой из заданных очередей - public function ThenWaitForAny(params qs: array of CommandQueueBase) := ThenWaitForAnyBase(qs); - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любой из заданных очередей - public function ThenWaitForAny(qs: sequence of CommandQueueBase ) := ThenWaitForAnyBase(qs); - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от заданой очереди - public function ThenWaitFor(q: CommandQueueBase) := ThenWaitForAll(q); - - {$endregion ThenWait} - {$region ToString} private static function DisplayNameForType(t: System.Type): string; @@ -1919,63 +1855,6 @@ type ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU CommandQueue = abstract partial class(CommandQueueBase) - {$region ThenConvert} - - ///Создаёт очередь, которая выполнит данную - ///А затем выполнит на CPU функцию f, используя результат данной очереди - public function ThenConvert(f: T->TOtp): CommandQueue := ThenConvert((o,c)->f(o)); - ///Создаёт очередь, которая выполнит данную - ///А затем выполнит на CPU функцию f, используя результат данной очереди и контекст выполнения - public function ThenConvert(f: (T, Context)->TOtp): CommandQueue; - - private function ThenConvertBase(f: (object, Context)->TOtp): CommandQueue; override := - ThenConvert(f as object as Func2); //ToDo #2221 - - {$endregion ThenConvert} - - {$region +/*} - - public static function operator+(q1: CommandQueueBase; q2: CommandQueue): CommandQueue; - public static function operator*(q1: CommandQueueBase; q2: CommandQueue): CommandQueue; - - private function AfterQueueSyncBase (q: CommandQueueBase): CommandQueueBase; override := q+self; - private function AfterQueueAsyncBase(q: CommandQueueBase): CommandQueueBase; override := q*self; - - public static procedure operator+=(var q1: CommandQueue; q2: CommandQueue) := q1 := q1+q2; - public static procedure operator*=(var q1: CommandQueue; q2: CommandQueue) := q1 := q1*q2; - - {$endregion +/*} - - {$region Multiusable} - - ///Создаёт функцию, вызывая которую можно создать любое кол-во очередей-удлинителей для данной очереди - ///Подробнее в справке: "Очередь>>Создание очередей>>Множественное использование очереди" - public function Multiusable: ()->CommandQueue; - - private function MultiusableBase: ()->CommandQueueBase; override := Multiusable() as object as Func; //ToDo #2221 - - {$endregion Multiusable} - - {$region ThenWait} - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждой из заданых очередей - public function ThenWaitForAll(params qs: array of CommandQueueBase): CommandQueue := ThenWaitForAll(qs.AsEnumerable); - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждой из заданых очередей - public function ThenWaitForAll(qs: sequence of CommandQueueBase): CommandQueue; - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любой из заданных очередей - public function ThenWaitForAny(params qs: array of CommandQueueBase): CommandQueue := ThenWaitForAny(qs.AsEnumerable); - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любой из заданных очередей - public function ThenWaitForAny(qs: sequence of CommandQueueBase): CommandQueue; - - ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от заданой очереди - public function ThenWaitFor(q: CommandQueueBase) := ThenWaitForAll(q); - - private function ThenWaitForAllBase(qs: sequence of CommandQueueBase): CommandQueueBase; override := ThenWaitForAll(qs); - private function ThenWaitForAnyBase(qs: sequence of CommandQueueBase): CommandQueueBase; override := ThenWaitForAny(qs); - - {$endregion ThenWait} - end; {$endregion Base} @@ -2023,6 +1902,7 @@ type new ConstQueue(o); end; + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU CommandQueue = abstract partial class @@ -2033,19 +1913,203 @@ type {$endregion Const} - {$region Marker} + {$region Cast} - ///Представляет очередь-маркер - ///Очереди-маркеры ничего не выполняют и возвращает object(nil) - ///Используйте такие очереди только для ожидания в Wait очередях - MarkerQueue = sealed partial class + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueueBase = abstract partial class - ///Создаёт новую очередь-маркер - public constructor := exit; + ///Если данная очередь проходит по условию "... is CommandQueue" - возвращает себя же + ///Иначе возвращает очередь-обёртку, выполняющую "res := T(res)", где res - результат данной очереди + public function Cast: CommandQueue; end; - {$endregion Marker} + {$endregion Cast} + + {$region ThenConvert} + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueueBase = partial abstract class + + private function ThenConvertBase(f: (object, Context)->TOtp): CommandQueue; virtual; + + ///Создаёт очередь, которая выполнит данную + ///А затем выполнит на CPU функцию f, используя результат данной очереди + public function ThenConvert(f: object->TOtp ) := ThenConvertBase((o,c)->f(o)); + ///Создаёт очередь, которая выполнит данную + ///А затем выполнит на CPU функцию f, используя результат данной очереди и контекст выполнения + public function ThenConvert(f: (object, Context)->TOtp) := ThenConvertBase(f); + + end; + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueue = partial abstract class(CommandQueueBase) + + private function ThenConvertBase(f: (object, Context)->TOtp): CommandQueue; override := + ThenConvert(f as object as Func2); //ToDo #2221 + + ///Создаёт очередь, которая выполнит данную + ///А затем выполнит на CPU функцию f, используя результат данной очереди + public function ThenConvert(f: T->TOtp): CommandQueue := ThenConvert((o,c)->f(o)); + ///Создаёт очередь, которая выполнит данную + ///А затем выполнит на CPU функцию f, используя результат данной очереди и контекст выполнения + public function ThenConvert(f: (T, Context)->TOtp): CommandQueue; + + end; + + {$endregion ThenConvert} + + {$region +/*} + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueueBase = partial abstract class + + private function AfterQueueSyncBase(q: CommandQueueBase): CommandQueueBase; virtual; + private function AfterQueueAsyncBase(q: CommandQueueBase): CommandQueueBase; virtual; + + public static function operator+(q1, q2: CommandQueueBase): CommandQueueBase := q2.AfterQueueSyncBase(q1); + public static function operator*(q1, q2: CommandQueueBase): CommandQueueBase := q2.AfterQueueAsyncBase(q1); + + public static procedure operator+=(var q1: CommandQueueBase; q2: CommandQueueBase) := q1 := q1+q2; + public static procedure operator*=(var q1: CommandQueueBase; q2: CommandQueueBase) := q1 := q1*q2; + + end; + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueue = partial abstract class(CommandQueueBase) + + private function AfterQueueSyncBase (q: CommandQueueBase): CommandQueueBase; override := q+self; + private function AfterQueueAsyncBase(q: CommandQueueBase): CommandQueueBase; override := q*self; + + public static function operator+(q1: CommandQueueBase; q2: CommandQueue): CommandQueue; + public static function operator*(q1: CommandQueueBase; q2: CommandQueue): CommandQueue; + + public static procedure operator+=(var q1: CommandQueue; q2: CommandQueue) := q1 := q1+q2; + public static procedure operator*=(var q1: CommandQueue; q2: CommandQueue) := q1 := q1*q2; + + end; + + {$endregion +/*} + + {$region Multiusable} + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueueBase = partial abstract class + + private function MultiusableBase: ()->CommandQueueBase; virtual; + + ///Создаёт функцию, вызывая которую можно создать любое кол-во очередей-удлинителей для данной очереди + ///Подробнее в справке: "Очередь>>Создание очередей>>Множественное использование очереди" + public function Multiusable := MultiusableBase; + + end; + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueue = partial abstract class(CommandQueueBase) + + private function MultiusableBase: ()->CommandQueueBase; override := Multiusable() as object as Func; //ToDo #2221 + + ///Создаёт функцию, вызывая которую можно создать любое кол-во очередей-удлинителей для данной очереди + ///Подробнее в справке: "Очередь>>Создание очередей>>Множественное использование очереди" + public function Multiusable: ()->CommandQueue; + + end; + + {$endregion Multiusable} + + {$region Wait} + + ///Представляет базовый класс маркеров для Wait очередей + WaitMarkerBase = abstract partial class(CommandQueueBase) + + ///Посылает сигнал выполненности всем ожидающим Wait очередям + public procedure SendSignal; + + end; + + ///Представляет простой маркер для Wait очередей + ///При выполнении возвращает object(nil) + WaitMarker = sealed partial class(WaitMarkerBase) + + ///Создаёт новый маркер + public constructor := exit; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; + + end; + + ///Представляет псевдо-маркер для Wait очередей, являющийся обёрткой очереди с возвращаемым значением + ///Этот тип является наследником CommandQueue, а значит он не может наследовать сразу и от WaitMarkerBase + ///Но при присвоении или передаче параметром он разлагается в обычный маркер, поэтому его можно передавать в любые Wait очереди + PseudoWaitMarker = sealed partial class + private q: CommandQueue; + private wrap: WaitMarkerBase; + + ///Создаёт новый псевдо-маркер для Wait очередей + public constructor(q: CommandQueue); + private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + public static function operator implicit(pmarker: PseudoWaitMarker): WaitMarkerBase := pmarker.wrap; + + ///Посылает сигнал выполненности всем ожидающим Wait очередям + public procedure SendSignal := wrap.SendSignal; + + end; + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueueBase = abstract partial class + + private function ThenWaitMarkerBase: WaitMarkerBase; virtual; + ///Создаёт новую обёртку-псевдо-маркер (PseudoWaitMarker), которая работает как очередь, + ///но разлогается в обычный маркер для Wait очередей при присвоении или передаче параметром + public function ThenWaitMarker := ThenWaitMarkerBase; + + private function ThenWaitForAllBase(markers: sequence of WaitMarkerBase): CommandQueueBase; virtual; + private function ThenWaitForAnyBase(markers: sequence of WaitMarkerBase): CommandQueueBase; virtual; + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждого из заданых маркеров + public function ThenWaitForAll(params markers: array of WaitMarkerBase) := ThenWaitForAllBase(markers); + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждого из заданых маркеров + public function ThenWaitForAll( markers: sequence of WaitMarkerBase) := ThenWaitForAllBase(markers); + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любого из заданных маркеров + public function ThenWaitForAny(params markers: array of WaitMarkerBase) := ThenWaitForAnyBase(markers); + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любого из заданных маркеров + public function ThenWaitForAny( markers: sequence of WaitMarkerBase) := ThenWaitForAnyBase(markers); + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от заданого маркера + public function ThenWaitFor(marker: WaitMarkerBase) := ThenWaitForAll(marker); + + end; + + ///Представляет очередь, состоящую в основном из команд, выполняемых на GPU + CommandQueue = abstract partial class(CommandQueueBase) + + private function ThenWaitMarkerBase: WaitMarkerBase; override := ThenWaitMarker; + + ///Создаёт новую обёртку-псевдо-маркер (PseudoWaitMarker), которая работает как очередь, + ///но разлогается в обычный маркер для Wait очередей при присвоении или передаче параметром + public function ThenWaitMarker := new PseudoWaitMarker(self); + + private function ThenWaitForAllBase(markers: sequence of WaitMarkerBase): CommandQueueBase; override := ThenWaitForAll(markers); + private function ThenWaitForAnyBase(markers: sequence of WaitMarkerBase): CommandQueueBase; override := ThenWaitForAny(markers); + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждого из заданых маркеров + public function ThenWaitForAll(params markers: array of WaitMarkerBase): CommandQueue := ThenWaitForAll(markers.AsEnumerable); + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от каждого из заданых маркеров + public function ThenWaitForAll( markers: sequence of WaitMarkerBase): CommandQueue; + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любого из заданных маркеров + public function ThenWaitForAny(params markers: array of WaitMarkerBase): CommandQueue := ThenWaitForAny(markers.AsEnumerable); + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую первого сигнала выполненности от любого из заданных маркеров + public function ThenWaitForAny( markers: sequence of WaitMarkerBase): CommandQueue; + + ///Создаёт очередь, сначала выполняющую данную, а затем ожидающую сигнала выполненности от заданого маркера + public function ThenWaitFor(marker: WaitMarkerBase) := ThenWaitForAll(marker); + + end; + + {$endregion Wait} {$endregion CommandQueue} @@ -2346,18 +2410,18 @@ type ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU public function AddProc(p: (Buffer, Context)->()): BufferCommandQueue; - ///Добавляет ожидание сигнала выполненности от всех заданных очередей - public function AddWaitAll(params qs: array of CommandQueueBase): BufferCommandQueue; - ///Добавляет ожидание сигнала выполненности от всех заданных очередей - public function AddWaitAll(qs: sequence of CommandQueueBase): BufferCommandQueue; + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(params markers: array of WaitMarkerBase): BufferCommandQueue; + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(markers: sequence of WaitMarkerBase): BufferCommandQueue; - ///Добавляет ожидание первого сигнала выполненности от одной из заданных очередей - public function AddWaitAny(params qs: array of CommandQueueBase): BufferCommandQueue; - ///Добавляет ожидание первого сигнала выполненности от одной из заданных очередей - public function AddWaitAny(qs: sequence of CommandQueueBase): BufferCommandQueue; + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(params markers: array of WaitMarkerBase): BufferCommandQueue; + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(markers: sequence of WaitMarkerBase): BufferCommandQueue; - ///Добавляет ожидание сигнала выполненности от заданной очереди - public function AddWait(q: CommandQueueBase): BufferCommandQueue; + ///Добавляет ожидание сигнала выполненности от заданного маркера + public function AddWait(marker: WaitMarkerBase): BufferCommandQueue; {$endregion Special .Add's} @@ -2601,18 +2665,18 @@ type ///Добавляет выполнение процедуры на CPU в список обычных команд для GPU public function AddProc(p: (Kernel, Context)->()): KernelCommandQueue; - ///Добавляет ожидание сигнала выполненности от всех заданных очередей - public function AddWaitAll(params qs: array of CommandQueueBase): KernelCommandQueue; - ///Добавляет ожидание сигнала выполненности от всех заданных очередей - public function AddWaitAll(qs: sequence of CommandQueueBase): KernelCommandQueue; + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(params markers: array of WaitMarkerBase): KernelCommandQueue; + ///Добавляет ожидание сигнала выполненности от всех заданных маркеров + public function AddWaitAll(markers: sequence of WaitMarkerBase): KernelCommandQueue; - ///Добавляет ожидание первого сигнала выполненности от одной из заданных очередей - public function AddWaitAny(params qs: array of CommandQueueBase): KernelCommandQueue; - ///Добавляет ожидание первого сигнала выполненности от одной из заданных очередей - public function AddWaitAny(qs: sequence of CommandQueueBase): KernelCommandQueue; + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(params markers: array of WaitMarkerBase): KernelCommandQueue; + ///Добавляет ожидание первого сигнала выполненности от одного из заданных маркеров + public function AddWaitAny(markers: sequence of WaitMarkerBase): KernelCommandQueue; - ///Добавляет ожидание сигнала выполненности от заданной очереди - public function AddWait(q: CommandQueueBase): KernelCommandQueue; + ///Добавляет ожидание сигнала выполненности от заданного маркера + public function AddWait(marker: WaitMarkerBase): KernelCommandQueue; {$endregion Special .Add's} @@ -2666,18 +2730,18 @@ function HPQ(p: Context->()): CommandQueueBase; {$region WaitFor} -///Создаёт очередь, ожидающую сигнала выполненности от каждой из указанных очередей -function WaitForAll(params qs: array of CommandQueueBase): CommandQueueBase; -///Создаёт очередь, ожидающую сигнала выполненности от каждой из указанных очередей -function WaitForAll(qs: sequence of CommandQueueBase): CommandQueueBase; +///Создаёт очередь, ожидающую сигнала выполненности от каждого из указанных маркеров +function WaitForAll(params markers: array of WaitMarkerBase): CommandQueueBase; +///Создаёт очередь, ожидающую сигнала выполненности от каждого из указанных маркеров +function WaitForAll( markers: sequence of WaitMarkerBase): CommandQueueBase; -///Создаёт очередь, ожидающую первого сигнала выполненности от любой из указанных очередей -function WaitForAny(params qs: array of CommandQueueBase): CommandQueueBase; -///Создаёт очередь, ожидающую первого сигнала выполненности от любой из указанных очередей -function WaitForAny(qs: sequence of CommandQueueBase): CommandQueueBase; +///Создаёт очередь, ожидающую первого сигнала выполненности от любого из указанных маркеров +function WaitForAny(params markers: array of WaitMarkerBase): CommandQueueBase; +///Создаёт очередь, ожидающую первого сигнала выполненности от любого из указанных маркеров +function WaitForAny( markers: sequence of WaitMarkerBase): CommandQueueBase; -///Создаёт очередь, ожидающую сигнала выполненности от указанной очереди -function WaitFor(q: CommandQueueBase): CommandQueueBase; +///Создаёт очередь, ожидающую сигнала выполненности от заданного маркера +function WaitFor(marker: WaitMarkerBase): CommandQueueBase; {$endregion WaitFor} @@ -4103,7 +4167,25 @@ type protected function InvokeBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueResBase; abstract; - protected function InvokeNewQBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; prev_ev: EventList): QueueResBase; abstract; + private procedure FinishAfterNewQ(cq: cl_command_queue; ev: EventList; tsk: CLTaskBase; c: Context; main_dvc: cl_device_id); + begin + {$ifdef DEBUG} + if (ev.count<>0) and not ev.abortable then raise new System.NotSupportedException; + {$endif DEBUG} + if cq=cl_command_queue.Zero then exit; + + ev.AttachFinallyCallback(()-> + begin + System.Threading.Tasks.Task.Run(()->tsk.AddErr(cl.ReleaseCommandQueue(cq))) + end, tsk, c.ntv, main_dvc, cq{$ifdef EventDebug}, $'cl.ReleaseCommandQueue'{$endif}); + + end; + protected function InvokeNewQBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; prev_ev: EventList): QueueResBase; + begin + var cq := cl_command_queue.Zero; + Result := InvokeBase(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); + FinishAfterNewQ(cq, Result.ev, tsk, c, main_dvc); + end; /// Добавление tsk в качестве ключа для всех ожидаемых очередей protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); abstract; @@ -4112,10 +4194,7 @@ type CommandQueue = abstract partial class(CommandQueueBase) - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; abstract; - - protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; virtual := - InvokeImpl(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; abstract; protected function InvokeBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueResBase; override := Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); @@ -4123,73 +4202,19 @@ type begin var cq := cl_command_queue.Zero; Result := Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); - - {$ifdef DEBUG} - if (Result.ev.count<>0) and not Result.ev.abortable then raise new System.NotSupportedException; - {$endif DEBUG} - - if cq<>cl_command_queue.Zero then - Result.ev.AttachFinallyCallback(()-> - begin - System.Threading.Tasks.Task.Run(()->tsk.AddErr(cl.ReleaseCommandQueue(cq))) - end, tsk, c.ntv, main_dvc, cq{$ifdef EventDebug}, $'cl.ReleaseCommandQueue'{$endif}); - + FinishAfterNewQ(cq, Result.ev, tsk, c, main_dvc); end; - protected function InvokeNewQBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; prev_ev: EventList): QueueResBase; override := - InvokeNewQ(tsk, c, main_dvc, need_ptr_qr, prev_ev); end; {$endregion Base} -{$region Waitable} - -type - IWaitableCommandQueue = interface - procedure RegisterWaiterTask(tsk: CLTaskBase); - procedure AddMWHandler(tsk: CLTaskBase; handler: ()->boolean); - end; - WaitableCommandQueue = abstract class(CommandQueue, IWaitableCommandQueue) - private mw_evs := new Dictionary; - - public procedure IWaitableCommandQueue.RegisterWaiterTask(tsk: CLTaskBase) := - lock mw_evs do if not mw_evs.ContainsKey(tsk) then - begin - mw_evs[tsk] := new MWEventContainer; - tsk.WhenDone(tsk->lock mw_evs do mw_evs.Remove(tsk)); - end; - - public procedure IWaitableCommandQueue.AddMWHandler(tsk: CLTaskBase; handler: ()->boolean); - begin - var cont: MWEventContainer; - lock mw_evs do cont := mw_evs[tsk]; - cont.AddHandler(handler); - end; - - private procedure ExecuteMWHandlers; - begin - if mw_evs.Count=0 then exit; - var conts: array of MWEventContainer; - lock mw_evs do conts := mw_evs.Values.ToArray; - for var i := 0 to conts.Length-1 do conts[i].ExecuteHandler; - end; - - protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; - begin - Result := InvokeImpl(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev).EnsureAbortability(tsk, c, main_dvc, cq); - Result.ev.AttachCallback(self.ExecuteMWHandlers, tsk, c.ntv, main_dvc, cq{$ifdef EventDebug}, $'ExecuteMWHandlers'{$endif}, false); - end; - - end; - -{$endregion Waitable} - {$region Const} type ConstQueue = sealed partial class(CommandQueue, IConstQueue) - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin if prev_ev=nil then prev_ev := new EventList; @@ -4205,39 +4230,118 @@ type {$endregion Const} -{$region Marker} +{$region WaitMarker} type - MarkerQueue = sealed partial class(WaitableCommandQueue) + WaitMarkerBase = abstract partial class(CommandQueueBase) + private mw_evs := new Dictionary; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + private procedure RegisterWaiterTask(tsk: CLTaskBase) := + lock mw_evs do if not mw_evs.ContainsKey(tsk) then + begin + mw_evs[tsk] := new MWEventContainer; + tsk.WhenDone(tsk->lock mw_evs do mw_evs.Remove(tsk)); + end; + + private procedure AddMWHandler(tsk: CLTaskBase; handler: ()->boolean); + begin + var cont: MWEventContainer; + lock mw_evs do cont := mw_evs[tsk]; + cont.AddHandler(handler); + end; + + end; + + WaitMarker = sealed partial class(WaitMarkerBase) + + protected function InvokeBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueResBase; override; begin - if prev_ev=nil then prev_ev := new EventList; {$ifdef DEBUG} if need_ptr_qr then raise new System.InvalidOperationException; {$endif DEBUG} Result := new QueueResConst(nil, prev_ev ?? new EventList); + Result.ev.AttachCallback(self.SendSignal, tsk, c.ntv, main_dvc, cq{$ifdef EventDebug}, $'ExecuteMWHandlers'{$endif}, false); end; protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := exit; - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override := sb += #10; + end; + + PseudoWaitMarkerWrapper = sealed class(WaitMarkerBase) + private org: CommandQueueBase; + public constructor(org: CommandQueueBase) := self.org := org; + private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + protected function InvokeBase(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueResBase; override := + org.InvokeBase(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + org.RegisterWaitables(tsk, prev_hubs); + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + org.ToStringHeader(sb, index); + sb += #10; + + end; + + end; + PseudoWaitMarker = sealed partial class(CommandQueue) + + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + begin + Result := self.q.Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); + Result.ev.AttachCallback(wrap.SendSignal, tsk, c.ntv, main_dvc, cq{$ifdef EventDebug}, $'ExecuteMWHandlers'{$endif}, false); + end; + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + + sb.Append(#9, tabs); + wrap.ToStringHeader(sb, index); + sb += #10; + + q.ToString(sb, tabs, index, delayed); + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + q.RegisterWaitables(tsk, prev_hubs); end; -{$endregion Marker} +procedure WaitMarkerBase.SendSignal; +begin + if mw_evs.Count=0 then exit; + var conts: array of MWEventContainer; + lock mw_evs do conts := mw_evs.Values.ToArray; + for var i := 0 to conts.Length-1 do conts[i].ExecuteHandler; +end; + +constructor PseudoWaitMarker.Create(q: CommandQueue); +begin + self.q := q; + self.wrap := new PseudoWaitMarkerWrapper(self); +end; + +function CommandQueueBase.ThenWaitMarkerBase := self.Cast&.ThenWaitMarker.wrap; + +{$endregion WaitMarker} {$region Host} type /// очередь, выполняющая какую то работу на CPU, всегда в отдельном потоке - HostQueue = abstract class(WaitableCommandQueue) + HostQueue = abstract class(CommandQueue) protected function InvokeSubQs(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; prev_ev: EventList): QueueRes; abstract; protected function ExecFunc(o: TInp; c: Context): TRes; abstract; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin var prev_qr := InvokeSubQs(tsk, c, main_dvc, cq, prev_ev); @@ -4253,7 +4357,339 @@ type {$endregion Host} -{$region Array} +{$endregion CommandQueue} + +{$region CLTask} + +type + CLTaskBase = abstract partial class + protected mu_res := new Dictionary; + + {$region UserEvent's} + protected user_events := new List; + + protected function MakeUserEvent(c: cl_context{$ifdef EventDebug}; reason: string{$endif}): UserEvent; + begin + Result := new UserEvent(c{$ifdef EventDebug}, reason{$endif}); + + lock user_events do + begin + if err_lst.Count<>0 then + Result.Abort else + user_events += Result; + end; + + end; + + {$endregion UserEvent's} + + end; + + CLTask = sealed partial class(CLTaskBase) + + protected constructor(q: CommandQueue; c: Context); + begin + self.q := q; + self.org_c := c; + q.RegisterWaitables(self, new HashSet); + + var cq: cl_command_queue; + var qr := q.Invoke(self, c, c.MainDevice.ntv, false, cq, nil); + + // mu выполняют лишний .Retain, чтобы ивент не удалился пока очередь ещё запускается + foreach var mu_qr in mu_res.Values do + mu_qr.ev.Release({$ifdef EventDebug}$'excessive mu ev'{$endif}); + mu_res := nil; + + {$ifdef DEBUG} + if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; + {$endif DEBUG} + + //CQ.Invoke всегда выполняет UserEvent.EnsureAbortability, поэтому тут оно не нужно + qr.ev.AttachFinallyCallback(()-> + begin + qr.ev.Release({$ifdef EventDebug}$'last ev of CLTask'{$endif}); + if cq<>cl_command_queue.Zero then + System.Threading.Tasks.Task.Run(()->self.AddErr( cl.ReleaseCommandQueue(cq) )); + OnQDone(qr); + end, self, c.ntv, c.MainDevice.ntv, cq{$ifdef EventDebug}, $'CLTask.OnQDone'{$endif}); + + end; + + private procedure OnQDone(qr: QueueRes); + begin + var l_EvDone: array of Action>; + var l_EvComplete: array of Action, T>; + var l_EvError: array of Action, array of Exception>; + + lock wh_lock do + try + + l_EvDone := EvDone.ToArray; + l_EvComplete := EvComplete.ToArray; + l_EvError := EvError.ToArray; + + if err_lst.Count=0 then self.q_res := qr.GetRes; + finally + wh.Set; + end; + + foreach var ev in l_EvDone do + try + ev(self); + except + on e: Exception do AddErr(e); + end; + + if err_lst.Count=0 then + begin + + foreach var ev in l_EvComplete do + try + ev(self, self.q_res); + except + on e: Exception do AddErr(e); + end; + + end else + if l_EvError.Length<>0 then + begin + var err_arr := GetErrArr; + + foreach var ev in l_EvError do + try + ev(self, err_arr); + except + on e: Exception do AddErr(e); + end; + + end; + + end; + + end; + + CLTaskResLess = sealed class(CLTaskBase) + protected q: CommandQueueBase; + protected q_res: object; + + protected function OrgQueueBase: CommandQueueBase; override := q; + + protected constructor(q: CommandQueueBase; c: Context); + begin + self.q := q; + self.org_c := c; + q.RegisterWaitables(self, new HashSet); + + var cq: cl_command_queue; + var qr := q.InvokeBase(self, c, c.MainDevice.ntv, false, cq, nil); + + // mu выполняют лишний .Retain, чтобы ивент не удалился пока очередь ещё запускается + foreach var mu_qr in mu_res.Values do + mu_qr.ev.Release({$ifdef EventDebug}$'excessive mu ev'{$endif}); + mu_res := nil; + + {$ifdef DEBUG} + if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; + {$endif DEBUG} + + qr.ev.AttachFinallyCallback(()-> + begin + qr.ev.Release({$ifdef EventDebug}$'last ev of CLTask'{$endif}); + if cq<>cl_command_queue.Zero then + System.Threading.Tasks.Task.Run(()->self.AddErr( cl.ReleaseCommandQueue(cq) )); + OnQDone(qr); + end, self, c.ntv, c.MainDevice.ntv, cq{$ifdef EventDebug}, $'CLTaskResLess.OnQDone'{$endif}); + + end; + + {$region CLTask event's} + + protected EvDone := new List>; + protected procedure WhenDoneBase(cb: Action); override := + if AddEventHandler(EvDone, cb) then cb(self); + + protected EvComplete := new List>; + protected procedure WhenCompleteBase(cb: Action); override := + if AddEventHandler(EvComplete, cb) then cb(self, q_res); + + protected EvError := new List>; + protected procedure WhenErrorBase(cb: Action); override := + if AddEventHandler(EvError, cb) then cb(self, GetErrArr); + + {$endregion CLTask event's} + + {$region Execution} + + private procedure OnQDone(qr: QueueResBase); + begin + var l_EvDone: array of Action; + var l_EvComplete: array of Action; + var l_EvError: array of Action; + + lock wh_lock do + try + + l_EvDone := EvDone.ToArray; + l_EvComplete := EvComplete.ToArray; + l_EvError := EvError.ToArray; + + if err_lst.Count=0 then self.q_res := qr.GetResBase; + finally + wh.Set; + end; + + foreach var ev in l_EvDone do + try + ev(self); + except + on e: Exception do AddErr(e); + end; + + if err_lst.Count=0 then + begin + + foreach var ev in l_EvComplete do + try + ev(self, self.q_res); + except + on e: Exception do AddErr(e); + end; + + end else + if l_EvError.Length<>0 then + begin + var err_arr := GetErrArr; + + foreach var ev in l_EvError do + try + ev(self, err_arr); + except + on e: Exception do AddErr(e); + end; + + end; + + end; + + protected function WaitResBase: object; override; + begin + Wait; + Result := q_res; + end; + + {$endregion Execution} + + end; + +function Context.BeginInvoke(q: CommandQueue) := new CLTask(q, self); +function Context.BeginInvoke(q: CommandQueueBase) := new CLTaskResLess(q, self); + +procedure CLTaskBase.AddErr(e: Exception) := +begin + if e is ThreadAbortException then exit; + lock err_lst do err_lst += e; + lock user_events do + begin + for var i := user_events.Count-1 downto 0 do + user_events[i].Abort; + user_events.Clear; + end; +end; + +static function UserEvent.MakeUserEvent(tsk: CLTaskBase; c: cl_context{$ifdef EventDebug}; reason: string{$endif}) := tsk.MakeUserEvent(c{$ifdef EventDebug}, reason{$endif}); + +{$endregion CLTask} + +{$region Queue converter's} + +{$region Cast} + +type + ICastQueue = interface + function GetQ: CommandQueueBase; + end; + CastQueue = sealed class(CommandQueue, ICastQueue) + private q: CommandQueueBase; + public function ICastQueue.GetQ := q; + + public constructor(q: CommandQueueBase) := self.q := q; + + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := + q.InvokeBase(tsk, c, main_dvc, false, cq, prev_ev).LazyQuickTransformBase(o-> + try + Result := T(o); + except + on e: Exception do + tsk.AddErr(e); + end); + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + q.RegisterWaitables(tsk, prev_hubs); + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + q.ToString(sb, tabs, index, delayed); + end; + + end; + +function CommandQueueBase.Cast: CommandQueue; +begin + var q := self; + if q is ICastQueue(var cq) then q := cq.GetQ; + Result := + if q is IConstQueue(var cq) then + new ConstQueue(T(cq.GetConstVal)) else + if q is CommandQueue(var tcq) then + tcq else + new CastQueue(q); +end; + +{$endregion Cast} + +{$region ThenConvert} + +type + CommandQueueThenConvert = sealed class(HostQueue) + protected q: CommandQueue; + protected f: (TInp, Context)->TRes; + + public constructor(q: CommandQueue; f: (TInp, Context)->TRes); + begin + self.q := q; + self.f := f; + end; + private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + q.RegisterWaitables(tsk, prev_hubs); + + protected function InvokeSubQs(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := + q.Invoke(tsk, c, main_dvc, false, cq, prev_ev); + + protected function ExecFunc(o: TInp; c: Context): TRes; override := f(o, c); + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += ' => '; + sb.Append(f); + sb += #10; + q.ToString(sb, tabs, index, delayed); + end; + + end; + +function CommandQueueBase.ThenConvertBase(f: (object, Context)->TOtp) := +self.Cast&.ThenConvert(f); + +function CommandQueue.ThenConvert(f: (T, Context)->TOtp) := +new CommandQueueThenConvert(self, f); + +{$endregion ThenConvert} + +{$region +/*} {$region Simple} @@ -4261,7 +4697,7 @@ type ISimpleQueueArray = interface function GetQS: sequence of CommandQueueBase; end; - SimpleQueueArray = abstract class(WaitableCommandQueue, ISimpleQueueArray) + SimpleQueueArray = abstract class(CommandQueue, ISimpleQueueArray) protected qs: array of CommandQueueBase; protected last: CommandQueue; @@ -4293,7 +4729,7 @@ type ISimpleSyncQueueArray = interface(ISimpleQueueArray) end; SimpleSyncQueueArray = sealed class(SimpleQueueArray, ISimpleSyncQueueArray) - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin for var i := 0 to qs.Length-1 do @@ -4307,7 +4743,7 @@ type ISimpleAsyncQueueArray = interface(ISimpleQueueArray) end; SimpleAsyncQueueArray = sealed class(SimpleQueueArray, ISimpleAsyncQueueArray) - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin if (prev_ev<>nil) and (prev_ev.count<>0) then loop qs.Length do prev_ev.Retain({$ifdef EventDebug}$'for all async branches'{$endif}); @@ -4847,338 +5283,7 @@ type {$endregion Conv} -{$endregion Array} - -{$endregion CommandQueue} - -{$region CLTask} - -type - CLTaskBase = abstract partial class - protected mu_res := new Dictionary; - - {$region UserEvent's} - protected user_events := new List; - - protected function MakeUserEvent(c: cl_context{$ifdef EventDebug}; reason: string{$endif}): UserEvent; - begin - Result := new UserEvent(c{$ifdef EventDebug}, reason{$endif}); - - lock user_events do - begin - if err_lst.Count<>0 then - Result.Abort else - user_events += Result; - end; - - end; - - {$endregion UserEvent's} - - end; - - CLTask = sealed partial class(CLTaskBase) - - protected constructor(q: CommandQueue; c: Context); - begin - self.q := q; - self.org_c := c; - q.RegisterWaitables(self, new HashSet); - - var cq: cl_command_queue; - var qr := q.Invoke(self, c, c.MainDevice.ntv, false, cq, nil); - - // mu выполняют лишний .Retain, чтобы ивент не удалился пока очередь ещё запускается - foreach var mu_qr in mu_res.Values do - mu_qr.ev.Release({$ifdef EventDebug}$'excessive mu ev'{$endif}); - mu_res := nil; - - {$ifdef DEBUG} - if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; - {$endif DEBUG} - - //CQ.Invoke всегда выполняет UserEvent.EnsureAbortability, поэтому тут оно не нужно - qr.ev.AttachFinallyCallback(()-> - begin - qr.ev.Release({$ifdef EventDebug}$'last ev of CLTask'{$endif}); - if cq<>cl_command_queue.Zero then - System.Threading.Tasks.Task.Run(()->self.AddErr( cl.ReleaseCommandQueue(cq) )); - OnQDone(qr); - end, self, c.ntv, c.MainDevice.ntv, cq{$ifdef EventDebug}, $'CLTask.OnQDone'{$endif}); - - end; - - private procedure OnQDone(qr: QueueRes); - begin - var l_EvDone: array of Action>; - var l_EvComplete: array of Action, T>; - var l_EvError: array of Action, array of Exception>; - - lock wh_lock do - try - - l_EvDone := EvDone.ToArray; - l_EvComplete := EvComplete.ToArray; - l_EvError := EvError.ToArray; - - if err_lst.Count=0 then self.q_res := qr.GetRes; - finally - wh.Set; - end; - - foreach var ev in l_EvDone do - try - ev(self); - except - on e: Exception do AddErr(e); - end; - - if err_lst.Count=0 then - begin - - foreach var ev in l_EvComplete do - try - ev(self, self.q_res); - except - on e: Exception do AddErr(e); - end; - - end else - if l_EvError.Length<>0 then - begin - var err_arr := GetErrArr; - - foreach var ev in l_EvError do - try - ev(self, err_arr); - except - on e: Exception do AddErr(e); - end; - - end; - - end; - - end; - - CLTaskResLess = sealed class(CLTaskBase) - protected q: CommandQueueBase; - protected q_res: object; - - protected function OrgQueueBase: CommandQueueBase; override := q; - - protected constructor(q: CommandQueueBase; c: Context); - begin - self.q := q; - self.org_c := c; - q.RegisterWaitables(self, new HashSet); - - var cq: cl_command_queue; - var qr := q.InvokeBase(self, c, c.MainDevice.ntv, false, cq, nil); - - // mu выполняют лишний .Retain, чтобы ивент не удалился пока очередь ещё запускается - foreach var mu_qr in mu_res.Values do - mu_qr.ev.Release({$ifdef EventDebug}$'excessive mu ev'{$endif}); - mu_res := nil; - - {$ifdef DEBUG} - if (qr.ev.count<>0) and not qr.ev.abortable then raise new NotSupportedException; - {$endif DEBUG} - - qr.ev.AttachFinallyCallback(()-> - begin - qr.ev.Release({$ifdef EventDebug}$'last ev of CLTask'{$endif}); - if cq<>cl_command_queue.Zero then - System.Threading.Tasks.Task.Run(()->self.AddErr( cl.ReleaseCommandQueue(cq) )); - OnQDone(qr); - end, self, c.ntv, c.MainDevice.ntv, cq{$ifdef EventDebug}, $'CLTaskResLess.OnQDone'{$endif}); - - end; - - {$region CLTask event's} - - protected EvDone := new List>; - protected procedure WhenDoneBase(cb: Action); override := - if AddEventHandler(EvDone, cb) then cb(self); - - protected EvComplete := new List>; - protected procedure WhenCompleteBase(cb: Action); override := - if AddEventHandler(EvComplete, cb) then cb(self, q_res); - - protected EvError := new List>; - protected procedure WhenErrorBase(cb: Action); override := - if AddEventHandler(EvError, cb) then cb(self, GetErrArr); - - {$endregion CLTask event's} - - {$region Execution} - - private procedure OnQDone(qr: QueueResBase); - begin - var l_EvDone: array of Action; - var l_EvComplete: array of Action; - var l_EvError: array of Action; - - lock wh_lock do - try - - l_EvDone := EvDone.ToArray; - l_EvComplete := EvComplete.ToArray; - l_EvError := EvError.ToArray; - - if err_lst.Count=0 then self.q_res := qr.GetResBase; - finally - wh.Set; - end; - - foreach var ev in l_EvDone do - try - ev(self); - except - on e: Exception do AddErr(e); - end; - - if err_lst.Count=0 then - begin - - foreach var ev in l_EvComplete do - try - ev(self, self.q_res); - except - on e: Exception do AddErr(e); - end; - - end else - if l_EvError.Length<>0 then - begin - var err_arr := GetErrArr; - - foreach var ev in l_EvError do - try - ev(self, err_arr); - except - on e: Exception do AddErr(e); - end; - - end; - - end; - - protected function WaitResBase: object; override; - begin - Wait; - Result := q_res; - end; - - {$endregion Execution} - - end; - -function Context.BeginInvoke(q: CommandQueue) := new CLTask(q, self); -function Context.BeginInvoke(q: CommandQueueBase) := new CLTaskResLess(q, self); - -procedure CLTaskBase.AddErr(e: Exception) := -begin - if e is ThreadAbortException then exit; - lock err_lst do err_lst += e; - lock user_events do - begin - for var i := user_events.Count-1 downto 0 do - user_events[i].Abort; - user_events.Clear; - end; -end; - -static function UserEvent.MakeUserEvent(tsk: CLTaskBase; c: cl_context{$ifdef EventDebug}; reason: string{$endif}) := tsk.MakeUserEvent(c{$ifdef EventDebug}, reason{$endif}); - -{$endregion CLTask} - -{$region Queue converter's} - -{$region Cast} - -type - ICastQueue = interface - function GetQ: CommandQueueBase; - end; - CastQueue = sealed class(CommandQueue, ICastQueue) - private q: CommandQueueBase; - public function ICastQueue.GetQ := q; - - public constructor(q: CommandQueueBase) := self.q := q; - - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := - q.InvokeBase(tsk, c, main_dvc, false, cq, prev_ev).LazyQuickTransformBase(o-> - try - Result := T(o); - except - on e: Exception do - tsk.AddErr(e); - end); - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := - q.RegisterWaitables(tsk, prev_hubs); - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - q.ToString(sb, tabs, index, delayed); - end; - - end; - -function CommandQueueBase.Cast: CommandQueue; -begin - var q := self; - if q is ICastQueue(var cq) then q := cq.GetQ; - Result := - if q is IConstQueue(var cq) then - new ConstQueue(T(cq.GetConstVal)) else - if q is CommandQueue(var tcq) then - tcq else - new CastQueue(q); -end; - -{$endregion Cast} - -{$region ThenConvert} - -type - CommandQueueThenConvert = sealed class(HostQueue) - protected q: CommandQueue; - protected f: (TInp, Context)->TRes; - - public constructor(q: CommandQueue; f: (TInp, Context)->TRes); - begin - self.q := q; - self.f := f; - end; - private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := - q.RegisterWaitables(tsk, prev_hubs); - - protected function InvokeSubQs(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := - q.Invoke(tsk, c, main_dvc, false, cq, prev_ev); - - protected function ExecFunc(o: TInp; c: Context): TRes; override := f(o, c); - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += ' => '; - sb.Append(f); - sb += #10; - q.ToString(sb, tabs, index, delayed); - end; - - end; - -function CommandQueue.ThenConvert(f: (T, Context)->TOtp) := -new CommandQueueThenConvert(self, f); - -{$endregion ThenConvert} - -{$region QueueArray} +{$region Utils} type QueueArrayUtils = static class @@ -5215,15 +5320,20 @@ type end; +{$endregion Utils} + +function CommandQueueBase. AfterQueueSyncBase(q: CommandQueueBase) := q + self.Cast&; +function CommandQueueBase.AfterQueueAsyncBase(q: CommandQueueBase) := q * self.Cast&; + static function CommandQueue.operator+(q1: CommandQueueBase; q2: CommandQueue) := new SimpleSyncQueueArray(QueueArrayUtils. FlattenSyncQueueArray(|q1, q2|)); static function CommandQueue.operator*(q1: CommandQueueBase; q2: CommandQueue) := new SimpleAsyncQueueArray(QueueArrayUtils.FlattenAsyncQueueArray(|q1, q2|)); -{$endregion QueueArray} +{$endregion +/*} {$region Multiusable} type - MultiusableCommandQueueHub = sealed class(MultiusableCommandQueueHubBase) + MultiusableCommandQueueHub = sealed partial class(MultiusableCommandQueueHubBase) public q: CommandQueue; public constructor(q: CommandQueue) := self.q := q; private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); @@ -5243,15 +5353,13 @@ type Result.ev.Retain({$ifdef EventDebug}$'for all mu branches'{$endif}); end; - public function MakeNode: CommandQueue; - end; - MultiusableCommandQueueNode = sealed class(WaitableCommandQueue) + MultiusableCommandQueueNode = sealed class(CommandQueue) public hub: MultiusableCommandQueueHub; public constructor(hub: MultiusableCommandQueueHub) := self.hub := hub; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin Result := hub.OnNodeInvoked(tsk, c, main_dvc, need_ptr_qr); if prev_ev<>nil then Result := Result.TrySetEv( prev_ev + Result.ev ); @@ -5270,40 +5378,38 @@ type end; -function MultiusableCommandQueueHub.MakeNode := -new MultiusableCommandQueueNode(self); - + MultiusableCommandQueueHub = sealed partial class(MultiusableCommandQueueHubBase) + + public function MakeNode: CommandQueue := + new MultiusableCommandQueueNode(self); + + end; + +function CommandQueueBase.MultiusableBase := self.Cast&.Multiusable() as object as Func; //ToDo #2221 function CommandQueue.Multiusable: ()->CommandQueue := MultiusableCommandQueueHub&.Create(self).MakeNode; {$endregion Multiusable} -{$endregion Queue converter's} - {$region Wait} {$region WCQWaiter} type WCQWaiter = abstract class - private waitables: array of IWaitableCommandQueue; + private markers: array of WaitMarkerBase; - public constructor(waitables: array of CommandQueueBase); + public constructor(markers: array of WaitMarkerBase); begin - if waitables.Length = 0 then raise new System.ArgumentException($'Wait очереди должны ожидать хотя бы одну очередь'); - self.waitables := new IWaitableCommandQueue[waitables.Length]; - for var i := 0 to waitables.Length-1 do - begin - if waitables[i] is IWaitableCommandQueue(var wcq) then - self.waitables[i] := wcq else - if waitables[i] = nil then - raise new ArgumentNullException($'Очередь [{i}] очереди из списка ожидаемых была nil') else - raise new ArgumentException($'Wait очереди не поддерживают ожидание [{i}] очереди из списка ожидаемых, имеющей тип {waitables[i].GetType}'); - end; + if markers.Length = 0 then raise new System.ArgumentException($'Wait очереди должны ожидать хотя бы одну очередь'); + for var i := 0 to markers.Length-1 do + if markers[i] = nil then + raise new ArgumentNullException($'Очередь [{i}] очереди из списка маркеров была nil'); + self.markers := markers; end; private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC'); public procedure RegisterWaitables(tsk: CLTaskBase) := - foreach var q in waitables do q.RegisterWaiterTask(tsk); + foreach var marker in markers do marker.RegisterWaiterTask(tsk); public function GetWaitEv(tsk: CLTaskBase; c: Context): UserEvent; abstract; @@ -5312,24 +5418,24 @@ type sb.Append(#9, tabs); sb += self.GetType.Name; - if waitables.Length=1 then + if markers.Length=1 then begin sb += ' => '; - var q := waitables[0] as CommandQueueBase; - if q.ToStringHeader(sb, index) then - delayed += q; + var marker := markers[0]; + if marker.ToStringHeader(sb, index) then + delayed.Add( marker ); sb += #10; end else begin sb += #10; - foreach var q in waitables.Cast& do + foreach var marker in markers.Cast& do begin sb.Append(#9, tabs+1); - if q.ToStringHeader(sb, index) then - delayed += q; + if marker.ToStringHeader(sb, index) then + delayed.Add ( marker ); sb += #10; end; @@ -5348,11 +5454,11 @@ type ); var done := 0; - var total := waitables.Length; + var total := markers.Length; var done_lock := new object; - for var i := 0 to waitables.Length-1 do - waitables[i].AddMWHandler(tsk, ()-> + for var i := 0 to markers.Length-1 do + markers[i].AddMWHandler(tsk, ()-> begin if uev.CanRemove then exit; @@ -5380,8 +5486,8 @@ type {$ifdef EventDebug}, $'WCQWaiterAny[{waitables.Length}]'{$endif} ); - for var i := 0 to waitables.Length-1 do - waitables[i].AddMWHandler(tsk, ()->uev.SetStatus(CommandExecutionStatus.COMPLETE)); + for var i := 0 to markers.Length-1 do + markers[i].AddMWHandler(tsk, ()->uev.SetStatus(CommandExecutionStatus.COMPLETE)); Result := uev; end; @@ -5390,45 +5496,6 @@ type {$endregion WCQWaiter} -{$region WaitFor} - -type - CommandQueueWaitFor = sealed class(CommandQueue) - public waiter: WCQWaiter; - - public constructor(waiter: WCQWaiter) := - self.waiter := waiter; - - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; - begin - {$ifdef DEBUG} - if need_ptr_qr then raise new System.InvalidOperationException; - {$endif DEBUG} - var wait_ev := waiter.GetWaitEv(tsk, c); - Result := new QueueResConst(nil, prev_ev=nil ? wait_ev : prev_ev+wait_ev); - end; - - protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := - waiter.RegisterWaitables(tsk); - - private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; - begin - sb += #10; - waiter.ToString(sb, tabs, index, delayed); - end; - - end; - -function WaitForAll(params qs: array of CommandQueueBase) := WaitForAll(qs.AsEnumerable); -function WaitForAll(qs: sequence of CommandQueueBase) := new CommandQueueWaitFor(new WCQWaiterAll(qs.ToArray)); - -function WaitForAny(params qs: array of CommandQueueBase) := WaitForAny(qs.AsEnumerable); -function WaitForAny(qs: sequence of CommandQueueBase) := new CommandQueueWaitFor(new WCQWaiterAny(qs.ToArray)); - -function WaitFor(q: CommandQueueBase) := WaitForAll(q); - -{$endregion WaitFor} - {$region ThenWait} type @@ -5442,7 +5509,7 @@ type self.waiter := waiter; end; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin Result := q.Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); Result := Result.TrySetEv( Result.ev + waiter.GetWaitEv(tsk, c) ); @@ -5463,16 +5530,57 @@ type end; -function CommandQueue.ThenWaitForAll(qs: sequence of CommandQueueBase) := -new CommandQueueThenWaitFor(self, new WCQWaiterAll(qs.ToArray)); +function CommandQueueBase.ThenWaitForAllBase(markers: sequence of WaitMarkerBase) := self.Cast&.ThenWaitForAll(markers); +function CommandQueueBase.ThenWaitForAnyBase(markers: sequence of WaitMarkerBase) := self.Cast&.ThenWaitForAny(markers); -function CommandQueue.ThenWaitForAny(qs: sequence of CommandQueueBase) := -new CommandQueueThenWaitFor(self, new WCQWaiterAny(qs.ToArray)); +function CommandQueue.ThenWaitForAll(markers: sequence of WaitMarkerBase) := new CommandQueueThenWaitFor(self, new WCQWaiterAll(markers.ToArray)); +function CommandQueue.ThenWaitForAny(markers: sequence of WaitMarkerBase) := new CommandQueueThenWaitFor(self, new WCQWaiterAny(markers.ToArray)); {$endregion ThenWait} +{$region WaitFor} + +type + CommandQueueWaitFor = sealed class(CommandQueue) + public waiter: WCQWaiter; + + public constructor(waiter: WCQWaiter) := + self.waiter := waiter; + + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + begin + {$ifdef DEBUG} + if need_ptr_qr then raise new System.InvalidOperationException; + {$endif DEBUG} + var wait_ev := waiter.GetWaitEv(tsk, c); + Result := new QueueResConst(nil, prev_ev=nil ? wait_ev : prev_ev+wait_ev); + end; + + protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override := + waiter.RegisterWaitables(tsk); + + private procedure ToStringImpl(sb: StringBuilder; tabs: integer; index: Dictionary; delayed: HashSet); override; + begin + sb += #10; + waiter.ToString(sb, tabs, index, delayed); + end; + + end; + +function WaitForAll(params markers: array of WaitMarkerBase) := WaitForAll(markers.AsEnumerable); +function WaitForAll( markers: sequence of WaitMarkerBase) := new CommandQueueWaitFor(new WCQWaiterAll(markers.ToArray)); + +function WaitForAny(params markers: array of WaitMarkerBase) := WaitForAny(markers.AsEnumerable); +function WaitForAny( markers: sequence of WaitMarkerBase) := new CommandQueueWaitFor(new WCQWaiterAny(markers.ToArray)); + +function WaitFor(marker: WaitMarkerBase) := WaitForAll(marker); + +{$endregion WaitFor} + {$endregion Wait} +{$endregion Queue converter's} + {$region KernelArg} {$region Base} @@ -5891,13 +5999,13 @@ type end; - GPUCommandContainer = abstract partial class(WaitableCommandQueue) + GPUCommandContainer = abstract partial class(CommandQueue) protected core: GPUCommandContainerCore; protected commands := new List>; protected procedure InitObj(obj: T; c: Context); virtual := exit; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override := core.Invoke(tsk, c, main_dvc, need_ptr_qr, cq, prev_ev); protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet); override; @@ -6032,7 +6140,7 @@ constructor BufferCommandQueue.Create := inherited; function BufferCommandQueue.AddQueue(q: CommandQueueBase): BufferCommandQueue; begin Result := self; - if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди. Если вам надо выполнить очередь для Wait - используйте MarkerQueue'); + if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); if q is ICastQueue(var cq) then q := cq.GetQ; commands.Add( new QueueCommand(q) ); end; @@ -6040,13 +6148,13 @@ end; function BufferCommandQueue.AddProc(p: Buffer->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); function BufferCommandQueue.AddProc(p: (Buffer, Context)->()) := AddCommand(self, new ProcCommand(p)); -function BufferCommandQueue.AddWaitAll(params qs: array of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(qs.ToArray))); -function BufferCommandQueue.AddWaitAll(qs: sequence of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(qs.ToArray))); +function BufferCommandQueue.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); +function BufferCommandQueue.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); -function BufferCommandQueue.AddWaitAny(params qs: array of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(qs.ToArray))); -function BufferCommandQueue.AddWaitAny(qs: sequence of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(qs.ToArray))); +function BufferCommandQueue.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); +function BufferCommandQueue.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); -function BufferCommandQueue.AddWait(q: CommandQueueBase) := AddWaitAll(q); +function BufferCommandQueue.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); {$endregion Special .Add's} @@ -6068,7 +6176,7 @@ constructor KernelCommandQueue.Create := inherited; function KernelCommandQueue.AddQueue(q: CommandQueueBase): KernelCommandQueue; begin Result := self; - if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди. Если вам надо выполнить очередь для Wait - используйте MarkerQueue'); + if q is IConstQueue then raise new System.ArgumentException($'В .AddQueue нельзя передавать константные очереди'); if q is ICastQueue(var cq) then q := cq.GetQ; commands.Add( new QueueCommand(q) ); end; @@ -6076,13 +6184,13 @@ end; function KernelCommandQueue.AddProc(p: Kernel->()) := AddCommand(self, new ProcCommand((o,c)->p(o))); function KernelCommandQueue.AddProc(p: (Kernel, Context)->()) := AddCommand(self, new ProcCommand(p)); -function KernelCommandQueue.AddWaitAll(params qs: array of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(qs.ToArray))); -function KernelCommandQueue.AddWaitAll(qs: sequence of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(qs.ToArray))); +function KernelCommandQueue.AddWaitAll(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); +function KernelCommandQueue.AddWaitAll(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAll(markers.ToArray))); -function KernelCommandQueue.AddWaitAny(params qs: array of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(qs.ToArray))); -function KernelCommandQueue.AddWaitAny(qs: sequence of CommandQueueBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(qs.ToArray))); +function KernelCommandQueue.AddWaitAny(params markers: array of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); +function KernelCommandQueue.AddWaitAny(markers: sequence of WaitMarkerBase) := AddCommand(self, new WaitCommand(new WCQWaiterAny(markers.ToArray))); -function KernelCommandQueue.AddWait(q: CommandQueueBase) := AddWaitAll(q); +function KernelCommandQueue.AddWait(marker: WaitMarkerBase) := AddWaitAll(marker); {$endregion Special .Add's} @@ -6238,7 +6346,7 @@ type tsk: CLTaskBase; res_qr: QueueResDelayedBase; end; - EnqueueableGetCommand = abstract class(WaitableCommandQueue, IEnqueueable>) + EnqueueableGetCommand = abstract class(CommandQueue, IEnqueueable>) protected prev_commands: GPUCommandContainer; public constructor(prev_commands: GPUCommandContainer) := @@ -6260,7 +6368,7 @@ type Result := (lcq, ev, data)->enq_f(data.prev_qr.GetRes, lcq, data.tsk, ev, data.res_qr); end; - protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; + protected function Invoke(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes; override; begin var prev_qr := prev_commands.Invoke(tsk, c, main_dvc, false, cq, prev_ev);