Results 1 to 8 of 8

Thread: [VB6] How to use GPU from VB6 using opencl

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,227

    [VB6] How to use GPU from VB6 using opencl

    Here is a direct translation of this tutorial which uses opencl to populate a buffer with consecutive numbers.

    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
    cheers,
    </wqw>

  2. #2
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [VB6] How to use GPU from VB6 using opencl

    I run it, no error return. So what next???

  3. #3

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,227

    Re: [VB6] How to use GPU from VB6 using opencl

    Quote Originally Posted by georgekar View Post
    I run it, no error return. So what next???
    Next is to use opencl to calculate FFT on the GPU for instance :-))

    cheers,
    </wqw>

  4. #4
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [VB6] How to use GPU from VB6 using opencl

    Beautiful. Go on.

  5. #5
    Lively Member
    Join Date
    May 2021
    Posts
    96

    Re: [VB6] How to use GPU from VB6 using opencl

    Hi. Was discussing with a friend whether it would be possible to access the GPU from VBA, and I recalled this post, but am having a some difficulty porting it to 64bit VBA. I've converted the API declarations based on what you've indicated to be pointers from your code, and from the OpenCL Specification (Version: 1.0, DocRev: 48) and have managed to get the APIs to run without error, but it crashes on the CopyMemory line and I was hoping that you might have some thoughts as to why.

    I have used conditional compilation on the code below, and have tested it on 64bit VBA (crashes), and on TB 32bit and 64bit. The 32bit version works with TB without incident, but the 64bit version produces on the same Copymemory line:
    0001 00:47:51.428 NATIVE EXCEPTION: ACCESS_VIOLATION /Form1.twin LINE 000107
    Thank you all for your time.

    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@
    #If VBA7 Then
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare PtrSafe Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
        Private Declare PtrSafe Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As Currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
        Private Declare PtrSafe Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
        Private Declare PtrSafe Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
        Private Declare PtrSafe Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As Currency, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare PtrSafe Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, 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 PtrSafe Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
        Private Declare PtrSafe Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
        Private Declare PtrSafe Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
        Private Declare PtrSafe Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, 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 PtrSafe Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare PtrSafe Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
        Private Declare PtrSafe Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
    #Else
        Private Enum LongPtr
            [_]
        End Enum
        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
        Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
        Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
        Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
        Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As currency, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
        Private Declare Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, 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 LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
        Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
        Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, 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 LongPtr, ByVal kernel As LongPtr, 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 LongPtr) As Long
        Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As currency, ByVal offset As LongPtr, ByVal size As LongPtr, 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 LongPtr) As Long
    #End If
    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 LongPtr
        Dim hDevice         As LongPtr
        Dim hContext        As LongPtr
        Dim hQueue          As LongPtr
        Dim hProgram        As LongPtr
        Dim baSource()      As Byte
        Dim hKernel         As LongPtr
        Dim hBuffer         As LongPtr
        Dim hEvent          As LongPtr
        Dim lPtr            As LongPtr
        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, "clEnqueuehQueueMapBuffer"
        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

  6. #6
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,903

    Re: [VB6] How to use GPU from VB6 using opencl

    lPtr is a pointer, so clEnqueueMapBuffer should return LongPtr. You're truncating the pointer with it as Long, so getting an access violation from reading at an incorrect address.

    I don't get any errors after making that change (under tB 64bit, I did not test VBA64).

    The documentation I found lists it as returning void*, so looks like just an oversight, easy to miss when there's so many Long->LongPtr changes.. all void* types must be LongPtr.
    Last edited by fafalone; Oct 10th, 2023 at 12:39 AM.

  7. #7
    Lively Member
    Join Date
    May 2021
    Posts
    96

    Re: [VB6] How to use GPU from VB6 using opencl

    You're absolutely right - my apologies for missing that one. I've checked it in VBA 64bit and it's working as expected. Thank you both!

    On the off-chance anyone needs it, here is the TB/VBA 32bit and 64bit compatible code:

    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@
    #If VBA7 Then
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare PtrSafe Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
        Private Declare PtrSafe Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As Currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
        Private Declare PtrSafe Function clReleaseDevice Lib "opencl" (ByVal Device As LongPtr) As Long
        Private Declare PtrSafe Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
        Private Declare PtrSafe Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal Device As LongPtr, ByVal properties As Currency, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare PtrSafe Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, 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 PtrSafe Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
        Private Declare PtrSafe Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
        Private Declare PtrSafe Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
        Private Declare PtrSafe Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, 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 PtrSafe Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare PtrSafe Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As LongPtr
        Private Declare PtrSafe Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
    #Else
        Private Enum LongPtr
            [_]
        End Enum
        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
        Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
        Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
        Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
        Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
        Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As currency, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
        Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
        Private Declare Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, 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 LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
        Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
        Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
        Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, 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 LongPtr, ByVal kernel As LongPtr, 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 LongPtr) As Long
        Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As currency, ByVal offset As LongPtr, ByVal size As LongPtr, 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 LongPtr) As Long
    #End If
    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 LongPtr
        Dim hDevice         As LongPtr
        Dim hContext        As LongPtr
        Dim hQueue          As LongPtr
        Dim hProgram        As LongPtr
        Dim baSource()      As Byte
        Dim hKernel         As LongPtr
        Dim hBuffer         As LongPtr
        Dim hEvent          As LongPtr
        Dim lPtr            As LongPtr
        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, "clEnqueuehQueueMapBuffer"
        If lPtr <> 0 Then
            Call CopyMemory(aResult(0), ByVal lPtr, NWITEMS * 4)
            For lIdx = 0 To UBound(aResult)
                Debug.Print lIdx
                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

  8. #8
    Addicted Member
    Join Date
    Feb 2022
    Posts
    189

    Re: [VB6] How to use GPU from VB6 using opencl

    Quote Originally Posted by wqweto View Post
    Next is to use opencl to calculate FFT on the GPU for instance :-))
    cheers,
    </wqw>
    This is excellent. Is there a way we can specify VB to send routines to be processed on the GPU without OpenCL?
    Like with DirectX or even VB primitives? Cairo?

    EDIT: found the answer here
    Last edited by taishan; Apr 2nd, 2024 at 09:52 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width