administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Merge pull request #2209 from SunSerega/Open-CL-GL

Browse source 
Обновление POCGL (кодогенерация OpenCL)
This commit is contained in:
Mikhalkovich Stanislav 2020-03-06 22:51:35 +03:00 committed by GitHub
parent 38cc2e026f 0a23b630aa
commit c204054176
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
7 changed files with 57978 additions and 39277 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
InstallerSamples/OpenGL и OpenCL/OpenCL/MatrMlt.pas
View file

@ -8,43 +8,24 @@ const
VecByteSize = MatrW*8;
MatrL = MatrW*MatrW;
MatrByteSize = MatrL*8;
procedure MatrToUnmanagedArr(m: array[,] of real; mem: IntPtr);
begin
var a := new real[m.Length];
Buffer.BlockCopy(m,0, a,0, a.Length*8); // вообще не хорошо, лучше через GCHandle, тогда копировать не надо ничего
Marshal.Copy(a,0, mem,a.Length);
end;
procedure UnmanagedArrToMatr(mem: IntPtr; m: array[,] of real);
begin
var a := new real[m.Length];
Marshal.Copy(mem,a, 0,a.Length);
Buffer.BlockCopy(a,0, m,0, a.Length*8);
end;
begin
Randomize(0);
Randomize(0); // чтоб при каждом выполнении были одинаковые результаты
var ec: ErrorCode;
// Инициализация
var platform: cl_platform_id;
cl.GetPlatformIDs(1, @platform, nil).RaiseIfError;
cl.GetPlatformIDs(1, platform, IntPtr.Zero).RaiseIfError;
var device: cl_device_id;
cl.GetDeviceIDs(platform, DeviceTypeFlags.Default, 1, @device, nil).RaiseIfError;
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_DEFAULT, 1,device,IntPtr.Zero).RaiseIfError;
// cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
// DeviceTypeFlags.Default это обычно GPU
// К примеру, в ноутбуке его может не быть
// Тогда надо хоть для чего то попытаться инициализировать
// DeviceTypeFlags.All выберет первый любой девайс, поддерживающий OpenCL
// cl.GetDeviceIDs(platform, DeviceTypeFlags.All, 1, @device, nil).RaiseIfError;
var context := cl.CreateContext(nil, 1, @device, nil, nil, @ec);
var context := cl.CreateContext(nil, 1,device, nil,IntPtr.Zero, ec);
ec.RaiseIfError;
var command_queue := cl.CreateCommandQueue(context, device, CommandQueuePropertyFlags.NONE, ec);
var command_queue := cl.CreateCommandQueueWithProperties(context, device, nil, ec);
ec.RaiseIfError;
// Чтение и компиляция .cl файла
@ -60,7 +41,7 @@ begin
);
ec.RaiseIfError;
cl.BuildProgram(prog, 1, @device, nil, nil, nil).RaiseIfError;
cl.BuildProgram(prog, 1,device, nil, nil,IntPtr.Zero).RaiseIfError;
var MatrMltMatrKernel := cl.CreateKernel(prog, 'MatrMltMatr', ec);
ec.RaiseIfError;
@ -70,73 +51,70 @@ begin
// Подготовка параметров
writeln('Матрица A:');
Writeln('Матрица A:');
var A := MatrRandomReal(MatrW,MatrW,0,1).Println;
writeln;
var Amem := Marshal.AllocHGlobal(MatrByteSize);
MatrToUnmanagedArr(A,Amem);
var AmemObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE or MemoryFlags.USE_HOST_PTR, new UIntPtr(MatrByteSize), Amem, ec);
Writeln;
var A_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(MatrByteSize),IntPtr.Zero, ec);
ec.RaiseIfError;
cl.EnqueueWriteBuffer(command_queue, A_buf, Bool.BLOCKING, new UIntPtr(0),new UIntPtr(MatrByteSize), A[0,0], 0,nil,IntPtr.Zero).RaiseIfError;
writeln('Матрица B:');
Writeln('Матрица B:');
var B := MatrRandomReal(MatrW,MatrW,0,1).Println;
writeln;
var Bmem := Marshal.AllocHGlobal(MatrByteSize);
MatrToUnmanagedArr(B,Bmem);
var BmemObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE or MemoryFlags.USE_HOST_PTR, new UIntPtr(MatrByteSize), Bmem, ec);
Writeln;
var B_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(MatrByteSize),IntPtr.Zero, ec);
ec.RaiseIfError;
cl.EnqueueWriteBuffer(command_queue, B_buf, Bool.BLOCKING, new UIntPtr(0),new UIntPtr(MatrByteSize), B[0,0], 0,nil,IntPtr.Zero).RaiseIfError;
writeln('Вектор V1:');
Writeln('Вектор V1:');
var V1 := ArrRandomReal(MatrW);
V1.Println;
writeln;
var V1mem := Marshal.AllocHGlobal(VecByteSize);
Marshal.Copy(V1,0, V1mem,MatrW);
var V1memObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE or MemoryFlags.USE_HOST_PTR, new UIntPtr(VecByteSize), V1mem, ec);
Writeln;
var V1_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(VecByteSize),IntPtr.Zero, ec);
ec.RaiseIfError;
cl.EnqueueWriteBuffer(command_queue, V1_buf, Bool.BLOCKING, new UIntPtr(0),new UIntPtr(VecByteSize), V1[0], 0,nil,IntPtr.Zero).RaiseIfError;
var C_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(MatrByteSize),IntPtr.Zero, ec);
ec.RaiseIfError;
var CmemObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE, new UIntPtr(MatrByteSize), nil, @ec);
ec.RaiseIfError;
var V2memObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE, new UIntPtr(VecByteSize), nil, @ec);
var V2_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(VecByteSize),IntPtr.Zero, ec);
ec.RaiseIfError;
var MatrWParam := MatrW;
var WmemObj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE or MemoryFlags.USE_HOST_PTR, new UIntPtr(4), @MatrWParam, @ec);
var W_buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE or MemFlags.MEM_USE_HOST_PTR, new UIntPtr(sizeof(integer)),new IntPtr(@MatrWParam), ec);
ec.RaiseIfError;
// Выполнение C := A*B
cl.SetKernelArg(MatrMltMatrKernel, 0, new UIntPtr(UIntPtr.Size), AmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 1, new UIntPtr(UIntPtr.Size), BmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 2, new UIntPtr(UIntPtr.Size), CmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 3, new UIntPtr(UIntPtr.Size), WmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 0, new UIntPtr(UIntPtr.Size), A_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 1, new UIntPtr(UIntPtr.Size), B_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 2, new UIntPtr(UIntPtr.Size), C_buf).RaiseIfError;
cl.SetKernelArg(MatrMltMatrKernel, 3, new UIntPtr(UIntPtr.Size), W_buf).RaiseIfError;
cl.EnqueueNDRangeKernel(command_queue, MatrMltMatrKernel, 2, nil,new UIntPtr[](new UIntPtr(MatrW),new UIntPtr(MatrW)),nil, 0,nil,nil).RaiseIfError;
var k1_ev: cl_event;
cl.EnqueueNDRangeKernel(command_queue, MatrMltMatrKernel, 2, nil,new UIntPtr[](new UIntPtr(MatrW),new UIntPtr(MatrW)),nil, 0,nil,k1_ev).RaiseIfError;
// Выполнение V2 := C*V
cl.SetKernelArg(MatrMltVecKernel, 0, new UIntPtr(UIntPtr.Size), CmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 1, new UIntPtr(UIntPtr.Size), V1memObj).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 2, new UIntPtr(UIntPtr.Size), V2memobj).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 3, new UIntPtr(UIntPtr.Size), WmemObj).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 0, new UIntPtr(UIntPtr.Size), C_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 1, new UIntPtr(UIntPtr.Size), V1_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 2, new UIntPtr(UIntPtr.Size), V2_buf).RaiseIfError;
cl.SetKernelArg(MatrMltVecKernel, 3, new UIntPtr(UIntPtr.Size), W_buf).RaiseIfError;
cl.EnqueueNDRangeKernel(command_queue, MatrMltVecKernel, 1, nil,new UIntPtr[](new UIntPtr(MatrW)),nil, 0,nil,nil).RaiseIfError;
var k2_ev: cl_event;
cl.EnqueueNDRangeKernel(command_queue, MatrMltVecKernel, 1, nil,new UIntPtr[](new UIntPtr(MatrW)),nil, 1,k1_ev,k2_ev).RaiseIfError;
// Чтение и вывод результата
cl.EnqueueReadBuffer(command_queue, CmemObj, 0, new UIntPtr(0), new UIntPtr(MatrByteSize), Amem, 0,nil,nil).RaiseIfError;
cl.EnqueueReadBuffer(command_queue, V2memObj, 0, new UIntPtr(0), new UIntPtr(VecByteSize), V1mem, 0,nil,nil).RaiseIfError;
cl.Finish(command_queue).RaiseIfError;
writeln('Матрица С = A*B:');
UnmanagedArrToMatr(Amem,A);
// Внимание! В отличии от OpenCLABC - тут чтение "C_buf" не обязательно начнётся сразу после выполнения "k1_ev"
// Большинство реализаций OpenCL не поддерживают асинхронные очереди
// Чтоб получить асинхронное выполнение "cl.Enqueue*" команд - надо несколько вызовов "cl.CreateCommandQueueWithProperties"
cl.EnqueueReadBuffer(command_queue, C_buf, Bool.BLOCKING, new UIntPtr(0), new UIntPtr(MatrByteSize), A[0,0], 1,k1_ev,IntPtr.Zero).RaiseIfError;
Writeln('Матрица С = A*B:');
A.Println;
writeln;
Writeln;
writeln('Вектор V2 = C*V1:');
Marshal.Copy(V1mem,V1,0,MatrW);
cl.EnqueueReadBuffer(command_queue, V2_buf, Bool.NON_BLOCKING, new UIntPtr(0), new UIntPtr(VecByteSize), V1[0], 1,k2_ev,IntPtr.Zero).RaiseIfError;
Writeln('Вектор V2 = C*V1:');
V1.Println;
end.

