Threading

[SpriggsySpriggs]

@justsomeguy You got me seriously interested in this topic so I decided to whip up some WinAPI QB64 code based on the example on the MSDN page on threading here. Below is the code that will run three threads in the same executable.

A header you will need, save it as threadwin.h

Code: C++: [Select]

1. #include<strsafe.h>
2. int32 FUNC_MYTHREADFUNCTION(ptrszint*_FUNC_MYTHREADFUNCTION_OFFSET_LPPARAM);
3. extern "C"{
4.         __declspec(dllexport) int32 MyThreadFunction(ptrszint*lpParam){
5.                 return FUNC_MYTHREADFUNCTION((lpParam));
6.         }
7. }
8.  
9. int32 sizeoftchar(){
10.         return sizeof(TCHAR);
11. }

Code: QB64: [Select]

1. Option _Explicit
2. $Console:Only
3.  
4. Type MyData
5.     As Long val1, val2
6. End Type
7.  
8. Const BUF_SIZE = 255
9. Const MAX_THREADS = 20
10. Const HEAP_ZERO_MEMORY = &H00000008
11. Const INFINITE = 4294967295
12. Const STD_OUTPUT_HANDLE = -11
13. Const INVALID_HANDLE_VALUE = -1
14.  
15. Const MB_OK = 0
16.  
17. Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
18. Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
19. Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
20. Const LANG_NEUTRAL = &H00
21. Const SUBLANG_DEFAULT = &H01
22.  
23. Const LMEM_ZEROINIT = &H0040
24.  
25. Declare CustomType Library
26.     Function LoadLibrary%& (lpLibFileName As String)
27.     Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
28.     Function FreeLibrary%% (ByVal hLibModule As _Offset)
29.     Sub FreeLibrary (ByVal hLibModule As _Offset)
30.     Function GetLastError& ()
31.     Function HeapAlloc%& (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval dwBytes As _Offset)
32.     Function GetProcessHeap%& ()
33.     Sub ExitProcess (ByVal uExitCode As _Unsigned Long)
34.     Function CreateThread%& (ByVal lpThreadAttributes As _Offset, Byval dwStackSize As _Offset, Byval lpStartAddress As _Offset, Byval lpParameter As _Offset, Byval dwCreationFlags As Long, Byval lpThreadId As _Offset)
35.     Function WaitForMultipleObjects& (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
36.     Sub WaitForMultipleObjects (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
37.     Function CloseHandle%% (ByVal hObject As _Offset)
38.     Sub CloseHandle (ByVal hObject As _Offset)
39.     Function HeapFree%% (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval lpMem As _Offset)
40.     Sub HeapFree (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval lpMem As _Offset)
41.     Sub StringCchPrintf Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, byvalpszFormat As String, Byval arg1 As Long, Byval arg2 As Long)
42.     Sub StringCchPrintf2 Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, pszFormat As String, lpszFunction As String, Byval error As Long, Byval lpMsgBuf As _Offset)
43.     Sub StringCchLength Alias "StringCchLengthA" (ByVal psz As _Offset, Byval cchMax As _Offset, Byval pcchLength As _Offset)
44.     Function GetStdHandle%& (ByVal nStdHandle As Long)
45.     Function CreateMutex%& Alias "CreateMutexA" (ByVal lpMutexAttributes As _Offset, Byval bInitialOwner As Long, Byval lpName As _Offset)
46.     Sub WriteConsole (ByVal hConsoleOutput As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfCharsToWrite As Long, Byval lpNumberOfCharsWritten As _Offset, Byval lpReserved As _Offset)
47.     Sub FormatMessage Alias FormatMessageA (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
48.     Sub MessageBox Alias "MessageBoxA" (ByVal hWnd As _Offset, Byval lpText As _Offset, lpCaption As String, Byval uType As _Unsigned Long)
49.     Sub LocalFree (ByVal hMem As _Offset)
50.     Function LocalAlloc%& (ByVal uFlags As _Unsigned Long, Byval uBytes As _Unsigned _Offset)
51.     Function lstrlen& Alias "lstrlenA" (ByVal lpString As _Offset)
52.     Function LocalSize%& (ByVal hMem As _Offset)
53.     Sub SetLastError (ByVal dwError As Long)
54. End Declare
55.  
56. Declare Library "threadwin"
57.     Function sizeoftchar& ()
58. End Declare
59.  
60. Declare Library
61.     Function MAKELANGID& (ByVal p As Long, Byval s As Long)
62. End Declare
63.  
64. Dim As _Offset libload: libload = LoadLibrary(Command$(0))
65. Dim As _Offset MyThreadFunc: MyThreadFunc = GetProcAddress(libload, "MyThreadFunction")
66.  
67. Dim As MyData pDataArray(1 To MAX_THREADS)
68. Dim As Long dwThreadIdArray(1 To MAX_THREADS)
69. Dim As _Offset hThreadArray(1 To MAX_THREADS), heap(1 To MAX_THREADS)
70.  
71. Dim As _Offset ghMutex: ghMutex = CreateMutex(0, 0, 0)
72. If ghMutex = 0 Then
73.     ErrorHandler "CreateMutex"
74. End If
75. Dim As Long i
76. For i = 1 To MAX_THREADS
77.     heap(i) = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Len(pDataArray(i)))
78.     Dim As _MEM pdata: pdata = _MemNew(8)
79.     _MemPut pdata, pdata.OFFSET, heap(i)
80.     _MemGet pdata, pdata.OFFSET, pDataArray(i)
81.     If heap(i) = 0 Then
82.         ExitProcess 2
83.     End If
84.     pDataArray(i).val1 = i
85.     pDataArray(i).val2 = i + 100
86.     hThreadArray(i) = CreateThread(0, 0, MyThreadFunc, _Offset(pDataArray(i)), 0, _Offset(dwThreadIdArray(i)))
87.     If hThreadArray(i) = 0 Then
88.         ErrorHandler "CreateThread"
89.         ExitProcess 3
90.     End If
91. Next
92. WaitForMultipleObjects MAX_THREADS, _Offset(hThreadArray()), 1, INFINITE
93. For i = 1 To MAX_THREADS
94.     CloseHandle hThreadArray(i)
95.     If heap(i) <> 0 Then
96.         HeapFree GetProcessHeap, 0, heap(i)
97.     End If
98. Next
99. CloseHandle ghMutex
100. FreeLibrary libload
101.  
102. Function MyThreadFunction& (lpParam As _Offset)
103.     Dim As String * BUF_SIZE msgBuf
104.     Dim As _Offset hStdout
105.     Dim As Long cchStringSize, dwChars
106.     Dim As MyData MyData
107.     hStdout = GetStdHandle(STD_OUTPUT_HANDLE)
108.     If hStdout = INVALID_HANDLE_VALUE Then
109.         MyThreadFunction = 1
110.     End If
111.     Dim As _MEM PMYDATA: PMYDATA = _MemNew(8)
112.     _MemPut PMYDATA, PMYDATA.OFFSET, lpParam
113.     _MemGet PMYDATA, PMYDATA.OFFSET, MyData
114.     StringCchPrintf _Offset(msgBuf), BUF_SIZE, "Parameters = %d, %d" + Chr$(10) + Chr$(0), MyData.val1, MyData.val2
115.     StringCchLength _Offset(msgBuf), BUF_SIZE, _Offset(cchStringSize)
116.     WriteConsole hStdout, _Offset(msgBuf), cchStringSize, _Offset(dwChars), 0
117.     MyThreadFunction = 0
118. End Function
119.  
120. Sub ErrorHandler (lpszFunction As String)
121.     Dim As _Offset lpMsgBuf, lpDisplayBuf
122.     Dim As Long dw: dw = GetLastError
123.     FormatMessage FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, dw, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _Offset(lpMsgBuf), 0, 0
124.     lpDisplayBuf = LocalAlloc(LMEM_ZEROINIT, (lstrlen(lpMsgBuf) + lstrlen(_Offset(lpszFunction)) + 40) * sizeoftchar)
125.     StringCchPrintf2 lpDisplayBuf, LocalSize(lpDisplayBuf) / sizeoftchar, "%s failed with error %d:" + Chr$(10) + " %s" + Chr$(0), lpszFunction + Chr$(0), dw, lpMsgBuf
126.     MessageBox 0, lpDisplayBuf, "Error" + Chr$(0), MB_OK
127.     LocalFree lpMsgBuf
128.     LocalFree lpDisplayBuf
129. End Sub

And a screenshot of the output:
  [ You are not allowed to view this attachment ]

Edit: For a bit of fun, increase the MAX_THREADS constant to a higher number. I've tried 20

[SpriggsySpriggs]

If you aren't already, please join the Discord. I would love to collaborate with you on more similar projects. It's been a long time since I've been this excited about API programming. Excited enough that I pulled out my work laptop and coded this one while laying in a hotel bed. I NEVER touch my work laptop when I'm at a hotel.

[justsomeguy]

@SpriggsySpriggs Very impressive. I'm glad that I could get you fired up!

 Have you tried bench-marking it? How's the stability? I'm surprised that the 'print' statement isn't core dumping on you.

Anyway, I am on discord, and I don't mind collaborating, but I think your programming skill is several orders magnitude greater than mine.

[SpriggsySpriggs]

I had to edit my post above with the thread safe functions for printing. I was noticing small issues with launching and running. This should behave a bit better. You were correct about the printing causing an issue. So, this new printing is far safer (from what I can tell)