Here is a direct translation of this tutorial which uses opencl to populate a buffer with consecutive numbers.
cheers,
</wqw>
Code:
Option Explicit
Private Const CL_FALSE As Long = 0
Private Const CL_TRUE As Long = 1
Private Const CL_DEVICE_TYPE_GPU As Currency = 4 / 10000@
Private Const CL_MEM_WRITE_ONLY As Currency = 2 / 10000@
Private Const CL_MAP_READ As Currency = 1 / 10000@
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As Any, num_platforms As Any) As Long
Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As Long, ByVal device_type As Currency, ByVal num_entries As Long, devices As Any, num_devices As Any) As Long
Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As Long) As Long
Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As Any, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As Long
Private Declare Function clReleaseContext Lib "opencl" (ByVal context As Long) As Long
Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As Long, ByVal device As Long, ByVal properties As Currency, errcode_ret As Any) As Long
Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As Long) As Long
Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As Long, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As Long
Private Declare Function clBuildProgram Lib "opencl" (ByVal program As Long, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
Private Declare Function clCreateKernel Lib "opencl" (ByVal program As Long, ByVal kernel_name As String, errcode_ret As Any) As Long
Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As Long) As Long
Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As Long, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As Long, errcode_ret As Any) As Long
Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As Long) As Long
Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As Long, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
Private Declare Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As Long, ByVal kernel As Long, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
Private Declare Function clFinish Lib "opencl" (ByVal command_queue As Long) As Long
Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As Long, ByVal buffer As Long, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As Long, ByVal size As Long, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
Private Declare Function clReleaseEvent Lib "opencl" (ByVal event_ As Long) As Long
Private Const STR_SOURCE As String = _
"kernel void memset( global uint *dst )" & vbCrLf & _
"{" & vbCrLf & _
" dst[get_global_id(0)] = get_global_id(0);" & vbCrLf & _
"}"
Private Const NWITEMS As Long = 512
Private Sub Form_Load()
Dim lError As Long
Dim hPlatform As Long
Dim hDevice As Long
Dim hContext As Long
Dim hQueue As Long
Dim hProgram As Long
Dim baSource() As Byte
Dim hKernel As Long
Dim hBuffer As Long
Dim hEvent As Long
Dim lPtr As Long
Dim aResult(0 To NWITEMS - 1) As Long
Dim lIdx As Long
On Error GoTo EH
baSource = StrConv(STR_SOURCE & vbNullChar, vbFromUnicode)
lError = clGetPlatformIDs(1, hPlatform, ByVal 0)
pvCheckError lError, "clGetPlatformIDs"
lError = clGetDeviceIDs(hPlatform, CL_DEVICE_TYPE_GPU, 1, hDevice, ByVal 0)
pvCheckError lError, "clGetDeviceIDs"
hContext = clCreateContext(0, 1, hDevice, 0, 0, lError)
pvCheckError lError, "clCreateContext"
hQueue = clCreateCommandQueue(hContext, hDevice, ByVal 0, lError)
pvCheckError lError, "clCreateCommandQueue"
hProgram = clCreateProgramWithSource(hContext, 1, VarPtr(baSource(0)), ByVal 0, lError)
pvCheckError lError, "clCreateProgramWithSource"
lError = clBuildProgram(hProgram, 1, hDevice, vbNullString, 0, 0)
pvCheckError lError, "clBuildProgram"
hKernel = clCreateKernel(hProgram, "memset", lError)
pvCheckError lError, "clCreateKernel"
hBuffer = clCreateBuffer(hContext, CL_MEM_WRITE_ONLY, NWITEMS * 4, 0, lError)
pvCheckError lError, "clCreateBuffer"
lError = clSetKernelArg(hKernel, 0, LenB(hBuffer), hBuffer)
pvCheckError lError, "clSetKernelArg"
lError = clEnqueueNDRangeKernel(hQueue, hKernel, 1, ByVal 0, NWITEMS, ByVal 0, 0, ByVal 0, hEvent)
pvCheckError lError, "clEnqueueNDRangeKernel"
lError = clFinish(hQueue)
pvCheckError lError, "clFinish"
lPtr = clEnqueueMapBuffer(hQueue, hBuffer, CL_TRUE, CL_MAP_READ, 0, NWITEMS * 4, 0, ByVal 0, ByVal 0, lError)
pvCheckError lError, "clEnqueueMapBuffer"
If lPtr <> 0 Then
Call CopyMemory(aResult(0), ByVal lPtr, NWITEMS * 4)
For lIdx = 0 To UBound(aResult)
Debug.Assert aResult(lIdx) = lIdx
Next
End If
QH:
Call clReleaseEvent(hEvent)
Call clReleaseMemObject(hBuffer)
Call clReleaseKernel(hKernel)
Call clReleaseCommandQueue(hQueue)
Call clReleaseContext(hContext)
Call clReleaseDevice(hDevice)
Exit Sub
EH:
MsgBox "Critical error: " & Err.Description & " &H" & Hex$(Err.Number), vbCritical, Err.Source
Resume QH
End Sub
Private Sub pvCheckError(ByVal lError As Long, sSource As String)
If lError <> 0 Then
Err.Raise vbObjectError, sSource, "Error " & lError
End If
End Sub</wqw>