46
InstallerSamples/OpenGL и OpenCL/OpenCL/SimpleAddition.pas
View file

@ -2,32 +2,33 @@
uses System;
uses System.Runtime.InteropServices;
//Описания всех подпрограмм найдёте в справке по OpenCL:
//www.khronos.org/registry/OpenCL/specs/2.2/html/OpenCL_API.html
const
buf_size = 10;
buf_byte_size = buf_size * 4;
begin
var ec: ErrorCode;
// Инициализация
var platform: cl_platform_id;
cl.GetPlatformIDs(1, @platform, nil).RaiseIfError;
cl.GetPlatformIDs(1, platform, IntPtr.Zero).RaiseIfError;
var device: cl_device_id;
cl.GetDeviceIDs(platform, DeviceTypeFlags.Default, 1, @device, nil).RaiseIfError;
cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_DEFAULT, 1,device,IntPtr.Zero).RaiseIfError;
// DeviceTypeFlags.Default это обычно GPU
// DEVICE_TYPE_DEFAULT это, обычно, GPU
// Но, к примеру, в ноутбуке его может не быть
// Тогда надо хоть для чего то попытаться инициализировать
// DeviceTypeFlags.All выберет первые любое устройство, поддерживающее OpenCL
// cl.GetDeviceIDs(platform, DeviceTypeFlags.All, 1, @device, nil).RaiseIfError;
// DEVICE_TYPE_ALL выберет первое любое устройство, поддерживающее OpenCL
// cl.GetDeviceIDs(platform, DeviceType.DEVICE_TYPE_ALL, 1,device,IntPtr.Zero).RaiseIfError;
// Если всё ещё пишет что устройств нет - обновите драйверы,
// потому что даже встроенные видеокарты поддерживают OpenCL (хоть и криво)
// потому что даже встроенные видеокарты поддерживают OpenCL
var context := cl.CreateContext(nil, 1, @device, nil, nil, @ec);
var context := cl.CreateContext(nil, 1,device, nil,IntPtr.Zero, ec);
ec.RaiseIfError;
var command_queue := cl.CreateCommandQueue(context, device, CommandQueuePropertyFlags.NONE, ec);
var command_queue := cl.CreateCommandQueueWithProperties(context, device, nil, ec);
ec.RaiseIfError;
// Чтение и компиляция .cl файла
@ -43,30 +44,29 @@ begin
);
ec.RaiseIfError;
cl.BuildProgram(prog, 1, @device, nil, nil, nil).RaiseIfError;
cl.BuildProgram(prog, 1,device, nil, nil,IntPtr.Zero).RaiseIfError;
// Подготовка и запуск программы на GPU
var kernel := cl.CreateKernel(prog, 'TEST', ec); // Обязательно то же имя что у карнела из .cl файла. И регистр важен!
var kernel := cl.CreateKernel(prog, 'TEST', ec); // То же имя что у kernel'а из .cl файла. Регистр важен!
ec.RaiseIfError;
var mem := Marshal.AllocHGlobal(40);
Marshal.Copy(ArrFill(10,1),0,mem,10);
var memobj := cl.CreateBuffer(context, MemoryFlags.READ_WRITE or MemoryFlags.USE_HOST_PTR, new UIntPtr(40), mem, ec); // USE_HOST_PTR значит что нужно скопировать память из mem в memobj
var buf := cl.CreateBuffer(context, MemFlags.MEM_READ_WRITE, new UIntPtr(buf_byte_size), IntPtr.Zero, ec);
ec.RaiseIfError;
cl.SetKernelArg(kernel, 0, new UIntPtr(UIntPtr.Size), memobj).RaiseIfError;
var buf_fill_pattern := 1;
var buf_fill_ev: cl_event;
cl.EnqueueFillBuffer(command_queue, buf, buf_fill_pattern,new UIntPtr(sizeof(integer)), UIntPtr.Zero,new UIntPtr(buf_byte_size), 0,nil,buf_fill_ev).RaiseIfError;
cl.EnqueueNDRangeKernel(command_queue, kernel, 1, nil,new UIntPtr[](new UIntPtr(10)),nil, 0,nil,nil).RaiseIfError;
cl.SetKernelArg(kernel, 0, new UIntPtr(cl_mem.Size), buf).RaiseIfError;
cl.Finish(command_queue).RaiseIfError;
var k_ev: cl_event;
cl.EnqueueNDRangeKernel(command_queue, kernel, 1, nil,new UIntPtr[](new UIntPtr(buf_size)),nil, 1,buf_fill_ev,k_ev).RaiseIfError;
// Чтение и вывод результата
cl.EnqueueReadBuffer(command_queue, memobj, 1, new UIntPtr(0), new UIntPtr(40), mem, 0,nil,nil).RaiseIfError;
var res := new integer[10];
Marshal.Copy(mem,res,0,10);
var res := new integer[buf_size];
cl.EnqueueReadBuffer(command_queue, buf, Bool.BLOCKING, UIntPtr.Zero, new UIntPtr(buf_byte_size), res[0], 1,k_ev,IntPtr.Zero).RaiseIfError;
res.Println;
end.

