|
| 1 | +'' examples/manual/proguide/multithreading/emulatetls1.bas |
| 2 | +'' |
| 3 | +'' Example extracted from the FreeBASIC Manual |
| 4 | +'' from topic 'Emulate a TLS (Thread Local Storage) and a TP (Thread Pooling) feature' |
| 5 | +'' |
| 6 | +'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=ProPgEmulateTlsTp |
| 7 | +'' -------- |
| 8 | + |
| 9 | +#include Once "crt/string.bi" |
| 10 | + |
| 11 | +#if __FB_VERSION__ < "1.08" |
| 12 | + ' Emulation of the function Threadself() of FreeBASIC |
| 13 | + ' Before each use, the thread must refresh this function value with its own thread handle, |
| 14 | + ' and all of this (refreshing + use) protected by a mutex. |
| 15 | + Function ThreadSelf () ByRef As Any Ptr |
| 16 | + Static As Any Ptr handle |
| 17 | + Return handle |
| 18 | + End Function |
| 19 | +#else |
| 20 | + #include Once "fbthread.bi" |
| 21 | +#endif |
| 22 | + |
| 23 | +#macro CreateTLSdatatypeVariableFunction (variable_function_name, variable_datatype) |
| 24 | +' Creation of a "variable_function_name" function to emulate a static datatype variable (not an array), |
| 25 | +' with a value depending on the thread using it. |
| 26 | + Namespace TLS |
| 27 | + Function variable_function_name (ByVal cd As Boolean = True) ByRef As variable_datatype |
| 28 | + ' Function emulating (creation/access/destruction) a static datatype variable with value depending on thread using it: |
| 29 | + ' If calling without parameter (or with 'True') parameter, this allows to [create and] access the static datatype variable. |
| 30 | + ' If calling with the 'False' parameter, this allows to destroy the static datatype variable. |
| 31 | + Dim As Integer bound = 0 |
| 32 | + Static As Any Ptr TLSindex(bound) |
| 33 | + Static As variable_datatype TLSdata(bound) |
| 34 | + Dim As Any Ptr Threadhandle = ThreadSelf() |
| 35 | + Dim As Integer index = 0 |
| 36 | + For I As Integer = 1 To UBound(TLSindex) ' search existing TLS variable (existing array element) for the running thread |
| 37 | + If TLSindex(I) = Threadhandle Then |
| 38 | + index = I |
| 39 | + Exit For |
| 40 | + End If |
| 41 | + Next I |
| 42 | + If index = 0 And cd = True Then ' create a new TLS variable (new array element) for a new thread |
| 43 | + index = UBound(TLSindex) + 1 |
| 44 | + ReDim Preserve TLSindex(index) |
| 45 | + TLSindex(index) = Threadhandle |
| 46 | + ReDim Preserve TLSdata(index) |
| 47 | + ElseIf index > 0 And cd = False Then ' destroy a TLS variable (array element) and compact the array |
| 48 | + If index < UBound(TLSindex) Then ' reorder the array elements |
| 49 | + memmove(@TLSindex(index), @TLSindex(index + 1), (UBound(TLSindex) - index) * SizeOf(Any Ptr)) |
| 50 | + Dim As variable_datatype Ptr p = Allocate(SizeOf(variable_datatype)) ' for compatibility to object with destructor |
| 51 | + memmove(p, @TLSdata(index), SizeOf(variable_datatype)) ' for compatibility to object with destructor |
| 52 | + memmove(@TLSdata(index), @TLSdata(index + 1), (UBound(TLSdata) - index) * SizeOf(variable_datatype)) |
| 53 | + memmove(@TLSdata(UBound(TLSdata)), p, SizeOf(variable_datatype)) ' for compatibility to object with destructor |
| 54 | + Deallocate(p) ' for compatibility to object with destructor |
| 55 | + End If |
| 56 | + ReDim Preserve TLSindex(UBound(TLSindex) - 1) |
| 57 | + ReDim Preserve TLSdata(UBound(TLSdata) - 1) |
| 58 | + index = 0 |
| 59 | + End If |
| 60 | + Return TLSdata(index) |
| 61 | + End Function |
| 62 | + End Namespace |
| 63 | +#endmacro |
| 64 | + |
| 65 | +'------------------------------------------------------------------------------ |
| 66 | + |
| 67 | +Type threadData |
| 68 | + Dim As Any Ptr handle |
| 69 | + Dim As String prefix |
| 70 | + Dim As String suffix |
| 71 | + Dim As Double tempo |
| 72 | + #if __FB_VERSION__ < "1.08" |
| 73 | + Static As Any Ptr mutex |
| 74 | + #endif |
| 75 | +End Type |
| 76 | +#if __FB_VERSION__ < "1.08" |
| 77 | + Dim As Any Ptr threadData.mutex |
| 78 | +#endif |
| 79 | + |
| 80 | +CreateTLSdatatypeVariableFunction (count, Integer) ' create a TLS static integer function |
| 81 | + |
| 82 | +Function counter() As Integer ' definition of a generic counter with counting depending on thread calling it |
| 83 | + TLS.count() += 1 ' increment the TLS static integer |
| 84 | + Return TLS.count() ' return the TLS static integer |
| 85 | +End Function |
| 86 | + |
| 87 | +Sub Thread(ByVal p As Any Ptr) |
| 88 | + Dim As threadData Ptr ptd = p |
| 89 | + Dim As UInteger c |
| 90 | + Do |
| 91 | + #if __FB_VERSION__ < "1.08" |
| 92 | + MutexLock(threadData.mutex) |
| 93 | + ThreadSelf() = ptd->handle |
| 94 | + #endif |
| 95 | + c = counter() |
| 96 | + #if __FB_VERSION__ < "1.08" |
| 97 | + MutexUnlock(threadData.mutex) |
| 98 | + #endif |
| 99 | + Print ptd->prefix & c & ptd->suffix & " "; ' single print with concatenated string avoids using a mutex |
| 100 | + Sleep ptd->tempo, 1 |
| 101 | + Loop Until c = 12 |
| 102 | + #if __FB_VERSION__ < "1.08" |
| 103 | + MutexLock(threadData.mutex) |
| 104 | + ThreadSelf() = ptd->handle |
| 105 | + #endif |
| 106 | + TLS.count(False) ' destroy the TLS static integer |
| 107 | + #if __FB_VERSION__ < "1.08" |
| 108 | + MutexUnlock(threadData.mutex) |
| 109 | + #endif |
| 110 | +End Sub |
| 111 | + |
| 112 | +'------------------------------------------------------------------------------ |
| 113 | + |
| 114 | +Print "|x| : counting from thread a" |
| 115 | +Print "(x) : counting from thread b" |
| 116 | +Print "[x] : counting from thread c" |
| 117 | +Print |
| 118 | + |
| 119 | +#if __FB_VERSION__ < "1.08" |
| 120 | + threadData.mutex = MutexCreate() |
| 121 | +#endif |
| 122 | + |
| 123 | +Dim As threadData mtlsa |
| 124 | +mtlsa.prefix = "|" |
| 125 | +mtlsa.suffix = "|" |
| 126 | +mtlsa.tempo = 100 |
| 127 | +#if __FB_VERSION__ < "1.08" |
| 128 | + MutexLock(threadData.mutex) |
| 129 | +#endif |
| 130 | +mtlsa.handle = ThreadCreate(@Thread, @mtlsa) |
| 131 | +#if __FB_VERSION__ < "1.08" |
| 132 | + MutexUnlock(threadData.mutex) |
| 133 | +#endif |
| 134 | + |
| 135 | +Dim As threadData mtlsb |
| 136 | +mtlsb.prefix = "(" |
| 137 | +mtlsb.suffix = ")" |
| 138 | +mtlsb.tempo = 150 |
| 139 | +#if __FB_VERSION__ < "1.08" |
| 140 | + MutexLock(threadData.mutex) |
| 141 | +#endif |
| 142 | +mtlsb.handle = ThreadCreate(@Thread, @mtlsb) |
| 143 | +#if __FB_VERSION__ < "1.08" |
| 144 | + MutexUnlock(threadData.mutex) |
| 145 | +#endif |
| 146 | + |
| 147 | +Dim As threadData mtlsc |
| 148 | +mtlsc.prefix = "[" |
| 149 | +mtlsc.suffix = "]" |
| 150 | +mtlsc.tempo = 250 |
| 151 | +#if __FB_VERSION__ < "1.08" |
| 152 | + MutexLock(threadData.mutex) |
| 153 | +#endif |
| 154 | +mtlsc.handle = ThreadCreate(@Thread, @mtlsc) |
| 155 | +#if __FB_VERSION__ < "1.08" |
| 156 | + MutexUnlock(threadData.mutex) |
| 157 | +#endif |
| 158 | + |
| 159 | +ThreadWait(mtlsa.handle) |
| 160 | +ThreadWait(mtlsb.handle) |
| 161 | +ThreadWait(mtlsc.handle) |
| 162 | +#if __FB_VERSION__ < "1.08" |
| 163 | + MutexDestroy(threadData.mutex) |
| 164 | +#endif |
| 165 | + |
| 166 | +Print |
| 167 | +Print |
| 168 | +Print "end of threads" |
| 169 | + |
| 170 | +Sleep |
| 171 | + |
0 commit comments