Thread Local Storage (MSDN Example)

[SpriggsySpriggs]

This code comes from the MSDN page on Using Thread Local Storage.

Thread local storage (TLS) enables multiple threads of the same process to use an index allocated by the TlsAlloc function to store and retrieve a value that is local to the thread. In this example, an index is allocated when the process starts. When each thread starts, it allocates a block of dynamic memory and stores a pointer to this memory in the TLS slot using the TlsSetValue function. The CommonFunc function uses the TlsGetValue function to access the data associated with the index that is local to the calling thread. Before each thread terminates, it releases its dynamic memory. Before the process terminates, it calls TlsFree to release the index.

A couple of headers are required:

Code: C++: [Select]

1. //save as stderr.h
2. FILE *stderrf (){
3.     return stderr;
4. }

Code: C++: [Select]

1. //save as threadfunc.h
2. #include<strsafe.h>
3. int32 FUNC_THREADFUNC();
4. extern "C"{
5.         __declspec(dllexport) int32 ThreadFunc(){
6.                 return FUNC_THREADFUNC();
7.         }
8. }

And the QB64 code:

Code: QB64: [Select]

1. Option _Explicit
2. $Console:Only
3.  
4. Const THREADCOUNT = 4
5. Const ERROR_SUCCESS = 0
6. Const LPTR = &H0040
7. Const TLS_OUT_OF_INDEXES = &HFFFFFFFF
8. Const INFINITE = 4294967295
9.  
10. Declare CustomType Library
11.     Function LoadLibrary%& (lpLibFileName As String)
12.     Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
13.     Sub FreeLibrary (ByVal hLibModule As _Offset)
14.     Sub fprintf (ByVal stream As _Offset, format As String, argument As String)
15.     Sub ExitProcess (ByVal uExitCode As _Unsigned Long)
16.     Function TlsGetValue%& (ByVal dwTlsIndex As Long)
17.     Function TlsSetValue%% (ByVal dwTlsIndex As Long, Byval lpTlsValue As _Offset)
18.     Function TlsAlloc& ()
19.     Sub TlsFree (ByVal dwTlsIndex As Long)
20.     Function GetLastError& ()
21.     Function GetCurrentThreadId& ()
22.     Sub printf (format As String, Byval dwarg As Long, Byval lparg As _Offset)
23.     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)
24.     Function LocalAlloc%& (ByVal uFlags As _Unsigned Long, Byval uBytes As _Unsigned _Offset)
25.     Sub LocalFree (ByVal hMem As _Offset)
26.     Function CreateMutex%& Alias "CreateMutexA" (ByVal lpMutexAttributes As _Offset, Byval bInitialOwner As Long, Byval lpName As _Offset)
27.     Sub WaitForSingleObject (ByVal hHandle As _Offset, Byval dwMilliseconds As Long)
28.     Sub CloseHandle (ByVal hObject As _Offset)
29. End Declare
30.  
31. Declare CustomType Library "stderr"
32.     Function stderr%& Alias "stderrf" ()
33. End Declare
34.  
35. Declare Library "threadfunc"
36. End Declare
37.  
38. Dim Shared As Long dwTlsIndex
39. Dim As Long IDThread, i
40. Dim As _Offset hThread(1 To THREADCOUNT)
41.  
42. Dim As _Offset libload: libload = LoadLibrary(Command$(0))
43. Dim As _Offset pThreadFunc: pThreadFunc = GetProcAddress(libload, "ThreadFunc")
44.  
45. 'Allocate a TLS index
46.  
47. dwTlsIndex = TlsAlloc
48. If dwTlsIndex = TLS_OUT_OF_INDEXES Then _
49.     ErrorExit "TlsAlloc failed"
50.  
51. 'Create multiple threads
52.  
53. For i = 1 To THREADCOUNT
54.     hThread(i) = CreateThread(0,_
55.        0,_
56.         pThreadFunc,_
57.        0,_
58.        0,_
59.         _Offset(IDThread))
60.  
61.     'Check the return value for success
62.     If hThread(i) = 0 Then _
63.         ErrorExit "CreateThread error"
64. Next
65.  
66. For i = 1 To THREADCOUNT
67.     WaitForSingleObject hThread(i), INFINITE
68. Next
69.  
70. TlsFree dwTlsIndex
71. FreeLibrary libload
72.  
73. Sub CommonFunc ()
74.     Dim As _Offset lpvData
75.  
76.     'Retrieve a data pointer for the current thread
77.  
78.     lpvData = TlsGetValue(dwTlsIndex)
79.     If lpvData = 0 And GetLastError <> ERROR_SUCCESS Then _
80.         ErrorExit "TlsGetValue error"
81.  
82.     'Use the data stored for the current thread
83.  
84.     printf "common: thread %d: lpvData=%lx" + Chr$(10) + Chr$(0), GetCurrentThreadId, lpvData
85.     Sleep 5
86. End Sub
87.  
88. Function ThreadFunc& ()
89.     Dim As _Offset lpvData
90.  
91.     'Initialize the TLS index for this thread
92.  
93.     lpvData = LocalAlloc(LPTR, 256)
94.     If TlsSetValue(dwTlsIndex, lpvData) = 0 Then _
95.         ErrorExit "TlsSetValue error"
96.  
97.     printf "thread %d: lpvData=%lx" + Chr$(10) + Chr$(0), GetCurrentThreadId, lpvData
98.  
99.     CommonFunc
100.  
101.     'Release the dynamic memory before the thread returns
102.  
103.     lpvData = TlsGetValue(dwTlsIndex)
104.     If lpvData <> 0 Then _
105.         LocalFree lpvData
106.  
107.     ThreadFunc = 0
108. End Function
109.  
110. Sub ErrorExit (message As String)
111.     fprintf stderr, "%s" + Chr$(10) + Chr$(0), message + Chr$(0)
112.     ExitProcess 0
113. End Sub