180
InstallerSamples/OpenGL и OpenCL/Гайд по использованию OpenGL и OpenCL.html
View file

@ -876,6 +876,7 @@ window.onload = ()=>{
</a>
.</p>
<hr />
<h3>Отношение к высоко-уровневым модулям</h3>
<p>Н.у. модули созданы как промежуточная точка между исходными библиотеками и модулями
<a href="%D0%A1%D0%BF%D1%80%D0%B0%D0%B2%D0%BA%D0%B0%20OpenGLABC.html"><code>OpenGLABC</code></a>
и
@ -883,9 +884,10 @@ window.onload = ()=>{
на случай если вы хотите использовать OpenGL и/или OpenCL, но хотите написать свою высоко-уровневую оболочку.
Возможно, ради опыта. Возможно, ради особых оптимизаций. И т.п.</p>
<p>Если вы будете использовать только модули <code>OpenGLABC</code> и <code>OpenCLABC</code> - данная справка вам не нужна,
потому что <code>OpenGLABC</code> и <code>OpenCLABC</code> специально созданы так, чтоб отстранить программиста от всех сложностей
потому что они специально созданы так, чтоб отстранить программиста от всех сложностей
работы с неуправляемыми .dll и предоставить привычный ООП интерфейс со всевозможными удобствами.</p>
<hr />
<h3>Багтрагер</h3>
<p>Если:</p>
<ul>
<li><p>В н.у. модулях или данной справке найдена ошибка или чего-либо не хватает;</p>
@ -893,28 +895,7 @@ window.onload = ()=>{
<li><p>Вы наткнулись на какую то особенностью работы с неуправляемыми .dll, которая тут не (или недо-) описана:</p>
</li>
</ul>
<p>Пишите в <a href="https://github.com/SunSerega/POCGL/issues">issue</a>.</p>
<hr />
<p>Так же, в н.у. модулях (особенно в <code>OpenGL</code> и особенно в расширениях) содержится огромное количество подпрограмм.<br />
И большинство из них требует какой-либо чистки (в основном потому что при переводе с C++
<code>int *</code> может оказаться и указателем, и <code>var</code>-параметром, и массивом).</p>
<p>Все разом их не проверить. Но сделать это, всё же, надо. И в записи-перечисления тоже нуждаются в проверке.<br />
Если хотите помочь - можно писать и в issue, но лучше (и проще для вас, когда разберётесь) создать fork репозитория,
сделать там нужные изменения и послать pull-request. Могу объяснить подробнее в <a href="https://vk.com/sun_serega">vk</a> или по <code>sunserega2@gmail.com</code>.</p>
<p>Если будете изменять сами - вот файлы о которых вам надо знать:</p>
<ul>
<li><p>OpenGL | <a href="https://github.com/SunSerega/POCGL/tree/master/Packing/Template/GL/Fixers/Funcs">Контроль</a> перегрузок функций
и их <a href="https://github.com/SunSerega/POCGL/blob/master/Packing/Template/GL/Pack%20Funcs.pas">упаковщик</a>.<br />
+ после успешной упаковки <a href="https://github.com/SunSerega/POCGL/blob/master/Packing/Template/GL/Log/FinalFuncOverloads.log">этот</a>
файл показывает готовые списки перегрузок каждой подпрограммы в том же синтаксисе.</p>
</li>
<li><p>OpenGL | <a href="https://github.com/SunSerega/POCGL/tree/master/Packing/Template/GL/Fixers/Enums">Контроль</a> значений перечислений
и их <a href="https://github.com/SunSerega/POCGL/blob/master/Packing/Template/GL/Pack%20Enums.pas">упаковщик</a>.</p>
</li>
<li><p>Для создания .pas и .pcu файлов модулей в корне репозитория есть PackAll.pas и .bat файлы.</p>
</li>
</ul>
<p>(<code>OpenCL.pas</code> в ближайшее время получит такие же отдельные контроллеры и упаковщики, но пока что всё вручную, в .pas файле)</p>
<p>Пишите в <a href="https://github.com/SunSerega/POCGL/issues">issue</a>.</p>
</div>
<script>on_page_added(document.getElementById("page-1"))</script>
<div id="page-2" page_name="О неуправляемых .dll" hidden=true>
@ -927,8 +908,49 @@ window.onload = ()=>{
<p>OpenCL.dll и OpenGL.dll созданы на- и для языков C/C++, поэтому являются неуправляемыми.</p>
</div>
<script>on_page_added(document.getElementById("page-2"))</script>
<div id="page-3" page_name="Участие в разработке н.у. модулей" hidden=true>
<p>Большинство функций из н.у. модулей требует какой-либо чистки. В основном потому что
при переводе с C++ тип <code>int*</code> может оказаться и указателем, и <code>var</code>-параметром, и массивом.</p>
<p>При автоматическом переводе кода с C++ на паскаль - создаются все возможные перегркзки.
А те перегрузки, которые не подходят конкретным подпрограммам - надо убирать вручную.
В этом и состоит чистка подпрограмм.</p>
<p>Все разом функции не почистишь, в одном только <code>OpenGL</code> их &gt;3000. Но сделать это, всё же, надо.
Если хотите помочь - можно писать и в issue, но лучше (и проще для вас, когда разберётесь) создать fork репозитория,
сделать там нужные изменения и послать pull-request. Могу объяснить подробнее в <a href="https://vk.com/sun_serega">vk</a> или по <code>sunserega2@gmail.com</code>.</p>
<hr />
<p>Чтоб чистить подпрограммы было проще - я написал несколько инструментов.
Вся упаковка н.у. модулей находится <a href="https://github.com/SunSerega/POCGL/tree/master/Packing/Template">тут</a>.
Откройте папку <code>CL</code> или <code>GL</code>. Они устроены одинаково, поэтому объяснять можно на любой из них.</p>
<p>Все файлы (кроме .exe и .pdb, которые создаёт паскаль) в этих папках
открываются любым текстовым редактором (но я рекомендую Notepad++).</p>
<hr />
<h3>Fixers</h3>
<p>Контроль содержимого модуля находится в папке <code>Fixers</code>. В этой папке есть следующие подпапки:</p>
<ul>
<li><code>Funcs</code> - контроль подпрограмм;</li>
<li><code>Enums</code> - контроль записей-перечислений;</li>
<li><code>Structs</code> - контроль просто записей (записей-контейнеров, если хотите).</li>
</ul>
<p>Во всех папках находится файл <code>ReadMe.md</code>, объясняющий синтаксис.</p>
<hr />
<h3>MiscInput</h3>
<p><code>MiscInput</code> содержит другие данные, используемые при создании модулей, которые имеют разные значения для OpenCL и OpenGL.</p>
<p>Синтаксис у всех предельно прост. Не вижу смысла объяснять подробнее.</p>
<hr />
<h3>Log</h3>
<p><code>Log</code> содержит логи последней сборки соответствующего модуля.</p>
<p>Они в основном используются чтоб было проще увидеть на что именно
повлияли ваши изменения и как (используя проверку изменений git'а).</p>
<p>Но файл <code>FinalFuncOverloads.log</code> так же особо полезен перед
началом чистки, чтоб увидеть какие перегрузки уже есть.</p>
<hr />
<p>Чтоб применить фиксеры и посмотреть на что они влияют - вызывайте <code>Pack Most.pas</code>.</p>
<p>Ну а чтоб полностью собрать модули - вызывайте <code>PackAll.exe</code> в корне репозитория.<br />
(или <code>.bat</code> файлы там же, для сборки отдельно 1 модуля)</p>
</div>
<script>on_page_added(document.getElementById("page-3"))</script>
<script>on_end_folder()</script>
<div id="page-3" page_name="" hidden=true>
<div id="page-4" page_name="" hidden=true>
<h1>В кратце:</h1>
<ul>
<li>Н.у. модули представляют весь возможный функционал из своих соответствующих .dll;</li>
@ -952,19 +974,20 @@ window.onload = ()=>{
<li><a path="Особые типы модуля OpenGL"> Особые типы модуля <code>OpenGL</code> </a></li>
</ul>
</div>
<script>on_start_folder("Основные принципы", document.getElementById("page-3"))</script>
<div id="page-4" page_name="Записи-имена" hidden=true>
<script>on_start_folder("Основные принципы", document.getElementById("page-4"))</script>
<div id="page-5" page_name="Записи-имена" hidden=true>
<p>В исходных библиотеках обращение ко всем объектам идёт по &quot;именам&quot; (их так же можно назвать дескрипторами или id этих объектов).</p>
<p>Имена объектов - это числа (в OpenGL обычно на 32 бита, в OpenCL - зависит от битности системы).</p>
<p>Чтоб имя одного типа объектов нельзя было передать в подпрограмму, принимающую имена
объектов другого типа - в н.у. модулях для каждого типа объектов описана подобная запись:</p>
<p>Чтоб в подпрограмму, принимающую имена объектов определённого типа нельзя было передать имя
объекта неправильного типа - в н.у. модулях для каждого типа объектов описана подобная запись:</p>
<pre><code> BufferName = record
public val: UInt32;
public constructor(val: UInt32) := self.val := val;
public static property Zero: BufferName read default(BufferName);
public static property Size: integer read Marshal.SizeOf&amp;&lt;UInt32&gt;;
end;
</code></pre>
<p>Такой подход не замедляет готовую программу, но позволяет отловить на этапе компиляции некоторые ошибки.</p>
<p>Такой подход не замедляет готовую программу, но позволяет отловить некоторые ошибки на этапе компиляции.</p>
<p>Поле <code>.val</code> и конструктор публичны только на случай ошибки в перегрузках,
то есть если подпрограмма принемает неправильный тип имени.</p>
<p>В обычной ситуации - вы будете взаимодействовать с именами только 3 способами:</p>
@ -992,12 +1015,11 @@ MyProc(default(BufferName));
<p>У настоящих объектов имя никогда не будет нулевым.</p>
<p>Но бывает не мало случаев когда исходные библиотеки могут принимать нулевое имя.<br />
К примеру, привязка шейдера с нулевым именем в OpenGL отменяет предыдущую привязку шейдера.</p>
<p>И в своих подпрограммах вы так же можете определить особое поведение при передачи нулевого имени.</p>
</li>
</ol>
</div>
<script>on_page_added(document.getElementById("page-4"))</script>
<div id="page-5" page_name="Записи-перечисления" hidden=true>
<script>on_page_added(document.getElementById("page-5"))</script>
<div id="page-6" page_name="Записи-перечисления" hidden=true>
<p>Многие параметры подпрограмм в исходных библиотеках принимают перечисления (enum's).</p>
<p>Перечисления, как и имена, это числа. Но в отличии от имён - перечисления принимают заданные заранее константные значения.</p>
<p>В качестве примера:</p>
@ -1050,14 +1072,14 @@ gl.BeginQuery(QueryTarget.VERTICES_SUBMITTED, name);
ClearBufferMask.DEPTH_BUFFER_BIT // очистка буфера глубины - обязательна при рисовании 3D
);
</code></pre>
<p><code>or</code>, в данном случае, побитовое а не логическое. Поэтому его нельзя читать как &quot;или&quot;:</p>
<p><code>or</code>, в данном случае, побитовое, а не логическое.</p>
<p>Выражение<br />
<code>ClearBufferMask.COLOR_BUFFER_BIT or ClearBufferMask.DEPTH_BUFFER_BIT</code><br />
можно читать как &quot;все биты <code>COLOR_BUFFER_BIT</code> + все биты <code>DEPTH_BUFFER_BIT</code>&quot;.</p>
<p>А в случае <code>gl.Clear</code> эта комбинация значит &quot;очистить буфер цвета <strong>и</strong> буфер глубины&quot;</p>
</div>
<script>on_page_added(document.getElementById("page-5"))</script>
<div id="page-6" page_name="Классы-контейнеры подпрограмм" hidden=true>
<script>on_page_added(document.getElementById("page-6"))</script>
<div id="page-7" page_name="Классы-контейнеры подпрограмм" hidden=true>
<p>Все подпрограммы исходных библиотек можно разделить на подпрограммы ядра + множество мелких расширений.</p>
<hr />
<p>Все подпрограммы ядра находятся в классе <code>gl</code>/<code>cl</code> для OpenGL/OpenCL соответственно.</p>
@ -1105,28 +1127,17 @@ glDebugOutputAMD.DebugMessageEnableAMD(...);
</ul>
<p>Оба этих класса работают как класс <code>cl</code>, то есть им <strong>не</strong> надо создавать экземпляр.</p>
<hr />
<p>И последнее что вам надо знать об этих классах: если адрес определённой подпрограммы не удалось получить
(к примеру, при попытке получить адрес подпрограммы из более новой версии OpenGL, чем установлена в драйверах),
то возвращается нулевой адрес.</p>
<p>Адрес можно проверить через специальное поле класса:</p>
<pre><code>if gl.z_BindTextures_adr=IntPtr.Zero then ... ;
// Так же можно проверить адрес одной из перегрузок:
if gl.z_BindTextures_ovr_0=nil then ... ;
</code></pre>
<p>Для подпрограмм, подключаемых с помощью <code>external</code> (всё из OpenCL + <code>wgl</code>+<code>gdi</code> + функции из <code>gl</code> версий OpenGL1.1 и ниже)
адрес хранится в статичном поле. То есть их адрес можно читать только через имя класса:</p>
<pre><code>// У &quot;external&quot; подпрограмм нет &quot;z_*_adr&quot; поля
if OpenGL.gl.z_BindTexture_ovr0=nil then ... ;
// Если экземпляра класса нет - обращаться к имени класса можно и без &quot;OpenGL.&quot;
if wgl.z_CreateContext_ovr0=nil then ... ;
</code></pre>
<p>Однако проверять адрес это, в целом, плохая практика.</p>
<p>К примеру, узнать поддерживаемую версию <code>OpenGL</code> и список поддерживаемых расширений можно функцией <code>gl.GetString(...)</code>.
И такой подход на много правильнее чем создавать экземпляр расширения и смотреть, что с адресами его подпрограмм.</p>
<p>Адреса подпрограмм доступны публично только чтоб упростить вам жизнь при поиске ошибок.</p>
<p>И последнее что вам надо знать об этих классах: Если вы получаете <code>NullReferenceException</code>:</p>
<ol>
<li><p>Скорее всего вы попытались вызвать подпрограмму, которой нет в реализации библиотеки на вашем компьютере.<br />
Проверьте версию библиотеки, или, если это подпрограмма из расширения - проверьте существование у вас этого расширения.</p>
</li>
<li><p>Так же, возможно, проблема в н.у. модуле. Если вы уверены что п.1. вас не касается - напишите в issue.</p>
</li>
</ol>
</div>
<script>on_page_added(document.getElementById("page-6"))</script>
<div id="page-7" page_name="Особые типы модуля OpenGL" hidden=true>
<script>on_page_added(document.getElementById("page-7"))</script>
<div id="page-8" page_name="Особые типы модуля OpenGL" hidden=true>
<p>Библиотека <code>OpenGL.dll</code> имеет несколько функций, принимающих
вектора и матрицы (в основном для передачи значений в шейдеры).</p>
<p>В модуле <code>OpenGL</code> для каждого типа вектора и матрицы описана отдельная запись.
@ -1423,9 +1434,9 @@ var s := m.ToString;
<p>Но если выводить на форму, то придётся специально поставить моноширный шрифт.<br />
А если выводить в файл, надо выбрать кодировку файла - юникод (UTF).</p>
</div>
<script>on_page_added(document.getElementById("page-7"))</script>
<script>on_page_added(document.getElementById("page-8"))</script>
<script>on_end_folder()</script>
<div id="page-8" page_name="" hidden=true>
<div id="page-9" page_name="" hidden=true>
<p>Большинство проблем при использовании неуправляемых .dll вытекают из следующих 2 различий:</p>
<ol>
<li><p>В .Net строки и массивы это стандартные типы, доступные для всех .Net языков.</p>
@ -1461,8 +1472,8 @@ var s := m.ToString;
<li><a path="Делегаты" > Делегаты </a></li>
</ul>
</div>
<script>on_start_folder("Маршлинг управляемых типов", document.getElementById("page-8"))</script>
<div id="page-9" page_name="Тесты эффектов сборщика мусора" hidden=true>
<script>on_start_folder("Маршлинг управляемых типов", document.getElementById("page-9"))</script>
<div id="page-10" page_name="Тесты эффектов сборщика мусора" hidden=true>
<p>Кроме удаления неиспользуемых экземпляров классов, сборщик мусора так же может произвольно
перемещать используемые объекты, более плотно упаковая их в памяти.</p>
<p>И он прекрасно справляется с тем, чтоб сделать эти перемещения незаметными, в обычных ситуациях.
@ -1618,7 +1629,7 @@ end.
<p>Вся безопастность зависит только от объявления подпрограммы. Если подпрограмма принимает:</p>
<ul>
<li><p>Массив или <code>var</code>-параметр:<br />
Пока вызов не завершится - сборщик мусора НЕ будет передвигать объект в памяти.</p>
Пока вызов неуправляемой подпрограммы не завершится - сборщик мусора НЕ будет передвигать объект в памяти.</p>
</li>
<li><p>Указатель в любом виде (типизированный, безтиповый или даже обёрнутый в запись вроде <code>IntPtr</code>):<br />
Передавать адрес содержимого класса НЕ безопастно.</p>
@ -1629,8 +1640,8 @@ end.
</li>
</ul>
</div>
<script>on_page_added(document.getElementById("page-9"))</script>
<div id="page-10" page_name="var-параметры" hidden=true>
<script>on_page_added(document.getElementById("page-10"))</script>
<div id="page-11" page_name="var-параметры" hidden=true>
<p>В .Net <code>var</code>-параметры реализованы через указатели. То есть эти 2 кода:</p>
<pre><code>procedure p1(var i: integer);
begin
@ -1667,8 +1678,8 @@ end.
<p>А захваченные лямбдой локальные переменные превращаются в поля специального анонимного
класса, поэтому, опять же, могут быть перемещены даже если у них размерный тип.</p>
</div>
<script>on_page_added(document.getElementById("page-10"))</script>
<div id="page-11" page_name="Массивы" hidden=true>
<script>on_page_added(document.getElementById("page-11"))</script>
<div id="page-12" page_name="Массивы" hidden=true>
<p>В .Net массивы хранят не только содержимое, но и данные о своём размере.</p>
<p>А в C++ вместо обычных массивов используется безформенная область памяти.<br />
При её выделении - в переменную записывается указатель <code>[0]</code> элемента.
@ -1745,8 +1756,8 @@ end;
Когда происходит вызов с массивом определённой размерности - создавать новый делегат
в виде динамичного метода, с помощью <code>System.Reflection.Emit</code>, если его ещё нет в словаре.</p>
</div>
<script>on_page_added(document.getElementById("page-11"))</script>
<div id="page-12" page_name="Строки" hidden=true>
<script>on_page_added(document.getElementById("page-12"))</script>
<div id="page-13" page_name="Строки" hidden=true>
<p>Как и массивы - неуправляемые строки это указатель на первый символ строки.<br />
Но со строками ещё сложнее - исходные библиотеки хранят строки в кодировке ANSI (1 байт на символ).<br />
А управляемые строки - хранят символы в кодировке Unicode (2 байта на символ).</p>
@ -1770,9 +1781,9 @@ end;
<li>Полученные бинарные файлы подключать в виде <code>$resource</code>, читать как массив байт и его уже передавать неуправляемому коду вместо строки.</li>
</ol>
</div>
<script>on_page_added(document.getElementById("page-12"))</script>
<div id="page-13" page_name="Делегаты" hidden=true>
<p>Делегат - это адрес подпрограмм:</p>
<script>on_page_added(document.getElementById("page-13"))</script>
<div id="page-14" page_name="Делегаты" hidden=true>
<p>Делегат - это адрес подпрограммы:</p>
<pre><code>procedure p1(i: integer);
begin
Writeln(i);
@ -1795,28 +1806,26 @@ end.
<p>Так же как обычные подпрограммы - подпрограммы из неуправляемых .dll могут принимать делегаты параметром.<br />
Далее всё будет рассматриваться на примере <code>cl.SetEventCallback</code> из модуля <code>OpenCL</code>, потому что с ним есть особые проблемы.</p>
<div class="spoiler" summary="Объявления" hidden="true"><p>Объявление <code>cl.SetEventCallback</code>:</p>
<pre><code> static function SetEventCallback(&amp;event: cl_event; command_exec_callback_type: CommandExecutionStatus; pfn_notify: Event_Callback; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clSetEventCallback';
static function SetEventCallback(&amp;event: cl_event; command_exec_callback_type: CommandExecutionStatus; pfn_notify: IntPtr; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clSetEventCallback';
<pre><code> static function SetEventCallback(&amp;event: cl_event; command_exec_callback_type: CommandExecutionStatus; pfn_notify: EventCallback; user_data: IntPtr): ErrorCode;
</code></pre>
<p>Объявление <code>Event_Callback</code>:</p>
<pre><code> Event_Callback = procedure(&amp;event: cl_event; event_command_exec_status: CommandExecutionStatus; user_data: pointer);
<p>Объявление <code>EventCallback</code>:</p>
<pre><code> EventCallback = procedure(&amp;event: cl_event; event_command_status: CommandExecutionStatus; user_data: IntPtr);
</code></pre>
</div>
<p>Рассмотрим следующий пример:</p>
<pre><code>uses OpenCL;
<pre><code>uses System;
uses OpenCL;
begin
var cb: Event_Callback := (ev,st,data)-&gt;
var cb: EventCallback := (ev,st,data)-&gt;
begin
Writeln($'{ev} перешёл в состояние {st}');
end;
var ev: cl_event; //ToDo := ...
cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb, nil).RaiseIfError;
cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb,IntPtr.Zero).RaiseIfError;
end.
</code></pre>
<p>Этот код будет может время от времени вылетать, потому что:</p>
@ -1831,19 +1840,20 @@ end.
<p>Раз после вызова <code>cl.SetEventCallback</code> делегат <code>cb</code> больше нигде не используется - сборщик мусора может в любой момент
решить удалить его. Но, опять же, это редко случается сразу после вызова <code>cl.SetEventCallback</code>,
поэтому ошибки связанные с этим удалением могут быть плавающие.</p>
<p>Если сборщик мусора удалит делегат, а затем OpenCL.dll попытается его вызвать -
<p>Если сборщик мусора удалит делегат, а затем .dll попытается его вызвать -
это приведёт или к ошибке доступа, или к моментальному беззвучному вылету.</p>
<p>Чтоб запретить сборщику мусора удалять делегать - нужно создать <code>GCHandle</code>, привязанный к нему.<br />
Но в отличии от массивов - <code>GCHandleType.Pinned</code> не нужно, потому что сборщик мусора может перемещать
в памяти данные о параметрах делегата, но не сам адрес (а он единственное что передаётся в OpenCL.dll).
Это потому что адрес хранится в виде неуправляемого делегата, а им сборщик мусора уже не распоряжается.</p>
в памяти данные о параметрах делегата, но не сам адрес (а он единственное что передаётся в .dll).
Это потому что адрес хранится в виде указателя на неуправляемый код.</p>
<pre><code>uses System.Runtime.InteropServices;
uses System;
uses OpenCL;
begin
var gc_hnd: GCHandle;
var cb: Event_Callback := (ev,st,data)-&gt;
var cb: EventCallback := (ev,st,data)-&gt;
begin
Writeln($'{ev} перешёл в состояние {st}');
@ -1856,11 +1866,11 @@ begin
var ev: cl_event; //ToDo := ...
cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb, nil).RaiseIfError;
cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb,IntPtr.Zero).RaiseIfError;
end.
</code></pre>
</div>
<script>on_page_added(document.getElementById("page-13"))</script>
<script>on_page_added(document.getElementById("page-14"))</script>
<script>on_end_folder()</script>
<script>on_end_folder()</script>
</body>

2
InstallerSamples/OpenGL и OpenCL/Справка OpenGLABC.html
View file

@ -861,7 +861,7 @@ window.onload = ()=>{
<div id="page-1" page_name="" hidden=true>
<p><code>ToDo</code> модуля <code>OpenGLABC</code> пока что не существует. Когда то он появится, но пока что есть только это сообщение.</p>
<p>Если хотите понять, было ли это сообщение оставлено тут 10 лет назад и забыто - вот дата, когда автор сообщения последний раз прочитал его:<br />
03.02.2020</p>
24.02.2020</p>
</div>
<script>on_start_folder("GL ABC", document.getElementById("page-1"))</script>
<script>on_end_folder()</script>

14220
bin/Lib/OpenCL.pas
View file

File diff suppressed because it is too large Load diff

130
bin/Lib/OpenCLABC.pas
View file

@ -39,6 +39,9 @@ uses System.Runtime.CompilerServices;
//===================================
// Обязательно сделать до следующего пула:
//ToDo Тесты всех фич модуля
//ToDo И в каждом сделать по несколько выполнений, на случай плавающий ошибок
//===================================
// Запланированное:
@ -97,8 +100,6 @@ uses System.Runtime.CompilerServices;
//ToDo Пройтись по всем функциям OpenCL, посмотреть функционал каких не доступен из OpenCLABC
// - у Kernel.Exec несколько параметров не используются. Стоит использовать
//ToDo Тесты всех фич модуля
//===================================
//ToDo issue компилятора:
@ -137,7 +138,7 @@ type
ProgramCode = class;
DeviceTypeFlags = OpenCL.DeviceTypeFlags;
DeviceType = OpenCL.DeviceType;
{$endregion pre def}
@ -145,10 +146,11 @@ type
__NativUtils = static class
static function CopyToUnm<TRecord>(a: TRecord): ^TRecord; where TRecord: record;
static function CopyToUnm<TRecord>(a: TRecord): IntPtr; where TRecord: record;
begin
Result := pointer(Marshal.AllocHGlobal(Marshal.SizeOf&<TRecord>));
Result^ := a;
Result := Marshal.AllocHGlobal(Marshal.SizeOf&<TRecord>);
var res: ^TRecord := pointer(Result);
res^ := a;
end;
static function AsPtr<T>(p: pointer): ^T := p;
@ -156,10 +158,10 @@ type
static function GCHndAlloc(o: object) :=
CopyToUnm(GCHandle.Alloc(o));
static procedure GCHndFree(gc_hnd_ptr: pointer);
static procedure GCHndFree(gc_hnd_ptr: IntPtr);
begin
AsPtr&<GCHandle>(gc_hnd_ptr)^.Free;
Marshal.FreeHGlobal(IntPtr(gc_hnd_ptr));
AsPtr&<GCHandle>(pointer(gc_hnd_ptr))^.Free;
Marshal.FreeHGlobal(gc_hnd_ptr);
end;
end;
@ -199,14 +201,8 @@ type
public static procedure operator+=(l: __EventList; ev: __EventList);
begin
{$ifdef DebugMode}
for var i := 0 to ev.count-1 do
l += ev[i];
exit;
{$endif DebugMode}
if ev.count=0 then exit;
System.Buffer.BlockCopy( ev.evs,0, l.evs,l.count*cl_event.Size, ev.count*cl_event.Size );
l.count += ev.count;
end;
public static function operator+(l1,l2: __EventList): __EventList;
@ -231,12 +227,12 @@ type
for var i := 0 to count-1 do
cl.ReleaseEvent(evs[i]).RaiseIfError;
public static procedure AttachCallback(ev: cl_event; cb: Event_Callback);
public static procedure AttachCallback(ev: cl_event; cb: Event_Callback; tsk: CLTaskBase);
public static procedure AttachCallback(ev: cl_event; cb: EventCallback);
public static procedure AttachCallback(ev: cl_event; cb: EventCallback; tsk: CLTaskBase);
///cb должен иметь глобальный try и вызывать "state.RaiseIfError" и "__NativUtils.GCHndFree(data)",
///А "cl.ReleaseEvent" если и вызывать - то только на результате вызова AttachCallback
public function AttachCallback(cb: Event_Callback; c: Context; var cq: cl_command_queue): cl_event;
public function AttachCallback(cb: EventCallback; c: Context; var cq: cl_command_queue): cl_event;
end;
@ -255,7 +251,7 @@ type
function WaitAndGetBase: object;
function AttachCallbackBase(cb: Event_Callback; c: Context; var cq: cl_command_queue): __IQueueRes;
function AttachCallbackBase(cb: EventCallback; c: Context; var cq: cl_command_queue): __IQueueRes;
end;
__QueueRes<T> = record(__IQueueRes)
@ -306,13 +302,13 @@ type
end;
function AttachCallback(cb: Event_Callback; c: Context; var cq: cl_command_queue): __QueueRes<T>;
function AttachCallback(cb: EventCallback; c: Context; var cq: cl_command_queue): __QueueRes<T>;
begin
Result.res := self.res;
Result.res_f := self.res_f;
Result.ev := self.ev.AttachCallback(cb, c, cq);
end;
function AttachCallbackBase(cb: Event_Callback; c: Context; var cq: cl_command_queue): __IQueueRes := AttachCallback(cb, c, cq);
function AttachCallbackBase(cb: EventCallback; c: Context; var cq: cl_command_queue): __IQueueRes := AttachCallback(cb, c, cq);
end;
@ -513,7 +509,7 @@ type
if err.IS_ERROR then AddErr(new OpenCLException(err.ToString));
protected procedure AddErr(st: CommandExecutionStatus) :=
if st.IS_ERROR then AddErr(new OpenCLException(st.GetError.ToString));
if st.IS_ERROR then AddErr(new OpenCLException(ErrorCode.Create(st).ToString));
/// Возвращает True если очередь уже завершилась
protected function AddEventHandler<T>(var ev: T; cb: T): boolean; where T: Delegate;
@ -1466,24 +1462,24 @@ type
_def_cont := new Context;
except
try
_def_cont := new Context(DeviceTypeFlags.All); // если нету GPU - попытаться хотя бы для чего то инициализировать
_def_cont := new Context(DeviceType.DEVICE_TYPE_ALL); // если нету GPU - попытаться хотя бы для чего то инициализировать
except
_def_cont := nil;
end;
end;
public constructor := Create(DeviceTypeFlags.GPU);
public constructor := Create(DeviceType.DEVICE_TYPE_GPU);
public constructor(dt: DeviceTypeFlags);
public constructor(dt: DeviceType);
begin
var ec: ErrorCode;
var _platform: cl_platform_id;
cl.GetPlatformIDs(1, @_platform, nil).RaiseIfError;
cl.GetPlatformIDs(1, _platform, IntPtr.Zero).RaiseIfError;
cl.GetDeviceIDs(_platform, dt, 1, @_device, nil).RaiseIfError;
cl.GetDeviceIDs(_platform, dt, 1, _device, IntPtr.Zero).RaiseIfError;
_context := cl.CreateContext(nil, 1, @_device, nil, nil, @ec);
_context := cl.CreateContext(IntPtr.Zero, 1, _device, nil, IntPtr.Zero, ec);
ec.RaiseIfError;
need_finnalize := true;
@ -1492,7 +1488,7 @@ type
public constructor(context: cl_context);
begin
cl.GetContextInfo(context, ContextInfoType.CL_CONTEXT_DEVICES, new UIntPtr(IntPtr.Size), @_device, nil).RaiseIfError;
cl.GetContextInfo(context, ContextInfo.CONTEXT_DEVICES, new UIntPtr(IntPtr.Size), _device, IntPtr.Zero).RaiseIfError;
_context := context;
end;
@ -1533,7 +1529,7 @@ type
self._program := cl.CreateProgramWithSource(c._context, files_texts.Length, files_texts, files_texts.ConvertAll(s->new UIntPtr(s.Length)), ec);
ec.RaiseIfError;
cl.BuildProgram(self._program, 1, @c._device, nil,nil,nil).RaiseIfError;
cl.BuildProgram(self._program, 1,c._device, nil, nil,IntPtr.Zero).RaiseIfError;
end;
@ -1548,12 +1544,13 @@ type
public function GetAllKernels: Dictionary<string, Kernel>;
begin
// Можно и "cl.CreateKernelsInProgram", но тогда имена придётся получать отдельно, а они нужны
var names_char_len: UIntPtr;
cl.GetProgramInfo(_program, ProgramInfoType.NUM_KERNELS, new UIntPtr(UIntPtr.Size), @names_char_len, nil).RaiseIfError;
cl.GetProgramInfo(_program, ProgramInfo.PROGRAM_KERNEL_NAMES, UIntPtr.Zero,IntPtr.Zero, names_char_len).RaiseIfError;
var names_ptr := Marshal.AllocHGlobal(IntPtr(pointer(names_char_len))+1);
cl.GetProgramInfo(_program, ProgramInfoType.KERNEL_NAMES, names_char_len, pointer(names_ptr), nil).RaiseIfError;
var names_ptr := Marshal.AllocHGlobal(IntPtr(pointer(names_char_len)));
cl.GetProgramInfo(_program, ProgramInfo.PROGRAM_KERNEL_NAMES, names_char_len,names_ptr, IntPtr.Zero).RaiseIfError;
var names := Marshal.PtrToStringAnsi(names_ptr).Split(';');
Marshal.FreeHGlobal(names_ptr);
@ -1571,14 +1568,10 @@ type
public function Serialize: array of byte;
begin
var bytes_count: UIntPtr;
cl.GetProgramInfo(_program, ProgramInfoType.BINARY_SIZES, new UIntPtr(UIntPtr.Size), @bytes_count, nil).RaiseIfError;
cl.GetProgramInfo(_program, ProgramInfo.PROGRAM_BINARY_SIZES, new UIntPtr(UIntPtr.Size),bytes_count, IntPtr.Zero).RaiseIfError;
var bytes_mem := Marshal.AllocHGlobal(IntPtr(pointer(bytes_count)));
cl.GetProgramInfo(_program, ProgramInfoType.BINARIES, new UIntPtr(UIntPtr.Size), @bytes_mem, nil).RaiseIfError;
Result := new byte[bytes_count.ToUInt64()];
Marshal.Copy(bytes_mem,Result, 0,Result.Length);
Marshal.FreeHGlobal(bytes_mem);
Result := new byte[bytes_count.ToUInt64];
cl.GetProgramInfo(_program, ProgramInfo.PROGRAM_BINARIES, bytes_count,Result[0], IntPtr.Zero).RaiseIfError;
end;
@ -1597,17 +1590,16 @@ type
public static function Deserialize(c: Context; bin: array of byte): ProgramCode;
begin
var ec: ErrorCode;
Result := new ProgramCode;
var gchnd := GCHandle.Alloc(bin, GCHandleType.Pinned);
var bin_mem: ^byte := pointer(gchnd.AddrOfPinnedObject);
var bin_len := new UIntPtr(bin.Length);
Result._program := cl.CreateProgramWithBinary(c._context,1,@c._device, @bin_len, @bin_mem, nil, @ec);
var bin_arr: array of array of byte;
SetLength(bin_arr,1);
bin_arr[0] := bin;
var ec: ErrorCode;
Result._program := cl.CreateProgramWithBinary(c._context,1,c._device, bin_len,bin_arr, IntPtr.Zero,ec);
ec.RaiseIfError;
gchnd.Free;
end;
@ -1833,12 +1825,12 @@ end;
{$endregion CommandQueue}
static procedure __EventList.AttachCallback(ev: cl_event; cb: Event_Callback) :=
static procedure __EventList.AttachCallback(ev: cl_event; cb: EventCallback) :=
cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb, __NativUtils.GCHndAlloc(cb)).RaiseIfError;
static procedure __EventList.AttachCallback(ev: cl_event; cb: Event_Callback; tsk: CLTaskBase) :=
static procedure __EventList.AttachCallback(ev: cl_event; cb: EventCallback; tsk: CLTaskBase) :=
tsk.AddErr( cl.SetEventCallback(ev, CommandExecutionStatus.COMPLETE, cb, __NativUtils.GCHndAlloc(cb)) );
function __EventList.AttachCallback(cb: Event_Callback; c: Context; var cq: cl_command_queue): cl_event;
function __EventList.AttachCallback(cb: EventCallback; c: Context; var cq: cl_command_queue): cl_event;
begin
var ev: cl_event;
@ -1848,7 +1840,7 @@ begin
if cq=cl_command_queue.Zero then
begin
var ec: ErrorCode;
cq := cl.CreateCommandQueue(c._context, c._device, CommandQueuePropertyFlags.NONE, ec);
cq := cl.CreateCommandQueueWithProperties(c._context,c._device, IntPtr.Zero, ec);
ec.RaiseIfError;
end;
@ -2851,7 +2843,7 @@ type
if cq=cl_command_queue.Zero then
begin
var ec: ErrorCode;
cq := cl.CreateCommandQueue(c._context, c._device, CommandQueuePropertyFlags.NONE, ec);
cq := cl.CreateCommandQueueWithProperties(c._context,c._device, IntPtr.Zero, ec);
ec.RaiseIfError;
end;
@ -2890,7 +2882,7 @@ type
end).Start else
begin
var set_complete: Event_Callback := (ev,st,data)->
var set_complete: EventCallback := (ev,st,data)->
begin
tsk.AddErr( st );
@ -2982,7 +2974,7 @@ type
var res_ev: cl_event;
cl.EnqueueWriteBuffer(
l_cq, b.memobj, 0,
l_cq, b.memobj, Bool.NON_BLOCKING,
new UIntPtr(offset.Get), new UIntPtr(len.Get),
ptr.Get,
prev_ev.count,prev_ev.evs,res_ev
@ -3027,10 +3019,10 @@ type
begin
cl.EnqueueWriteBuffer(
l_cq, b.memobj, 1,
l_cq, b.memobj, Bool.BLOCKING,
new UIntPtr(offset.WaitAndGet), new UIntPtr(len.WaitAndGet),
Marshal.UnsafeAddrOfPinnedArrayElement(a.WaitAndGet,0),
0,nil,nil
0,IntPtr.Zero,IntPtr.Zero
).RaiseIfError;
Result := cl_event.Zero;
@ -3053,7 +3045,7 @@ type
public constructor(val: T; offset_q: CommandQueue<integer>);
begin
self.val := new IntPtr(__NativUtils.CopyToUnm(val));
self.val := __NativUtils.CopyToUnm(val);
self.offset_q := offset_q;
end;
@ -3069,7 +3061,7 @@ type
var res_ev: cl_event;
cl.EnqueueWriteBuffer(
l_cq, b.memobj, 0,
l_cq, b.memobj, Bool.NON_BLOCKING,
new UIntPtr(offset.Get), new UIntPtr(Marshal.SizeOf&<T>),
self.val,
prev_ev.count,prev_ev.evs,res_ev
@ -3110,10 +3102,10 @@ type
Result := (b, l_c, l_cq, prev_ev)->
begin
var res_ev: cl_event;
var val_ptr := new IntPtr(__NativUtils.CopyToUnm(val.Get()));
var val_ptr := __NativUtils.CopyToUnm(val.Get());
cl.EnqueueWriteBuffer(
l_cq, b.memobj, 0,
l_cq, b.memobj, Bool.NON_BLOCKING,
new UIntPtr(offset.Get), new UIntPtr(Marshal.SizeOf&<T>),
val_ptr,
prev_ev.count,prev_ev.evs,res_ev
@ -3184,7 +3176,7 @@ type
var res_ev: cl_event;
cl.EnqueueReadBuffer(
l_cq, b.memobj, 0,
l_cq, b.memobj, Bool.NON_BLOCKING,
new UIntPtr(offset.Get), new UIntPtr(len.Get),
ptr.Get,
prev_ev.count,prev_ev.evs,res_ev
@ -3229,10 +3221,10 @@ type
begin
cl.EnqueueReadBuffer(
l_cq, b.memobj, 1,
l_cq, b.memobj, Bool.BLOCKING,
new UIntPtr(offset.WaitAndGet), new UIntPtr(len.WaitAndGet),
Marshal.UnsafeAddrOfPinnedArrayElement(a.WaitAndGet,0),
0,nil,nil
0,IntPtr.Zero,IntPtr.Zero
).RaiseIfError;
Result := cl_event.Zero;
@ -3346,8 +3338,8 @@ type
new UIntPtr(offset.WaitAndGet), new UIntPtr(len.WaitAndGet),
prev_ev.count,prev_ev.evs,res_ev
).RaiseIfError;
cl.WaitForEvents(1,@res_ev);
cl.ReleaseEvent(res_ev);
cl.WaitForEvents(1,res_ev).RaiseIfError;
cl.ReleaseEvent(res_ev).RaiseIfError;
a_hnd.Free;
Result := cl_event.Zero;
@ -3370,7 +3362,7 @@ type
public constructor(val: T; offset_q, len_q: CommandQueue<integer>);
begin
self.val := new IntPtr(__NativUtils.CopyToUnm(val));
self.val := __NativUtils.CopyToUnm(val);
self.offset_q := offset_q;
self.len_q := len_q;
end;
@ -3432,7 +3424,7 @@ type
Result := (b, l_c, l_cq, prev_ev)->
begin
var res_ev: cl_event;
var val_ptr := new IntPtr(__NativUtils.CopyToUnm(val.Get()));
var val_ptr := __NativUtils.CopyToUnm(val.Get());
cl.EnqueueFillBuffer(
l_cq, b.memobj,
@ -3704,7 +3696,7 @@ begin
if self.memobj<>cl_mem.Zero then Dispose;
GC.AddMemoryPressure(Size64);
var ec: ErrorCode;
self.memobj := cl.CreateBuffer(c._context, MemoryFlags.READ_WRITE, self.sz, IntPtr.Zero, ec);
self.memobj := cl.CreateBuffer(c._context, MemFlags.MEM_READ_WRITE, self.sz, IntPtr.Zero, ec);
ec.RaiseIfError;
end;
@ -3720,7 +3712,7 @@ begin
new UIntPtr( offset ),
new UIntPtr( size )
);
Result.memobj := cl.CreateSubBuffer(self.memobj, MemoryFlags.READ_WRITE, BufferCreateType.REGION, pointer(@reg), ec);
Result.memobj := cl.CreateSubBuffer(self.memobj, MemFlags.MEM_READ_WRITE, BufferCreateType.BUFFER_CREATE_TYPE_REGION,reg, ec);
ec.RaiseIfError;
end;

82565
bin/Lib/OpenGL.pas
View file

File diff suppressed because it is too large Load diff